diff --git a/proof/crefine/AARCH64/ADT_C.thy b/proof/crefine/AARCH64/ADT_C.thy
index 10f06c8a7d..c8c1a67caf 100644
--- a/proof/crefine/AARCH64/ADT_C.thy
+++ b/proof/crefine/AARCH64/ADT_C.thy
@@ -82,8 +82,8 @@ lemma Basic_sem_eq:
 
 lemma setTCBContext_C_corres:
   "\<lbrakk> ccontext_relation tc tc'; t' = tcb_ptr_to_ctcb_ptr t \<rbrakk> \<Longrightarrow>
-  corres_underlying rf_sr nf nf' dc (pspace_domain_valid and tcb_at' t) \<top>
-    (threadSet (\<lambda>tcb. tcb \<lparr> tcbArch := atcbContextSet tc (tcbArch tcb)\<rparr>) t) (setTCBContext_C tc' t')"
+   corres_underlying rf_sr nf nf' dc (pspace_domain_valid and tcb_at' t) \<top>
+     (threadSet (\<lambda>tcb. tcb \<lparr> tcbArch := atcbContextSet tc (tcbArch tcb)\<rparr>) t) (setTCBContext_C tc' t')"
   apply (simp add: setTCBContext_C_def exec_C_def Basic_sem_eq corres_underlying_def)
   apply clarsimp
   apply (simp add: threadSet_def bind_assoc split_def exec_gets)
@@ -112,8 +112,6 @@ lemma setTCBContext_C_corres:
   apply (simp add: map_to_ctes_upd_tcb_no_ctes map_to_tcbs_upd tcb_cte_cases_def
                    cvariable_relation_upd_const ko_at_projectKO_opt cteSizeBits_def)
   apply (simp add: cep_relations_drop_fun_upd)
-  apply (apply_conjunct \<open>match conclusion in \<open>cready_queues_relation _ _ _\<close> \<Rightarrow>
-         \<open>erule cready_queues_relation_not_queue_ptrs; rule ext; simp split: if_split\<close>\<close>)
   apply (drule ko_at_projectKO_opt)
   apply (erule (2) cmap_relation_upd_relI)
     apply (simp add: ctcb_relation_def carch_tcb_relation_def)
@@ -648,25 +646,51 @@ lemma tcb_queue_rel'_unique:
   apply (erule(2) tcb_queue_rel_unique)
   done
 
-definition
-  cready_queues_to_H
-  :: "(tcb_C ptr \<rightharpoonup> tcb_C) \<Rightarrow> (tcb_queue_C[num_tcb_queues]) \<Rightarrow> word8 \<times> word8 \<Rightarrow> machine_word list"
+
+definition tcb_queue_C_to_tcb_queue :: "tcb_queue_C \<Rightarrow> tcb_queue" where
+  "tcb_queue_C_to_tcb_queue q \<equiv>
+     TcbQueue (if head_C q = NULL then None else Some (ctcb_ptr_to_tcb_ptr (head_C q)))
+              (if end_C q = NULL then None else Some (ctcb_ptr_to_tcb_ptr (end_C q)))"
+
+definition cready_queues_to_H ::
+  "tcb_queue_C[num_tcb_queues] \<Rightarrow> (domain \<times> priority \<Rightarrow> ready_queue)"
   where
-  "cready_queues_to_H h_tcb cs \<equiv> \<lambda>(qdom, prio). if ucast minDom \<le> qdom \<and> qdom \<le> ucast maxDom
-              \<and> ucast seL4_MinPrio \<le> prio \<and> prio \<le> ucast seL4_MaxPrio
-   then THE aq. let cqueue = index cs (cready_queues_index_to_C qdom prio)
-    in sched_queue_relation' h_tcb aq (head_C cqueue) (StateRelation_C.end_C cqueue)
-   else []"
+  "cready_queues_to_H cs \<equiv>
+     \<lambda>(qdom, prio).
+       if qdom \<le> maxDomain \<and> prio \<le> maxPriority
+       then let cqueue = index cs (cready_queues_index_to_C qdom prio)
+             in tcb_queue_C_to_tcb_queue cqueue
+       else TcbQueue None None"
 
 lemma cready_queues_to_H_correct:
-  "cready_queues_relation (clift s) cs as \<Longrightarrow>
-   cready_queues_to_H (clift s) cs = as"
-  apply (clarsimp simp: cready_queues_to_H_def cready_queues_relation_def
-                   fun_eq_iff)
-  apply (rule the_equality)
-   apply simp
-  apply (clarsimp simp: Let_def)
-  apply (rule_tac hp="clift s" in tcb_queue_rel'_unique, simp_all add: lift_t_NULL)
+  "\<lbrakk>cready_queues_relation (ksReadyQueues s) (ksReadyQueues_' ch);
+    no_0_obj' s; ksReadyQueues_asrt s; pspace_aligned' s; pspace_distinct' s\<rbrakk>
+   \<Longrightarrow> cready_queues_to_H (ksReadyQueues_' ch) = ksReadyQueues s"
+  apply (clarsimp simp: cready_queues_to_H_def cready_queues_relation_def Let_def)
+  apply (clarsimp simp: fun_eq_iff)
+  apply (rename_tac d p)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply (clarsimp simp: ready_queue_relation_def ksReadyQueues_asrt_def)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply clarsimp
+  apply (frule (3) obj_at'_tcbQueueHead_ksReadyQueues)
+  apply (frule (3) obj_at'_tcbQueueEnd_ksReadyQueues)
+  apply (frule tcbQueueHead_iff_tcbQueueEnd)
+  apply (rule conjI)
+   apply (clarsimp simp: tcb_queue_C_to_tcb_queue_def ctcb_queue_relation_def option_to_ctcb_ptr_def)
+   apply (case_tac "tcbQueueHead (ksReadyQueues s (d, p)) = None")
+    apply (clarsimp simp: tcb_queue.expand)
+   apply clarsimp
+   apply (rename_tac queue_head queue_end)
+   apply (prop_tac "tcb_at' queue_head s", fastforce simp: tcbQueueEmpty_def obj_at'_def)
+   apply (prop_tac "tcb_at' queue_end s", fastforce simp: tcbQueueEmpty_def obj_at'_def)
+   apply (drule tcb_at_not_NULL)+
+   apply (fastforce simp: tcb_queue.expand kernel.ctcb_ptr_to_ctcb_ptr)
+  apply (clarsimp simp: tcbQueueEmpty_def ctcb_queue_relation_def option_to_ctcb_ptr_def
+                 split: option.splits;
+         metis tcb_queue.exhaust_sel word_not_le)
   done
 
 (* showing that cpspace_relation is actually unique >>>*)
@@ -820,17 +844,20 @@ lemma cthread_state_rel_imp_eq:
   apply (cases y, simp_all add: ThreadState_defs)+
   done
 
-lemma ksPSpace_valid_objs_tcbBoundNotification_nonzero:
-  "\<exists>s. ksPSpace s = ah \<and> no_0_obj' s \<and> valid_objs' s
-     \<Longrightarrow> map_to_tcbs ah p = Some tcb \<Longrightarrow> tcbBoundNotification tcb \<noteq> Some 0"
+lemma map_to_tcbs_Some_refs_nonzero:
+  "\<lbrakk>map_to_tcbs (ksPSpace s) p = Some tcb; no_0_obj' s; valid_objs' s\<rbrakk>
+   \<Longrightarrow> tcbBoundNotification tcb \<noteq> Some 0
+       \<and> tcbSchedPrev tcb \<noteq> Some 0
+       \<and> tcbSchedNext tcb \<noteq> Some 0"
+  supply word_neq_0_conv[simp del]
   apply (clarsimp simp: map_comp_def split: option.splits)
-  apply (erule(1) valid_objsE')
-  apply (clarsimp simp: valid_obj'_def valid_tcb'_def)
+  apply (erule (1) valid_objsE')
+  apply (fastforce simp: valid_obj'_def valid_tcb'_def)
   done
 
 lemma ksPSpace_valid_objs_atcbVCPUPtr_nonzero:
-  "\<exists>s. ksPSpace s = ah \<and> no_0_obj' s \<and> valid_objs' s
-     \<Longrightarrow> map_to_tcbs ah p = Some tcb \<Longrightarrow> atcbVCPUPtr (tcbArch tcb) \<noteq> Some 0"
+  "\<lbrakk> no_0_obj' s; valid_objs' s \<rbrakk> \<Longrightarrow>
+   map_to_tcbs (ksPSpace s) p = Some tcb \<Longrightarrow> atcbVCPUPtr (tcbArch tcb) \<noteq> Some 0"
   apply (clarsimp simp: map_comp_def split: option.splits)
   apply (erule(1) valid_objsE')
   apply (clarsimp simp: valid_obj'_def valid_tcb'_def valid_arch_tcb'_def)
@@ -855,36 +882,77 @@ lemma carch_tcb_relation_imp_eq:
   apply (case_tac vcpuptr2 ; simp)
   done
 
+lemma tcb_ptr_to_ctcb_ptr_inj:
+  "tcb_ptr_to_ctcb_ptr x = tcb_ptr_to_ctcb_ptr y \<Longrightarrow> x = y"
+  by (auto simp: tcb_ptr_to_ctcb_ptr_def ctcb_offset_def)
+
+lemma
+  assumes "pspace_aligned' as" "pspace_distinct' as" "valid_tcb' atcb as"
+  shows tcb_at'_tcbBoundNotification:
+    "bound (tcbBoundNotification atcb) \<longrightarrow> ntfn_at' (the (tcbBoundNotification atcb)) as"
+  and tcb_at'_tcbSchedPrev:
+    "tcbSchedPrev atcb \<noteq> None \<longrightarrow> tcb_at' (the (tcbSchedPrev atcb)) as"
+  and tcb_at'_tcbSchedNext:
+    "tcbSchedNext atcb \<noteq> None \<longrightarrow> tcb_at' (the (tcbSchedNext atcb)) as"
+  using assms
+  by (clarsimp simp: valid_tcb'_def obj_at'_def)+
+
 lemma cpspace_tcb_relation_unique:
-  assumes tcbs: "cpspace_tcb_relation ah ch" "cpspace_tcb_relation ah' ch"
-      and   vs: "\<exists>s. ksPSpace s = ah \<and> no_0_obj' s \<and> valid_objs' s"
-      and   vs': "\<exists>s. ksPSpace s = ah' \<and> no_0_obj' s \<and> valid_objs' s"
-  assumes ctes: " \<forall>tcb tcb'. (\<exists>p. map_to_tcbs ah p = Some tcb \<and>
-                                  map_to_tcbs ah' p = Some tcb') \<longrightarrow>
-                  (\<forall>x\<in>ran tcb_cte_cases. fst x tcb' = fst x tcb)"
-  shows "map_to_tcbs ah' = map_to_tcbs ah"
+  assumes tcbs: "cpspace_tcb_relation (ksPSpace as) ch" "cpspace_tcb_relation (ksPSpace as') ch"
+  assumes   vs: "no_0_obj' as" "valid_objs' as"
+  assumes  vs': "no_0_obj' as'" "valid_objs' as'"
+  assumes   ad: "pspace_aligned' as" "pspace_distinct' as"
+  assumes  ad': "pspace_aligned' as'" "pspace_distinct' as'"
+  assumes ctes: "\<forall>tcb tcb'. (\<exists>p. map_to_tcbs (ksPSpace as) p = Some tcb \<and>
+                                 map_to_tcbs (ksPSpace as') p = Some tcb') \<longrightarrow>
+                 (\<forall>x\<in>ran tcb_cte_cases. fst x tcb' = fst x tcb)"
+  shows "map_to_tcbs (ksPSpace as') = map_to_tcbs (ksPSpace as)"
   using tcbs(2) tcbs(1)
   apply (clarsimp simp add: cmap_relation_def)
   apply (drule inj_image_inv[OF inj_tcb_ptr_to_ctcb_ptr])+
   apply (simp add: tcb_ptr_to_ctcb_ptr_def[abs_def] ctcb_offset_def)
   apply (rule ext)
-  apply (case_tac "x:dom (map_to_tcbs ah)")
+  apply (case_tac "x \<in> dom (map_to_tcbs (ksPSpace as))")
    apply (drule bspec, assumption)+
    apply (simp add: dom_def Collect_eq, drule_tac x=x in spec)
    apply clarsimp
    apply (rename_tac p x y)
    apply (cut_tac ctes)
    apply (drule_tac x=x in spec, drule_tac x=y in spec, erule impE, fastforce)
-   apply (frule ksPSpace_valid_objs_tcbBoundNotification_nonzero[OF vs])
-   apply (frule ksPSpace_valid_objs_tcbBoundNotification_nonzero[OF vs'])
+   apply (frule map_to_tcbs_Some_refs_nonzero[OF _ vs])
+   apply (frule map_to_tcbs_Some_refs_nonzero[OF _ vs'])
    apply (frule ksPSpace_valid_objs_atcbVCPUPtr_nonzero[OF vs])
    apply (frule ksPSpace_valid_objs_atcbVCPUPtr_nonzero[OF vs'])
+   apply (rename_tac atcb atcb')
+   apply (prop_tac "valid_tcb' atcb as")
+    apply (fastforce intro: vs ad map_to_ko_atI tcb_ko_at_valid_objs_valid_tcb')
+   apply (prop_tac "valid_tcb' atcb' as'")
+    apply (fastforce intro: vs' ad' map_to_ko_atI tcb_ko_at_valid_objs_valid_tcb')
+   apply (frule tcb_at'_tcbSchedPrev[OF ad])
+   apply (frule tcb_at'_tcbSchedPrev[OF ad'])
+   apply (frule tcb_at'_tcbSchedNext[OF ad])
+   apply (frule tcb_at'_tcbSchedNext[OF ad'])
    apply (thin_tac "map_to_tcbs x y = Some z" for x y z)+
-   apply (case_tac x, case_tac y, case_tac "the (clift ch (tcb_Ptr (p+0x400)))")
+   apply (case_tac "the (clift ch (tcb_Ptr (p + 2 ^ ctcb_size_bits)))")
    apply (clarsimp simp: ctcb_relation_def ran_tcb_cte_cases)
-   apply (clarsimp simp: option_to_ptr_def option_to_0_def split: option.splits)
-   apply (auto simp: cfault_rel_imp_eq cthread_state_rel_imp_eq carch_tcb_relation_imp_eq
-                     ccontext_relation_imp_eq up_ucast_inj_eq ctcb_size_bits_def)
+   apply (clarsimp simp: option_to_ctcb_ptr_def option_to_ptr_def option_to_0_def)
+   apply (rule tcb.expand)
+   apply clarsimp
+   apply (intro conjI)
+        apply (simp add: cthread_state_rel_imp_eq)
+       apply (simp add: cfault_rel_imp_eq)
+      apply (case_tac "tcbBoundNotification atcb'", case_tac "tcbBoundNotification atcb"; clarsimp)
+      apply (clarsimp split: option.splits)
+     apply (case_tac "tcbSchedPrev atcb'"; case_tac "tcbSchedPrev atcb"; clarsimp)
+       apply (force dest!: tcb_at_not_NULL)
+      apply (force dest!: tcb_at_not_NULL)
+     apply (force simp: tcb_ptr_to_ctcb_ptr_inj)
+    apply (case_tac "tcbSchedNext atcb'"; case_tac "tcbSchedNext atcb"; clarsimp)
+      apply (force dest!: tcb_at_not_NULL)
+     apply (force dest!: tcb_at_not_NULL)
+    apply (force simp: tcb_ptr_to_ctcb_ptr_inj)
+   apply (clarsimp simp: carch_tcb_relation_imp_eq)
+  apply auto
   done
 
 lemma tcb_queue_rel_clift_unique:
@@ -916,10 +984,6 @@ lemma is_aligned_no_overflow_0:
 abbreviation
   "is_aligned_opt x n \<equiv> case x of None \<Rightarrow> True | Some y \<Rightarrow> is_aligned y n"
 
-lemma tcb_ptr_to_ctcb_ptr_inj:
-  "tcb_ptr_to_ctcb_ptr x = tcb_ptr_to_ctcb_ptr y \<Longrightarrow> x = y"
-  by (auto simp: tcb_ptr_to_ctcb_ptr_def ctcb_offset_def)
-
 lemma option_to_ctcb_ptr_inj:
   "\<lbrakk> is_aligned_opt a tcbBlockSizeBits; is_aligned_opt b tcbBlockSizeBits \<rbrakk>
     \<Longrightarrow> (option_to_ctcb_ptr a = option_to_ctcb_ptr b) = (a = b)"
@@ -1218,8 +1282,8 @@ proof -
       apply (rule valid_objs'_aligned_vcpuTCB [OF valid_objs])
      apply (rule valid_objs'_aligned_vcpuTCB [OF valid_objs'])
     apply (drule (1) cpspace_tcb_relation_unique)
-       apply (fastforce intro: no_0_objs no_0_objs' valid_objs valid_objs')
-      apply (fastforce intro: no_0_objs no_0_objs' valid_objs valid_objs')
+       apply (fastforce intro: no_0_objs no_0_objs' valid_objs valid_objs')+
+      apply (fastforce intro: aligned distinct aligned' distinct')+
      apply (intro allI impI,elim exE conjE)
      apply (rule_tac p=p in map_to_ctes_tcb_ctes, assumption)
       apply (frule (1) map_to_ko_atI[OF _ aligned distinct])
@@ -1427,7 +1491,7 @@ where
     ksDomSchedule = cDomSchedule_to_H kernel_all_global_addresses.ksDomSchedule,
     ksCurDomain = ucast (ksCurDomain_' s),
     ksDomainTime = ksDomainTime_' s,
-    ksReadyQueues = cready_queues_to_H (clift (t_hrs_' s)) (ksReadyQueues_' s),
+    ksReadyQueues = cready_queues_to_H (ksReadyQueues_' s),
     ksReadyQueuesL1Bitmap = cbitmap_L1_to_H (ksReadyQueuesL1Bitmap_' s),
     ksReadyQueuesL2Bitmap = cbitmap_L2_to_H (ksReadyQueuesL2Bitmap_' s),
     ksCurThread = ctcb_ptr_to_tcb_ptr (ksCurThread_' s),
@@ -1449,16 +1513,16 @@ lemma trivial_eq_conj: "B = C \<Longrightarrow> (A \<and> B) = (A \<and> C)"
 lemma cstate_to_H_correct:
   assumes valid: "valid_state' as"
   assumes cstate_rel: "cstate_relation as cs"
+  assumes rdyqs: "ksReadyQueues_asrt as"
   shows "cstate_to_H cs = as \<lparr>ksMachineState:=  observable_memory (ksMachineState as) (user_mem' as)\<rparr>"
   apply (subgoal_tac "cstate_to_machine_H cs = observable_memory (ksMachineState as) (user_mem' as)")
    apply (rule kernel_state.equality, simp_all add: cstate_to_H_def)
-                      apply (rule cstate_to_pspace_H_correct)
+                    apply (rule cstate_to_pspace_H_correct)
                      using valid
                      apply (simp add: valid_state'_def)
                     using cstate_rel valid
                     apply (clarsimp simp: cstate_relation_def cpspace_relation_def Let_def
-                      observable_memory_def valid_state'_def
-                      valid_pspace'_def)
+                                          observable_memory_def valid_state'_def valid_pspace'_def)
                    using cstate_rel
                    apply (clarsimp simp: cstate_relation_def cpspace_relation_def Let_def prod_eq_iff)
                   using cstate_rel
@@ -1466,10 +1530,10 @@ lemma cstate_to_H_correct:
                  using valid cstate_rel
                  apply (rule mk_gsUntypedZeroRanges_correct)
                 subgoal
-                using cstate_rel
-                by (fastforce simp: cstate_relation_def cpspace_relation_def
-                                    Let_def ghost_size_rel_def unat_eq_0
-                            split: if_split)
+                  using cstate_rel
+                  by (fastforce simp: cstate_relation_def cpspace_relation_def
+                                      Let_def ghost_size_rel_def unat_eq_0
+                              split: if_split)
                using valid cstate_rel
                apply (rule cDomScheduleIdx_to_H_correct)
                using cstate_rel
@@ -1483,8 +1547,13 @@ lemma cstate_to_H_correct:
             using cstate_rel
             apply (clarsimp simp: cstate_relation_def Let_def)
            apply (rule cready_queues_to_H_correct)
-           using cstate_rel
-           apply (clarsimp simp: cstate_relation_def Let_def)
+               using cstate_rel rdyqs
+               apply (fastforce intro!: cready_queues_to_H_correct
+                                  simp: cstate_relation_def Let_def)
+              using valid apply (fastforce simp: valid_state'_def)
+             using rdyqs apply fastforce
+            using valid apply (fastforce simp: valid_state'_def)
+           using valid apply (fastforce simp: valid_state'_def)
           using cstate_rel
           apply (clarsimp simp: cstate_relation_def Let_def)
           using cstate_rel
diff --git a/proof/crefine/AARCH64/ArchMove_C.thy b/proof/crefine/AARCH64/ArchMove_C.thy
index 805de5eb17..e251a25afc 100644
--- a/proof/crefine/AARCH64/ArchMove_C.thy
+++ b/proof/crefine/AARCH64/ArchMove_C.thy
@@ -292,9 +292,6 @@ lemma asUser_getRegister_discarded:
                         return_def fail_def stateAssert_def)
   done
 
-crunches Arch.switchToThread
-  for valid_queues'[wp]: valid_queues'
-  (simp: crunch_simps wp: hoare_drop_imps crunch_wps getASID_wp)
 crunches switchToIdleThread
   for ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
 
@@ -312,10 +309,6 @@ lemma updateASIDPoolEntry_valid_pspace'[wp]:
   unfolding updateASIDPoolEntry_def valid_pspace'_def getPoolPtr_def
   by (wpsimp wp: getASID_wp)
 
-crunches switchToIdleThread, switchToThread
-  for valid_pspace'[wp]: valid_pspace'
-  (simp: whenE_def crunch_simps wp: crunch_wps hoare_drop_imps)
-
 lemma getMessageInfo_less_4:
   "\<lbrace>\<top>\<rbrace> getMessageInfo t \<lbrace>\<lambda>rv s. msgExtraCaps rv < 4\<rbrace>"
   including no_pre
@@ -454,8 +447,6 @@ lemma ko_at_vcpu_at'D:
 crunch pred_tcb_at'2[wp]: doMachineOp "\<lambda>s. P (pred_tcb_at' a b p s)"
   (simp: crunch_simps)
 
-crunch valid_queues'[wp]: readVCPUReg "\<lambda>s. valid_queues s"
-
 crunch valid_objs'[wp]: readVCPUReg "\<lambda>s. valid_objs' s"
 
 crunch sch_act_wf'[wp]: readVCPUReg "\<lambda>s. P (sch_act_wf (ksSchedulerAction s) s)"
diff --git a/proof/crefine/AARCH64/Arch_C.thy b/proof/crefine/AARCH64/Arch_C.thy
index b18268f950..999ce554fb 100644
--- a/proof/crefine/AARCH64/Arch_C.thy
+++ b/proof/crefine/AARCH64/Arch_C.thy
@@ -1421,7 +1421,7 @@ lemma performPageGetAddress_ccorres:
    apply clarsimp
    apply (rule conseqPre, vcg)
    apply clarsimp
-  apply (clarsimp simp: invs_no_0_obj' tcb_at_invs' invs_queues invs_valid_objs' invs_sch_act_wf'
+  apply (clarsimp simp: invs_no_0_obj' tcb_at_invs' invs_valid_objs' invs_sch_act_wf'
                         rf_sr_ksCurThread msgRegisters_unfold
                         seL4_MessageInfo_lift_def message_info_to_H_def mask_def)
   apply (cases isCall)
@@ -3246,13 +3246,14 @@ lemma decodeARMMMUInvocation_ccorres:
     apply (rule conjI; clarsimp)
     apply (frule invs_arch_state')
     apply (rule conjI, clarsimp simp: valid_arch_state'_def valid_asid_table'_def)
-    apply (clarsimp simp: neq_Nil_conv excaps_map_def valid_tcb_state'_def invs_queues
-                          invs_sch_act_wf'
+    apply (clarsimp simp: neq_Nil_conv excaps_map_def valid_tcb_state'_def invs_sch_act_wf'
                           unat_lt2p[where 'a=machine_word_len, folded word_bits_def])
     apply (frule interpret_excaps_eq[rule_format, where n=1], simp)
     apply (rule conjI; clarsimp)+
     apply (rule conjI, erule ctes_of_valid', clarsimp)
     apply (intro conjI)
+            apply fastforce
+           apply fastforce
           apply fastforce
          apply (fastforce elim!: pred_tcb'_weakenE)
         apply (clarsimp simp: st_tcb_at'_def obj_at'_def)
@@ -3269,15 +3270,17 @@ lemma decodeARMMMUInvocation_ccorres:
      apply (clarsimp simp: le_mask_asid_bits_helper)
     apply (simp add: is_aligned_shiftl_self)
    (* ARMASIDPoolAssign *)
-   apply (clarsimp simp: isCap_simps valid_tcb_state'_def invs_queues invs_sch_act_wf')
+   apply (clarsimp simp: isCap_simps valid_tcb_state'_def invs_sch_act_wf')
    apply (frule invs_arch_state', clarsimp)
    apply (intro conjI)
+         apply fastforce
         apply fastforce
-       apply (fastforce simp: ct_in_state'_def elim!: pred_tcb'_weakenE)
+       apply fastforce
       apply (fastforce simp: ct_in_state'_def elim!: pred_tcb'_weakenE)
-     apply (cases extraCaps; simp)
-     apply (clarsimp simp: excaps_in_mem_def slotcap_in_mem_def isPTCap'_def)
-    apply (simp add: valid_cap'_def)
+     apply (fastforce simp: ct_in_state'_def elim!: pred_tcb'_weakenE)
+    apply (cases extraCaps; simp)
+    apply (clarsimp simp: excaps_in_mem_def slotcap_in_mem_def isPTCap'_def)
+   apply (simp add: valid_cap'_def)
    apply (clarsimp simp: null_def neq_Nil_conv mask_def field_simps
                          asid_low_bits_word_bits asidInvalid_def asid_wf_def
                   dest!: filter_eq_ConsD)
@@ -3473,7 +3476,10 @@ lemma readVCPUReg_ccorres:
   apply fastforce
   done
 
-crunch st_tcb_at'[wp]: readVCPUReg "\<lambda>s. Q (st_tcb_at' P t s)"
+crunches readVCPUReg
+  for st_tcb_at'[wp]: "\<lambda>s. Q (st_tcb_at' P t s)"
+  and pspace_aligned'[wp]: "pspace_aligned'"
+  and pspace_distinct'[wp]: "pspace_distinct'"
   (wp: crunch_wps simp: crunch_simps)
 
 lemma invokeVCPUReadReg_ccorres: (* styled after invokeTCB_ReadRegisters_ccorres *)
@@ -3563,16 +3569,15 @@ lemma invokeVCPUReadReg_ccorres: (* styled after invokeTCB_ReadRegisters_ccorres
    apply clarsimp
    apply (rule conseqPre, vcg)
    apply clarsimp
-  apply (clarsimp simp: invs_no_0_obj' tcb_at_invs' invs_queues invs_valid_objs' invs_sch_act_wf'
+  apply (clarsimp simp: invs_no_0_obj' tcb_at_invs' invs_valid_objs' invs_sch_act_wf'
                         rf_sr_ksCurThread msgRegisters_unfold ThreadState_defs
                         seL4_MessageInfo_lift_def message_info_to_H_def mask_def)
   apply (cases isCall; clarsimp)
    apply (rule conjI, clarsimp simp: ct_in_state'_def st_tcb_at'_def comp_def)
-    apply (fastforce simp: obj_at'_def projectKOs)
-   apply (clarsimp simp: Kernel_C.badgeRegister_def AARCH64.badgeRegister_def
-                         AARCH64_H.badgeRegister_def C_register_defs)
+    apply (fastforce simp: obj_at'_def)
+   apply (clarsimp simp: AARCH64.badgeRegister_def AARCH64_H.badgeRegister_def C_register_defs)
    apply (simp add: rf_sr_def cstate_relation_def Let_def)
-  apply (rule conjI, clarsimp simp: pred_tcb_at'_def obj_at'_def projectKOs ct_in_state'_def)
+  apply (rule conjI, fastforce simp: pred_tcb_at'_def obj_at'_def ct_in_state'_def)
   apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def)
   done
 
@@ -3658,7 +3663,7 @@ lemma decodeVCPUWriteReg_ccorres:
    apply (vcg exspec=getSyscallArg_modifies)
 
   apply (clarsimp simp: word_less_nat_alt word_le_nat_alt conj_commute
-                        invs_no_0_obj' tcb_at_invs' invs_queues invs_valid_objs' invs_sch_act_wf'
+                        invs_no_0_obj' tcb_at_invs' invs_valid_objs' invs_sch_act_wf'
                         rf_sr_ksCurThread msgRegisters_unfold
                         valid_tcb_state'_def ThreadState_defs mask_def)
   apply (rule conjI; clarsimp) \<comment> \<open>not enough args\<close>
@@ -3913,7 +3918,7 @@ lemma decodeVCPUInjectIRQ_ccorres:
    apply (vcg exspec=getSyscallArg_modifies)
 
   apply (clarsimp simp: word_less_nat_alt word_le_nat_alt conj_commute
-                        invs_no_0_obj' tcb_at_invs' invs_queues invs_valid_objs' invs_sch_act_wf'
+                        invs_no_0_obj' tcb_at_invs' invs_valid_objs' invs_sch_act_wf'
                         rf_sr_ksCurThread msgRegisters_unfold
                         valid_tcb_state'_def ThreadState_defs mask_def)
 
@@ -4015,7 +4020,7 @@ lemma decodeVCPUReadReg_ccorres:
    apply (vcg exspec=getSyscallArg_modifies)
 
   apply (clarsimp simp: word_le_nat_alt conj_commute
-                        invs_no_0_obj' tcb_at_invs' invs_queues invs_valid_objs' invs_sch_act_wf'
+                        invs_no_0_obj' tcb_at_invs' invs_valid_objs' invs_sch_act_wf'
                         rf_sr_ksCurThread msgRegisters_unfold
                         valid_tcb_state'_def ThreadState_defs mask_def)
 
@@ -4119,8 +4124,9 @@ lemma decodeVCPUSetTCB_ccorres:
    apply vcg
 
   apply (clarsimp simp: word_less_nat_alt word_le_nat_alt conj_commute
-                        invs_no_0_obj' tcb_at_invs' invs_queues invs_valid_objs' invs_sch_act_wf'
+                        invs_no_0_obj' tcb_at_invs' invs_valid_objs' invs_sch_act_wf'
                         rf_sr_ksCurThread msgRegisters_unfold
+                        invs_pspace_aligned' invs_pspace_distinct'
                         valid_tcb_state'_def ThreadState_defs mask_def)
   apply (clarsimp simp: idButNot_def interpret_excaps_test_null
                         excaps_map_def neq_Nil_conv)
@@ -4272,18 +4278,15 @@ proof -
      (* Haskell side *)
      apply (clarsimp simp: excaps_in_mem_def slotcap_in_mem_def isCap_simps ctes_of_cte_at)
      apply (clarsimp simp: word_le_nat_alt conj_commute
-                           invs_no_0_obj' tcb_at_invs' invs_queues invs_valid_objs' invs_sch_act_wf'
+                           invs_no_0_obj' tcb_at_invs' invs_valid_objs' invs_sch_act_wf'
                            rf_sr_ksCurThread msgRegisters_unfold
-                           valid_tcb_state'_def mask_def
+                           valid_tcb_state'_def mask_def invs_pspace_aligned' invs_pspace_distinct'
                            valid_cap'_def ct_in_state'_def sysargs_rel_to_n st_tcb_at'_def comp_def
                            runnable'_eq)
      apply (fastforce elim: obj_at'_weakenE)
     (* C side *)
-    apply (clarsimp simp: word_le_nat_alt conj_commute
-                          invs_no_0_obj' tcb_at_invs' invs_queues invs_valid_objs' invs_sch_act_wf'
-                          rf_sr_ksCurThread msgRegisters_unfold
-                          valid_tcb_state'_def ThreadState_defs Kernel_C.maxIRQ_def
-                          and_mask_eq_iff_le_mask capVCPUPtr_eq)
+    apply (clarsimp simp: word_le_nat_alt rf_sr_ksCurThread msgRegisters_unfold
+                          Kernel_C.maxIRQ_def and_mask_eq_iff_le_mask capVCPUPtr_eq)
     apply (clarsimp simp:  mask_def)
     done
 qed
diff --git a/proof/crefine/AARCH64/Detype_C.thy b/proof/crefine/AARCH64/Detype_C.thy
index d63899c3f7..6e7d6055fb 100644
--- a/proof/crefine/AARCH64/Detype_C.thy
+++ b/proof/crefine/AARCH64/Detype_C.thy
@@ -1695,38 +1695,6 @@ proof -
     apply (simp add: cmap_relation_restrict_both_proj)
     done
 
-  moreover
-  from invs have "valid_queues s" ..
-  hence "\<And>p. \<forall>t \<in> set (ksReadyQueues s p). tcb_at' t s \<and> ko_wp_at' live' t s"
-    apply (clarsimp simp: valid_queues_def valid_queues_no_bitmap_def)
-    apply (drule spec, drule spec)
-    apply clarsimp
-    apply (drule (1) bspec)
-    apply (rule conjI)
-    apply (erule obj_at'_weakenE)
-    apply simp
-    apply (simp add: obj_at'_real_def)
-    apply (erule ko_wp_at'_weakenE)
-    apply (clarsimp simp: inQ_def live'_def)
-    done
-  hence tat: "\<And>p. \<forall>t \<in> set (ksReadyQueues s p). tcb_at' t s"
-    and  tlive: "\<And>p. \<forall>t \<in> set (ksReadyQueues s p). ko_wp_at' live' t s"
-    by auto
-  from sr have
-    "cready_queues_relation (clift ?th_s)
-        (ksReadyQueues_' (globals s')) (ksReadyQueues s)"
-    unfolding cready_queues_relation_def rf_sr_def cstate_relation_def
-              cpspace_relation_def
-    apply (clarsimp simp: Let_def all_conj_distrib)
-    apply (drule spec, drule spec, drule mp)
-    apply fastforce
-    apply ((subst lift_t_typ_region_bytes, rule cm_disj_tcb, assumption+,
-           simp_all add: objBits_simps pageBits_def)[1])+
-      \<comment> \<open>waiting ...\<close>
-    apply (simp add: tcb_queue_relation_live_restrict
-                     [OF D.valid_untyped tat tlive rl])
-    done
-
   moreover
   {
     assume "s' \<Turnstile>\<^sub>c armKSGlobalUserVSpace_Ptr "
diff --git a/proof/crefine/AARCH64/Fastpath_C.thy b/proof/crefine/AARCH64/Fastpath_C.thy
index 132cbee167..c39edefe45 100644
--- a/proof/crefine/AARCH64/Fastpath_C.thy
+++ b/proof/crefine/AARCH64/Fastpath_C.thy
@@ -39,11 +39,10 @@ lemma getEndpoint_obj_at':
 lemmas setEndpoint_obj_at_tcb' = setEndpoint_obj_at'_tcb
 
 lemma tcbSchedEnqueue_tcbContext[wp]:
-  "\<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>
-     tcbSchedEnqueue t'
-   \<lbrace>\<lambda>rv. obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
-  apply (rule tcbSchedEnqueue_obj_at_unchangedT[OF all_tcbI])
-  apply simp
+  "tcbSchedEnqueue t' \<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
+  apply (simp add: tcbSchedEnqueue_def tcbQueuePrepend_def unless_when)
+  apply (wp threadSet_obj_at' hoare_drop_imps threadGet_wp
+         | simp split: if_split)+
   done
 
 lemma setCTE_tcbContext:
@@ -55,20 +54,16 @@ lemma setCTE_tcbContext:
   done
 
 lemma setThreadState_tcbContext:
- "\<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>
-    setThreadState a b
-  \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
-  apply (rule setThreadState_obj_at_unchanged)
-  apply (clarsimp simp: atcbContext_def)+
-  done
+ "setThreadState a b \<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
+  unfolding setThreadState_def rescheduleRequired_def tcbSchedEnqueue_def
+            tcbQueuePrepend_def rescheduleRequired_def
+  by (wp threadSet_obj_at' hoare_drop_imps threadGet_wp | wpc
+         | simp split: if_split)+
 
 lemma setBoundNotification_tcbContext:
- "\<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>
-    setBoundNotification a b
-  \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
-  apply (rule setBoundNotification_obj_at_unchanged)
-  apply (clarsimp simp: atcbContext_def)+
-  done
+ "setBoundNotification a b \<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
+  unfolding setBoundNotification_def
+  by wpsimp
 
 declare comp_apply [simp del]
 crunch tcbContext[wp]: deleteCallerCap "obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t"
@@ -756,10 +751,13 @@ lemma switchToThread_fp_ccorres:
     apply (rule ccorres_assert2)
     apply csymbr
     apply (ctac (no_vcg) add: armv_contextSwitch_HWASID_ccorres[where vmid=vmid])
+     apply (clarsimp simp: setCurThread_def)
+     apply (rule ccorres_stateAssert)
      apply (rule_tac P=\<top> and P'=UNIV in ccorres_from_vcg)
      apply (clarsimp, rule conseqPre, vcg)
      apply (clarsimp simp: setCurThread_def simpler_modify_def rf_sr_def cstate_relation_def
                            Let_def carch_state_relation_def cmachine_state_relation_def)
+    apply (wp hoare_drop_imp)
    apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift')+
 
   apply (rule conjI)
@@ -1209,8 +1207,8 @@ lemma fastpath_dequeue_ccorres:
   apply (rule conjI)
    apply (clarsimp simp: cpspace_relation_def update_ep_map_tos
                          update_tcb_map_tos typ_heap_simps')
-   apply (rule conjI, erule ctcb_relation_null_queue_ptrs)
-    apply (rule ext, simp add: tcb_null_queue_ptrs_def
+   apply (rule conjI, erule ctcb_relation_null_ep_ptrs)
+    apply (rule ext, simp add: tcb_null_ep_ptrs_def
                      split: if_split)
    apply (rule conjI)
     apply (rule cpspace_relation_ep_update_ep, assumption+)
@@ -1226,8 +1224,6 @@ lemma fastpath_dequeue_ccorres:
   apply (simp add: carch_state_relation_def typ_heap_simps'
                    cmachine_state_relation_def h_t_valid_clift_Some_iff
                    update_ep_map_tos)
-  apply (erule cready_queues_relation_null_queue_ptrs)
-  apply (rule ext, simp add: tcb_null_ep_ptrs_def split: if_split)
   done
 
 lemma st_tcb_at_not_in_ep_queue:
@@ -1368,8 +1364,8 @@ lemma fastpath_enqueue_ccorres:
    apply (rule conjI)
     apply (clarsimp simp: cpspace_relation_def update_ep_map_tos
                           typ_heap_simps')
-    apply (rule conjI, erule ctcb_relation_null_queue_ptrs)
-     apply (rule ext, simp add: tcb_null_queue_ptrs_def
+    apply (rule conjI, erule ctcb_relation_null_ep_ptrs)
+     apply (rule ext, simp add: tcb_null_ep_ptrs_def
                          split: if_split)
     apply (rule conjI)
      apply (rule_tac S="tcb_ptr_to_ctcb_ptr ` set (ksCurThread \<sigma> # list)"
@@ -1408,8 +1404,6 @@ lemma fastpath_enqueue_ccorres:
            auto dest!: map_to_ko_atI)[1]
    apply (simp add: carch_state_relation_def typ_heap_simps' update_ep_map_tos
                     cmachine_state_relation_def h_t_valid_clift_Some_iff)
-   apply (erule cready_queues_relation_null_queue_ptrs)
-   apply (rule ext, simp add: tcb_null_ep_ptrs_def split: if_split)
   apply (clarsimp simp: typ_heap_simps' EPState_Recv_def mask_def
                         is_aligned_weaken[OF is_aligned_tcb_ptr_to_ctcb_ptr])
   apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def)
@@ -1418,8 +1412,8 @@ lemma fastpath_enqueue_ccorres:
   apply (rule conjI)
    apply (clarsimp simp: cpspace_relation_def update_ep_map_tos
                          typ_heap_simps' ct_in_state'_def)
-   apply (rule conjI, erule ctcb_relation_null_queue_ptrs)
-    apply (rule ext, simp add: tcb_null_queue_ptrs_def
+   apply (rule conjI, erule ctcb_relation_null_ep_ptrs)
+    apply (rule ext, simp add: tcb_null_ep_ptrs_def
                         split: if_split)
    apply (rule conjI)
     apply (rule_tac S="{tcb_ptr_to_ctcb_ptr (ksCurThread \<sigma>)}"
@@ -1439,8 +1433,6 @@ lemma fastpath_enqueue_ccorres:
           assumption+, auto dest!: map_to_ko_atI)[1]
   apply (simp add: carch_state_relation_def typ_heap_simps' update_ep_map_tos
                    cmachine_state_relation_def h_t_valid_clift_Some_iff)
-  apply (erule cready_queues_relation_null_queue_ptrs)
-  apply (rule ext, simp add: tcb_null_ep_ptrs_def split: if_split)
   done
 
 lemma setCTE_rf_sr:
@@ -2255,9 +2247,6 @@ proof -
                                 apply (erule cmap_relation_updI, erule ko_at_projectKO_opt)
                                  apply (simp add: ctcb_relation_def cthread_state_relation_def)
                                 apply simp
-                               apply (rule conjI, erule cready_queues_relation_not_queue_ptrs)
-                                 apply (rule ext, simp split: if_split add: typ_heap_simps')
-                                apply (rule ext, simp split: if_split add: typ_heap_simps')
                                apply (simp add: carch_state_relation_def cmachine_state_relation_def
                                                 typ_heap_simps' map_comp_update projectKO_opt_tcb
                                                 cvariable_relation_upd_const ko_at_projectKO_opt)
@@ -2381,9 +2370,6 @@ proof -
                                             apply (erule cmap_relation_updI, erule ko_at_projectKO_opt)
                                             apply (simp add: ctcb_relation_def cthread_state_relation_def)
                                             apply simp
-                                            apply (rule conjI, erule cready_queues_relation_not_queue_ptrs)
-                                            apply (rule ext, simp split: if_split)
-                                            apply (rule ext, simp split: if_split)
                                             apply (simp add: carch_state_relation_def cmachine_state_relation_def
                                                              typ_heap_simps' map_comp_update projectKO_opt_tcb
                                                              cvariable_relation_upd_const ko_at_projectKO_opt)
@@ -3154,9 +3140,6 @@ proof -
                                                      ThreadState_defs)
                                     apply (clarsimp simp: ccap_relation_ep_helpers)
                                    apply simp
-                                  apply (rule conjI, erule cready_queues_relation_not_queue_ptrs)
-                                    apply (rule ext, simp split: if_split)
-                                   apply (rule ext, simp split: if_split)
                                   apply (simp add: carch_state_relation_def cmachine_state_relation_def
                                                    typ_heap_simps' map_comp_update projectKO_opt_tcb
                                                    cvariable_relation_upd_const ko_at_projectKO_opt)
@@ -3236,9 +3219,6 @@ proof -
                                                apply (erule cmap_relation_updI, erule ko_at_projectKO_opt)
                                                 apply (simp add: ctcb_relation_def cthread_state_relation_def)
                                                apply simp
-                                              apply (rule conjI, erule cready_queues_relation_not_queue_ptrs)
-                                                apply (rule ext, simp split: if_split)
-                                               apply (rule ext, simp split: if_split)
                                               apply (simp add: carch_state_relation_def cmachine_state_relation_def
                                                                typ_heap_simps' map_comp_update projectKO_opt_tcb
                                                                cvariable_relation_upd_const ko_at_projectKO_opt)
@@ -3382,8 +3362,6 @@ proof -
      apply (clarsimp simp: invs_ksCurDomain_maxDomain')
      apply (rename_tac cur_tcb cte)
      apply (frule invs_valid_objs')
-     apply (frule invs_queues)
-     apply (clarsimp simp: valid_queues_def)
      apply (frule tcbs_of_aligned')
       apply (simp add: invs_pspace_aligned')
      apply (frule tcbs_of_cte_wp_at_caller)
@@ -3406,14 +3384,19 @@ proof -
       apply (solves \<open>clarsimp simp: wellformed_mapdata'_def\<close>)
      apply (frule_tac tcb=tcb in tcbs_of_valid_tcb'[OF invs_valid_objs', rotated], simp)
      apply (clarsimp simp add: valid_tcb'_def)
+     apply (frule invs_valid_objs')
+     apply (frule invs_valid_bitmaps)
+     apply (frule valid_bitmaps_bitmapQ_no_L1_orphans)
+     apply (frule invs_pspace_aligned')
+     apply (frule invs_pspace_distinct')
+     apply clarsimp
      apply (rule conjI; clarsimp?) (* canonical_address (capEPPtr (cteCap ctea)) *)
       apply (clarsimp simp: obj_at'_is_canonical dest!: invs_pspace_canonical')
      apply (clarsimp simp: isCap_simps valid_cap'_def[split_simps capability.split]
                            maskCapRights_def cte_wp_at_ctes_of cte_level_bits_def)
      apply (frule_tac p=a in ctes_of_valid', clarsimp)
-     apply (simp add: valid_cap_simps')
      apply (frule invs_mdb')
-     apply (rule conjI, solves clarsimp)+ (* a bunch of consequences of invs' *)
+     apply (simp add: valid_cap_simps')
      apply (clarsimp simp: cte_wp_at_ctes_of cte_level_bits_def
                            makeObject_cte isValidVTableRoot_def
                            to_bool_def
@@ -3426,7 +3409,6 @@ proof -
       apply (clarsimp simp: asid_has_vmid_def asid_has_entry_def)
        apply (case_tac asid_entry, fastforce)
      apply (frule ko_at_valid_ep', fastforce)
-     apply (frule invs_mdb')
      apply (safe del: notI disjE)[1]
        apply (simp add: isSendEP_def valid_ep'_def tcb_at_invs'
                  split: Structures_H.endpoint.split_asm)
diff --git a/proof/crefine/AARCH64/Fastpath_Equiv.thy b/proof/crefine/AARCH64/Fastpath_Equiv.thy
index 20bbbb6f91..c63144c57e 100644
--- a/proof/crefine/AARCH64/Fastpath_Equiv.thy
+++ b/proof/crefine/AARCH64/Fastpath_Equiv.thy
@@ -31,13 +31,9 @@ lemma getEndpoint_obj_at':
 
 lemmas setEndpoint_obj_at_tcb' = setEndpoint_obj_at'_tcb
 
-lemma tcbSchedEnqueue_tcbContext[wp]:
-  "\<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>
-     tcbSchedEnqueue t'
-   \<lbrace>\<lambda>rv. obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
-  apply (rule tcbSchedEnqueue_obj_at_unchangedT[OF all_tcbI])
-  apply simp
-  done
+crunches tcbSchedEnqueue
+  for tcbContext[wp]: "obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t"
+  (simp: tcbQueuePrepend_def)
 
 lemma setCTE_tcbContext:
   "\<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>
@@ -50,19 +46,17 @@ lemma setCTE_tcbContext:
 context begin interpretation Arch . (*FIXME: arch_split*)
 
 lemma setThreadState_tcbContext:
- "\<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>
-    setThreadState a b
-  \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
-  apply (rule setThreadState_obj_at_unchanged)
-  apply (clarsimp simp: atcbContext_def)+
+ "setThreadState st tptr \<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
+  unfolding setThreadState_def rescheduleRequired_def
+  apply (wpsimp wp: threadSet_wp hoare_drop_imps)
+  apply (fastforce simp: obj_at'_def objBits_simps projectKOs  atcbContext_def ps_clear_upd)
   done
 
 lemma setBoundNotification_tcbContext:
- "\<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>
-    setBoundNotification a b
-  \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
-  apply (rule setBoundNotification_obj_at_unchanged)
-  apply (clarsimp simp: atcbContext_def)+
+ "setBoundNotification ntfnPtr tptr \<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
+  unfolding setBoundNotification_def
+  apply (wpsimp wp: threadSet_wp hoare_drop_imps)
+  apply (fastforce simp: obj_at'_def objBits_simps projectKOs)
   done
 
 declare comp_apply [simp del]
@@ -508,6 +502,34 @@ lemma setThreadState_runnable_bitmap_inv:
 crunches curDomain
   for (no_fail) no_fail[intro!, wp, simp]
 
+lemma setThreadState_tcbDomain_tcbPriority_obj_at'[wp]:
+  "setThreadState ts t \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb) (tcbPriority tcb)) t'\<rbrace>"
+  unfolding setThreadState_def rescheduleRequired_def tcbSchedEnqueue_def tcbQueuePrepend_def
+  apply (wpsimp wp: threadSet_wp hoare_drop_imps threadGet_wp simp: setQueue_def bitmap_fun_defs)
+  apply (fastforce simp: obj_at'_def st_tcb_at'_def objBits_simps)
+  done
+
+lemma setThreadState_tcbQueued_obj_at'[wp]:
+  "setThreadState ts t \<lbrace>obj_at' (\<lambda>tcb. P (tcbQueued tcb)) t'\<rbrace>"
+  unfolding setThreadState_def rescheduleRequired_def tcbSchedEnqueue_def tcbQueuePrepend_def
+  apply (wpsimp wp: threadSet_wp hoare_drop_imps threadGet_wp simp: setQueue_def bitmap_fun_defs)
+  apply (fastforce simp: obj_at'_def st_tcb_at'_def objBits_simps)
+  done
+
+lemma setThreadState_tcbFault_obj_at'[wp]:
+  "setThreadState ts t \<lbrace>obj_at' (\<lambda>tcb. P (tcbFault tcb)) t'\<rbrace>"
+  unfolding setThreadState_def rescheduleRequired_def tcbSchedEnqueue_def tcbQueuePrepend_def
+  apply (wpsimp wp: threadSet_wp hoare_drop_imps threadGet_wp simp: setQueue_def bitmap_fun_defs)
+  apply (fastforce simp: obj_at'_def st_tcb_at'_def objBits_simps)
+  done
+
+lemma setThreadState_tcbArch_obj_at'[wp]:
+  "setThreadState ts t \<lbrace>obj_at' (\<lambda>tcb. P (tcbArch tcb)) t'\<rbrace>"
+  unfolding setThreadState_def rescheduleRequired_def tcbSchedEnqueue_def tcbQueuePrepend_def
+  apply (wpsimp wp: threadSet_wp hoare_drop_imps threadGet_wp simp: setQueue_def bitmap_fun_defs)
+  apply (fastforce simp: obj_at'_def st_tcb_at'_def objBits_simps)
+  done
+
 (* FIXME AARCH64 MOVE *)
 lemma setRegister_simple_modify_registers:
   "setRegister r v = (\<lambda>con. ({((), modify_registers (\<lambda>f. f(r := v)) con)}, False))"
@@ -581,7 +603,8 @@ lemma fastpath_callKernel_SysCall_corres:
   "monadic_rewrite True False
          (invs' and ct_in_state' ((=) Running)
                 and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)
-                and (\<lambda>s. ksDomainTime s \<noteq> 0))
+                and (\<lambda>s. ksDomainTime s \<noteq> 0)
+                and ready_qs_runnable)
      (callKernel (SyscallEvent SysCall)) (fastpaths SysCall)"
   supply if_cong[cong] option.case_cong[cong] if_split[split del]
   supply empty_fail_getMRs[wp] (* FIXME *)
@@ -763,22 +786,18 @@ lemma fastpath_callKernel_SysCall_corres:
                            apply wp[1]
                           apply (simp cong: if_cong HOL.conj_cong add: if_bool_simps)
                           apply (simp_all only:)[5]
-                          apply ((wp setThreadState_oa_queued[of _ "\<lambda>a _ _. \<not> a"]
-                                     setThreadState_obj_at_unchanged
-                                     asUser_obj_at_unchanged mapM_x_wp'
+                          apply ((wp asUser_obj_at_unchanged mapM_x_wp'
                                      sts_st_tcb_at'_cases
                                      setThreadState_no_sch_change
                                      setEndpoint_obj_at_tcb'
                                      fastpathBestSwitchCandidate_lift[where f="setThreadState f t" for f t]
-                                     setThreadState_oa_queued
                                      fastpathBestSwitchCandidate_lift[where f="asUser t f" for f t]
                                      fastpathBestSwitchCandidate_lift[where f="setEndpoint a b" for a b]
                                      lookupBitmapPriority_lift
                                      setThreadState_runnable_bitmap_inv
                                      getEndpoint_obj_at'
-                                   | simp add: setMessageInfo_def
+                                   | simp add: setMessageInfo_def obj_at'_conj
                                    | wp (once) hoare_vcg_disj_lift)+)
-
                    apply (simp add: setThreadState_runnable_simp
                                     getThreadCallerSlot_def getThreadReplySlot_def
                                     locateSlot_conv bind_assoc)
@@ -899,8 +918,10 @@ lemma fastpath_callKernel_SysCall_corres:
   apply (prop_tac "ksCurThread s \<noteq> blockedThread")
    apply normalise_obj_at'
   apply clarsimp
-  apply (frule_tac t="blockedThread" in valid_queues_not_runnable_not_queued, assumption)
-   subgoal by (fastforce simp: st_tcb_at'_def elim: obj_at'_weakenE)
+  apply (extract_conjunct \<open>match conclusion in "\<not> tcbQueued _" \<Rightarrow> -\<close>)
+   apply (clarsimp simp: ready_qs_runnable_def)
+   apply (drule_tac x=blockedThread in spec)
+   apply (solves \<open>clarsimp simp: obj_at'_def st_tcb_at'_def objBits_simps\<close>)
   apply (prop_tac "fastpathBestSwitchCandidate blockedThread s")
    apply (rule_tac ttcb=tcbb and ctcb=tcb in fastpathBestSwitchCandidateI)
      apply (solves \<open>simp only: disj_ac\<close>)
@@ -1064,14 +1085,15 @@ crunch tcbContext[wp]: possibleSwitchTo "obj_at' (\<lambda>tcb. P ( (atcbContext
 crunch only_cnode_caps[wp]: doFaultTransfer "\<lambda>s. P (only_cnode_caps (ctes_of s))"
   (wp: crunch_wps simp: crunch_simps)
 
+(* FIXME: monadic_rewrite_l does not work with stateAssert here *)
 lemma tcbSchedDequeue_rewrite_not_queued:
   "monadic_rewrite True False (tcb_at' t and obj_at' (Not \<circ> tcbQueued) t)
      (tcbSchedDequeue t) (return ())"
-  apply (simp add: tcbSchedDequeue_def when_def)
-  apply (monadic_rewrite_l monadic_rewrite_if_l_False \<open>wp threadGet_const\<close>)
-   apply (monadic_rewrite_symb_exec_l, rule monadic_rewrite_refl)
-   apply wp+
-  apply (clarsimp simp: o_def obj_at'_def)
+  apply (simp add: tcbSchedDequeue_def)
+  apply monadic_rewrite_symb_exec_l
+    apply (monadic_rewrite_symb_exec_l_known False, simp)
+     apply (rule monadic_rewrite_refl)
+    apply (wpsimp wp: threadGet_const)+
   done
 
 lemma schedule_known_rewrite:
@@ -1110,7 +1132,7 @@ lemma schedule_known_rewrite:
                             \<open>wpsimp wp: Arch_switchToThread_obj_at_pre\<close>)
    (* remove no-ops *)
    apply simp
-   apply (repeat 9 \<open>rule monadic_rewrite_symb_exec_l\<close>) (* until switchToThread *)
+   apply (repeat 13 \<open>rule monadic_rewrite_symb_exec_l\<close>) (* until switchToThread *)
                               apply (rule monadic_rewrite_refl)
                              apply (wpsimp simp: isHighestPrio_def')+
   apply (clarsimp simp: ct_in_state'_def not_pred_tcb_at'_strengthen
@@ -1372,18 +1394,12 @@ crunches setThreadState, emptySlot, asUser
   (wp: obj_at_setObject2 crunch_wps
    simp: crunch_simps updateObject_default_def in_monad)
 
-lemma st_tcb_at_is_Reply_imp_not_tcbQueued: "\<And>s t.\<lbrakk> invs' s; st_tcb_at' isReply t s\<rbrakk> \<Longrightarrow> obj_at' (\<lambda>a. \<not> tcbQueued a) t s"
-  apply (clarsimp simp: invs'_def valid_state'_def valid_queues_def st_tcb_at'_def valid_queues_no_bitmap_def)
-  apply (rule all_prio_not_inQ_not_tcbQueued)
-  apply (clarsimp simp: obj_at'_def)
-  apply (erule_tac x="d" in allE)
-  apply (erule_tac x="p" in allE)
-  apply (erule conjE)
-  apply (erule_tac x="t" in ballE)
-   apply (clarsimp simp: obj_at'_def runnable'_def isReply_def)
-   apply (case_tac "tcbState obj")
-          apply ((clarsimp simp: inQ_def)+)[8]
-  apply (clarsimp simp: valid_queues'_def obj_at'_def)
+lemma st_tcb_at_is_Reply_imp_not_tcbQueued:
+  "\<And>s t. \<lbrakk> ready_qs_runnable s; st_tcb_at' isReply t s\<rbrakk>  \<Longrightarrow> obj_at' (\<lambda>tcb. \<not> tcbQueued tcb) t s"
+  apply (clarsimp simp: ready_qs_runnable_def)
+  apply (drule_tac x=t in spec)
+  apply (clarsimp simp: st_tcb_at'_def obj_at'_def isReply_def)
+  apply (case_tac "tcbState obj"; clarsimp)
   done
 
 lemma valid_objs_ntfn_at_tcbBoundNotification:
@@ -1439,7 +1455,7 @@ lemma tcbSchedEnqueue_tcbIPCBuffer:
   "\<lbrace>obj_at' (\<lambda>tcb. P (tcbIPCBuffer tcb)) t\<rbrace>
   tcbSchedEnqueue t'
   \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P (tcbIPCBuffer tcb)) t\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_when)
+  apply (simp add: tcbSchedEnqueue_def tcbQueuePrepend_def unless_when)
   apply (wp threadSet_obj_at' hoare_drop_imps threadGet_wp
         |simp split: if_split)+
   done
@@ -1487,11 +1503,21 @@ lemma monadic_rewrite_fail:
   "monadic_rewrite True E \<top> fail g"
   by (simp add: monadic_rewrite_def)
 
+lemma threadSet_tcb_at'[wp]:
+  "threadSet f t' \<lbrace>\<lambda>s. P (tcb_at' addr s)\<rbrace>"
+  apply (wpsimp wp: threadSet_wp)
+  apply (erule rsubst[where P=P])
+  by (clarsimp simp: obj_at'_def ps_clear_upd objBits_simps)
+
+crunches rescheduleRequired, tcbSchedDequeue, setThreadState, setBoundNotification
+  for tcb''[wp]: "\<lambda>s. P (tcb_at' addr s)"
+  (wp: crunch_wps)
+
 (* FIXME AARCH64 pick up commentary and cleanup from fastpath_callKernel_SysCall_corres *)
 lemma fastpath_callKernel_SysReplyRecv_corres:
   "monadic_rewrite True False
      (invs' and ct_in_state' ((=) Running) and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)
-         and cnode_caps_gsCNodes')
+         and cnode_caps_gsCNodes' and ready_qs_runnable)
      (callKernel (SyscallEvent SysReplyRecv)) (fastpaths SysReplyRecv)"
   including classic_wp_pre
   supply if_cong[cong] option.case_cong[cong]
@@ -1630,8 +1656,7 @@ lemma fastpath_callKernel_SysReplyRecv_corres:
                                             and thread=thread in possibleSwitchTo_rewrite))
                            | rule cteDeleteOne_replycap_rewrite
                            | rule monadic_rewrite_bind monadic_rewrite_refl
-                           | wp assert_inv mapM_x_wp'
-                                setThreadState_obj_at_unchanged
+                           | wp assert_inv mapM_x_wp' sts_valid_objs'
                                 asUser_obj_at_unchanged
                                 hoare_strengthen_post[OF _ obj_at_conj'[simplified atomize_conjL], rotated]
                                  lookupBitmapPriority_lift
@@ -1697,8 +1722,8 @@ lemma fastpath_callKernel_SysReplyRecv_corres:
                                | wps)+)[3]
                     apply (simp cong: rev_conj_cong)
                     apply (wpsimp wp: setThreadState_tcbContext[simplified comp_apply]
-                                      setThreadState_oa_queued user_getreg_rv
-                                      setThreadState_no_sch_change setThreadState_obj_at_unchanged
+                                      user_getreg_rv
+                                      setThreadState_no_sch_change sts_valid_objs'
                                       sts_st_tcb_at'_cases sts_bound_tcb_at'
                                       fastpathBestSwitchCandidate_lift[where f="setThreadState s t" for s t]
                                       hoare_weak_lift_imp hoare_vcg_all_lift hoare_vcg_imp_lift
@@ -1706,8 +1731,7 @@ lemma fastpath_callKernel_SysReplyRecv_corres:
                                       hoare_vcg_ex_lift
                           | wps)+
                            apply (strengthen imp_consequent[where Q="tcb_at' t s" for t s])
-                           apply ((wp setThreadState_oa_queued user_getreg_rv setThreadState_no_sch_change
-                                      setThreadState_obj_at_unchanged
+                           apply ((wp user_getreg_rv setThreadState_no_sch_change
                                       sts_st_tcb_at'_cases sts_bound_tcb_at'
                                       emptySlot_obj_at'_not_queued emptySlot_obj_at_ep
                                       emptySlot_tcbContext[simplified comp_apply]
@@ -1893,7 +1917,9 @@ lemma fastpath_callKernel_SysReplyRecv_corres:
   apply (clarsimp simp: obj_at_tcbs_of tcbSlots
                         cte_level_bits_def)
   apply (frule(1) st_tcb_at_is_Reply_imp_not_tcbQueued)
-  apply (auto simp: obj_at_tcbs_of tcbSlots
+  apply (frule invs_pspace_aligned')
+  apply (frule invs_pspace_distinct')
+  apply (auto simp: obj_at_tcbs_of tcbSlots projectKOs
                         cte_level_bits_def)
   done
 
diff --git a/proof/crefine/AARCH64/Finalise_C.thy b/proof/crefine/AARCH64/Finalise_C.thy
index cf996daaca..4dcda90638 100644
--- a/proof/crefine/AARCH64/Finalise_C.thy
+++ b/proof/crefine/AARCH64/Finalise_C.thy
@@ -18,6 +18,108 @@ declare if_split [split del]
 definition
   "option_map2 f m = option_map f \<circ> m"
 
+definition ksReadyQueues_head_end_2 :: "(domain \<times> priority \<Rightarrow> ready_queue) \<Rightarrow> bool" where
+  "ksReadyQueues_head_end_2 qs \<equiv>
+     \<forall>d p. tcbQueueHead (qs (d, p)) \<noteq> None \<longleftrightarrow> tcbQueueEnd (qs (d, p)) \<noteq> None"
+
+abbreviation "ksReadyQueues_head_end s \<equiv> ksReadyQueues_head_end_2 (ksReadyQueues s)"
+
+lemmas ksReadyQueues_head_end_def = ksReadyQueues_head_end_2_def
+
+lemma ksReadyQueues_asrt_ksReadyQueues_head_end:
+  "ksReadyQueues_asrt s \<Longrightarrow> ksReadyQueues_head_end s"
+  by (fastforce dest: tcbQueueHead_iff_tcbQueueEnd
+                simp: ready_queue_relation_def ksReadyQueues_asrt_def ksReadyQueues_head_end_def)
+
+lemma tcbSchedEnqueue_ksReadyQueues_head_end[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>ksReadyQueues_head_end\<rbrace>"
+  unfolding tcbSchedEnqueue_def tcbQueuePrepend_def setQueue_def
+  apply (wpsimp wp: threadSet_wp threadGet_wp simp: bitmap_fun_defs)
+  apply (clarsimp simp: tcbQueueEmpty_def obj_at'_def ksReadyQueues_head_end_def split: if_splits)
+  done
+
+lemma ksReadyQueues_head_end_ksSchedulerAction_update[simp]:
+  "ksReadyQueues_head_end (s\<lparr>ksSchedulerAction := ChooseNewThread\<rparr>) = ksReadyQueues_head_end s"
+  by (simp add: ksReadyQueues_head_end_def)
+
+crunches rescheduleRequired
+  for ksReadyQueues_head_end[wp]: ksReadyQueues_head_end
+
+lemma setThreadState_ksReadyQueues_head_end[wp]:
+  "setThreadState ts tcbPtr \<lbrace>ksReadyQueues_head_end\<rbrace>"
+  unfolding setThreadState_def
+  by (wpsimp wp: threadSet_wp threadGet_wp simp: bitmap_fun_defs)
+
+definition ksReadyQueues_head_end_tcb_at'_2 ::
+  "(domain \<times> priority \<Rightarrow> ready_queue) \<Rightarrow> (obj_ref \<rightharpoonup> tcb) \<Rightarrow> bool" where
+  "ksReadyQueues_head_end_tcb_at'_2 qs tcbs \<equiv>
+     \<forall>d p. (\<forall>head. tcbQueueHead (qs (d, p)) = Some head \<longrightarrow> tcbs head \<noteq> None)
+           \<and> (\<forall>end. tcbQueueEnd (qs (d, p)) = Some end \<longrightarrow> tcbs end \<noteq> None)"
+
+abbreviation "ksReadyQueues_head_end_tcb_at' s \<equiv>
+  ksReadyQueues_head_end_tcb_at'_2 (ksReadyQueues s) (tcbs_of' s)"
+
+lemmas ksReadyQueues_head_end_tcb_at'_def = ksReadyQueues_head_end_tcb_at'_2_def
+
+lemma ksReadyQueues_asrt_ksReadyQueues_head_end_tcb_at':
+  "\<lbrakk>ksReadyQueues_asrt s; pspace_aligned' s; pspace_distinct' s\<rbrakk>
+   \<Longrightarrow> ksReadyQueues_head_end_tcb_at' s"
+  apply (clarsimp simp: ready_queue_relation_def ksReadyQueues_asrt_def
+                        ksReadyQueues_head_end_tcb_at'_def)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply (clarsimp simp: list_queue_relation_def)
+  apply (intro conjI impI allI)
+   apply (case_tac "ts = []", clarsimp)
+   apply (fastforce dest!: heap_path_head hd_in_set
+                     simp: opt_pred_def  tcbQueueEmpty_def split: option.splits)
+  apply (fastforce simp: queue_end_valid_def opt_pred_def tcbQueueEmpty_def
+                  split: option.splits)
+  done
+
+lemma tcbSchedEnqueue_ksReadyQueues_head_end_tcb_at'[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>ksReadyQueues_head_end_tcb_at'\<rbrace>"
+  unfolding tcbSchedEnqueue_def tcbQueuePrepend_def setQueue_def
+  apply (wpsimp wp: threadSet_wp threadGet_wp simp: bitmap_fun_defs)
+  apply (clarsimp simp: ksReadyQueues_head_end_tcb_at'_def split: if_splits)
+  done
+
+lemma ksReadyQueues_head_end_tcb_at'_ksSchedulerAction_update[simp]:
+  "ksReadyQueues_head_end_tcb_at' (s\<lparr>ksSchedulerAction := ChooseNewThread\<rparr>)
+   = ksReadyQueues_head_end_tcb_at' s"
+  by (simp add: ksReadyQueues_head_end_tcb_at'_def)
+
+crunches rescheduleRequired
+  for ksReadyQueues_head_end_tcb_at'[wp]: ksReadyQueues_head_end_tcb_at'
+
+lemma setThreadState_ksReadyQueues_head_end_tcb_at'[wp]:
+  "setThreadState ts tcbPtr \<lbrace>ksReadyQueues_head_end_tcb_at'\<rbrace>"
+  unfolding setThreadState_def
+  apply (wpsimp wp: threadSet_wp)
+  apply (fastforce simp: ksReadyQueues_head_end_tcb_at'_def split: if_splits)
+  done
+
+lemma head_end_ksReadyQueues_':
+  "\<lbrakk> (s, s') \<in> rf_sr; ksReadyQueues_head_end s; ksReadyQueues_head_end_tcb_at' s;
+     pspace_aligned' s; pspace_distinct' s;
+     d \<le> maxDomain; p \<le> maxPriority \<rbrakk>
+   \<Longrightarrow> head_C (index (ksReadyQueues_' (globals s')) (cready_queues_index_to_C d p)) = NULL
+       \<longleftrightarrow> end_C (index (ksReadyQueues_' (globals s')) (cready_queues_index_to_C d p)) = NULL"
+  apply (frule (2) rf_sr_ctcb_queue_relation[where d=d and p=p])
+  apply (clarsimp simp: ksReadyQueues_head_end_def)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply (clarsimp simp: ksReadyQueues_head_end_tcb_at'_def)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply (clarsimp simp: ctcb_queue_relation_def option_to_ctcb_ptr_def split: option.splits)
+  apply (rename_tac "end" head end_tcb head_tcb)
+  apply (prop_tac "tcb_at' head s \<and> tcb_at' end s")
+   apply (fastforce intro!: aligned'_distinct'_ko_wp_at'I
+                      simp: obj_at'_real_def opt_map_def split: option.splits)
+  apply (fastforce dest: tcb_at_not_NULL)
+  done
+
 lemma tcbSchedEnqueue_cslift_spec:
   "\<forall>s. \<Gamma>\<turnstile>\<^bsub>/UNIV\<^esub> \<lbrace>s. \<exists>d v. option_map2 tcbPriority_C (cslift s) \<acute>tcb = Some v
                        \<and> unat v \<le> numPriorities
@@ -29,7 +131,9 @@ lemma tcbSchedEnqueue_cslift_spec:
                                            \<noteq> None
                              \<and> option_map2 tcbDomain_C (cslift s)
                                    (head_C (index \<acute>ksReadyQueues (unat (d*0x100 + v))))
-                                           \<noteq> None)\<rbrace>
+                                           \<noteq> None)
+                       \<and> (head_C (index \<acute>ksReadyQueues (unat (d * 0x100 + v))) \<noteq> NULL
+                          \<longleftrightarrow> end_C (index \<acute>ksReadyQueues (unat (d * 0x100 + v))) \<noteq> NULL)\<rbrace>
        Call tcbSchedEnqueue_'proc
       {s'. option_map2 tcbEPNext_C (cslift s') = option_map2 tcbEPNext_C (cslift s)
            \<and> option_map2 tcbEPPrev_C (cslift s') = option_map2 tcbEPPrev_C (cslift s)
@@ -46,8 +150,8 @@ lemma tcbSchedEnqueue_cslift_spec:
   apply (rule conjI)
    apply (clarsimp simp: typ_heap_simps cong: if_cong)
    apply (simp split: if_split)
-  apply (clarsimp simp: typ_heap_simps if_Some_helper cong: if_cong)
-  by (simp split: if_split)
+  by (auto simp: typ_heap_simps' if_Some_helper numPriorities_def
+           cong: if_cong split: if_splits)
 
 lemma setThreadState_cslift_spec:
   "\<forall>s. \<Gamma>\<turnstile>\<^bsub>/UNIV\<^esub> \<lbrace>s. s \<Turnstile>\<^sub>c \<acute>tptr \<and> (\<forall>x. ksSchedulerAction_' (globals s) = tcb_Ptr x
@@ -143,8 +247,9 @@ lemma ctcb_relation_tcbPriority_maxPriority_numPriorities:
   done
 
 lemma tcbSchedEnqueue_cslift_precond_discharge:
-  "\<lbrakk> (s, s') \<in> rf_sr; obj_at' (P :: tcb \<Rightarrow> bool) x s;
-        valid_queues s; valid_objs' s \<rbrakk> \<Longrightarrow>
+  "\<lbrakk> (s, s') \<in> rf_sr; obj_at' (P :: tcb \<Rightarrow> bool) x s; valid_objs' s ;
+     ksReadyQueues_head_end s; ksReadyQueues_head_end_tcb_at' s;
+     pspace_aligned' s; pspace_distinct' s\<rbrakk> \<Longrightarrow>
    (\<exists>d v. option_map2 tcbPriority_C (cslift s') (tcb_ptr_to_ctcb_ptr x) = Some v
         \<and> unat v < numPriorities
         \<and> option_map2 tcbDomain_C (cslift s') (tcb_ptr_to_ctcb_ptr x) = Some d
@@ -155,31 +260,49 @@ lemma tcbSchedEnqueue_cslift_precond_discharge:
                                     \<noteq> None
                   \<and> option_map2 tcbDomain_C (cslift s')
                      (head_C (index (ksReadyQueues_' (globals s')) (unat (d*0x100 + v))))
-                                    \<noteq> None))"
+                                    \<noteq> None)
+        \<and> (head_C (index (ksReadyQueues_' (globals s')) (unat (d * 0x100 + v))) \<noteq> NULL
+           \<longleftrightarrow> end_C (index (ksReadyQueues_' (globals s')) (unat (d * 0x100 + v))) \<noteq> NULL))"
   apply (drule(1) obj_at_cslift_tcb)
   apply (clarsimp simp: typ_heap_simps' option_map2_def)
+  apply (rename_tac tcb tcb')
   apply (frule_tac t=x in valid_objs'_maxPriority, fastforce simp: obj_at'_def)
   apply (frule_tac t=x in valid_objs'_maxDomain, fastforce simp: obj_at'_def)
   apply (drule_tac P="\<lambda>tcb. tcbPriority tcb \<le> maxPriority" in obj_at_ko_at2', simp)
   apply (drule_tac P="\<lambda>tcb. tcbDomain tcb \<le> maxDomain" in obj_at_ko_at2', simp)
   apply (simp add: ctcb_relation_tcbDomain_maxDomain_numDomains
                    ctcb_relation_tcbPriority_maxPriority_numPriorities)
-  apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko"
-              in rf_sr_sched_queue_relation)
+  apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb" in rf_sr_ctcb_queue_relation)
     apply (simp add: maxDom_to_H maxPrio_to_H)+
+  apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb" in head_end_ksReadyQueues_', fastforce+)
   apply (simp add: cready_queues_index_to_C_def2 numPriorities_def le_maxDomain_eq_less_numDomains)
   apply (clarsimp simp: ctcb_relation_def)
   apply (frule arg_cong[where f=unat], subst(asm) unat_ucast_up_simp, simp)
-  apply (frule tcb_queue'_head_end_NULL)
-   apply (erule conjunct1[OF valid_queues_valid_q])
-  apply (frule(1) tcb_queue_relation_qhead_valid')
-   apply (simp add: valid_queues_valid_q)
-  apply (clarsimp simp: h_t_valid_clift_Some_iff)
+  apply (frule (3) head_end_ksReadyQueues_', fastforce+)
+  apply (clarsimp simp: ksReadyQueues_head_end_def)
+  apply (drule_tac x="tcbDomain tcb" in spec)
+  apply (drule_tac x="tcbPriority tcb" in spec)
+  apply (prop_tac "\<not> tcbQueueEmpty ((ksReadyQueues s (tcbDomain tcb, tcbPriority tcb)))")
+   apply (clarsimp simp: tcbQueueEmpty_def ctcb_queue_relation_def option_to_ctcb_ptr_def
+                  split: option.splits)
+  apply (clarsimp simp: ksReadyQueues_head_end_tcb_at'_def)
+  apply (drule_tac x="tcbDomain tcb" in spec)
+  apply (drule_tac x="tcbPriority tcb" in spec)
+  apply clarsimp
+  apply (clarsimp simp: tcbQueueEmpty_def)
+  apply (rename_tac head "end" head_tcb end_tcb)
+  apply (prop_tac "tcb_at' head s")
+   apply (fastforce intro: aligned'_distinct'_ko_wp_at'I
+                     simp: obj_at'_real_def opt_map_def split: option.splits)
+  apply (frule_tac thread=head in obj_at_cslift_tcb)
+   apply fastforce
+  apply (clarsimp dest: obj_at_cslift_tcb simp: ctcb_queue_relation_def option_to_ctcb_ptr_def)
   done
 
 lemma cancel_all_ccorres_helper:
   "ccorres dc xfdc
-      (\<lambda>s. valid_objs' s \<and> valid_queues s
+      (\<lambda>s. valid_objs' s \<and> pspace_aligned' s \<and> pspace_distinct' s
+             \<and> ksReadyQueues_head_end s \<and> ksReadyQueues_head_end_tcb_at' s
              \<and> (\<forall>t\<in>set ts. tcb_at' t s \<and> t \<noteq> 0)
              \<and> sch_act_wf (ksSchedulerAction s) s)
       {s'. \<exists>p. ep_queue_relation (cslift s') ts
@@ -234,11 +357,11 @@ next
            apply (erule cmap_relationE1 [OF cmap_relation_tcb])
             apply (erule ko_at_projectKO_opt)
            apply (fastforce intro: typ_heap_simps)
-          apply (wp sts_running_valid_queues | simp)+
+          apply (wp sts_valid_objs' | simp)+
         apply (rule ceqv_refl)
        apply (rule "Cons.hyps")
       apply (wp sts_valid_objs' sts_sch_act sch_act_wf_lift hoare_vcg_const_Ball_lift
-                sts_running_valid_queues sts_st_tcb' setThreadState_oa_queued | simp)+
+                sts_st_tcb' | simp)+
 
      apply (vcg exspec=setThreadState_cslift_spec exspec=tcbSchedEnqueue_cslift_spec)
     apply (clarsimp simp: tcb_at_not_NULL Collect_const_mem valid_tcb_state'_def
@@ -252,16 +375,13 @@ next
                            st_tcb_at'_def
                     split: scheduler_action.split_asm)
      apply (rename_tac word)
-     apply (frule_tac x=word in tcbSchedEnqueue_cslift_precond_discharge)
-        apply simp
-       apply clarsimp
-      apply clarsimp
-     apply clarsimp
+     apply (frule_tac x=word in tcbSchedEnqueue_cslift_precond_discharge; clarsimp?)
+     apply simp
     apply clarsimp
     apply (rule conjI)
      apply (frule(3) tcbSchedEnqueue_cslift_precond_discharge)
      apply clarsimp
-    apply clarsimp
+    apply clarsimp+
     apply (subst ep_queue_relation_shift, fastforce)
     apply (drule_tac x="tcb_ptr_to_ctcb_ptr thread"
                 in fun_cong)+
@@ -270,11 +390,17 @@ next
     done
 qed
 
+crunches setEndpoint, setNotification
+  for ksReadyQueues_head_end[wp]: ksReadyQueues_head_end
+  and ksReadyQueues_head_end_tcb_at'[wp]: ksReadyQueues_head_end_tcb_at'
+  (simp: updateObject_default_def)
+
 lemma cancelAllIPC_ccorres:
   "ccorres dc xfdc
-   (invs') (UNIV \<inter> {s. epptr_' s = Ptr epptr}) []
+   invs' (UNIV \<inter> {s. epptr_' s = Ptr epptr}) []
    (cancelAllIPC epptr) (Call cancelAllIPC_'proc)"
   apply (cinit lift: epptr_')
+   apply (rule ccorres_stateAssert)
    apply (rule ccorres_symb_exec_l [OF _ getEndpoint_inv _ empty_fail_getEndpoint])
     apply (rule_tac xf'=ret__unsigned_longlong_'
                 and val="case ep of IdleEP \<Rightarrow> scast EPState_Idle
@@ -289,7 +415,7 @@ lemma cancelAllIPC_ccorres:
        apply (simp add: cendpoint_relation_def Let_def
                  split: endpoint.split_asm)
       apply ceqv
-     apply (rule_tac A="invs' and ko_at' ep epptr"
+     apply (rule_tac A="invs' and ksReadyQueues_asrt and ko_at' ep epptr"
               in ccorres_guard_imp2[where A'=UNIV])
       apply wpc
         apply (rename_tac list)
@@ -330,12 +456,11 @@ lemma cancelAllIPC_ccorres:
              apply ceqv
             apply (ctac add: rescheduleRequired_ccorres)
            apply (wp weak_sch_act_wf_lift_linear
-                     cancelAllIPC_mapM_x_valid_queues
                   | simp)+
               apply (rule mapM_x_wp', wp)+
              apply (wp sts_st_tcb')
              apply (clarsimp split: if_split)
-            apply (rule mapM_x_wp', wp)+
+            apply (rule mapM_x_wp', wp sts_valid_objs')+
            apply (clarsimp simp: valid_tcb_state'_def)
           apply (simp add: guard_is_UNIV_def)
          apply (wp set_ep_valid_objs' hoare_vcg_const_Ball_lift
@@ -378,18 +503,21 @@ lemma cancelAllIPC_ccorres:
             apply (rule cancel_all_ccorres_helper)
            apply ceqv
           apply (ctac add: rescheduleRequired_ccorres)
-         apply (wp cancelAllIPC_mapM_x_valid_queues)
-         apply (wp mapM_x_wp' weak_sch_act_wf_lift_linear
+         apply (wp mapM_x_wp' weak_sch_act_wf_lift_linear sts_valid_objs'
                    sts_st_tcb' | clarsimp simp: valid_tcb_state'_def split: if_split)+
         apply (simp add: guard_is_UNIV_def)
        apply (wp set_ep_valid_objs' hoare_vcg_const_Ball_lift
                  weak_sch_act_wf_lift_linear)
       apply vcg
-     apply (clarsimp simp: valid_ep'_def invs_valid_objs' invs_queues)
+     apply (clarsimp simp: valid_ep'_def invs_valid_objs')
      apply (rule cmap_relationE1[OF cmap_relation_ep], assumption)
       apply (erule ko_at_projectKO_opt)
      apply (frule obj_at_valid_objs', clarsimp+)
      apply (clarsimp simp: valid_obj'_def valid_ep'_def)
+     apply (frule invs_pspace_aligned')
+     apply (frule invs_pspace_distinct')
+     apply (frule ksReadyQueues_asrt_ksReadyQueues_head_end)
+     apply (frule (2) ksReadyQueues_asrt_ksReadyQueues_head_end_tcb_at')
      subgoal by (auto simp: typ_heap_simps cendpoint_relation_def
                        Let_def tcb_queue_relation'_def
                        invs_valid_objs' valid_objs'_maxDomain valid_objs'_maxPriority
@@ -401,9 +529,10 @@ lemma cancelAllIPC_ccorres:
 
 lemma cancelAllSignals_ccorres:
   "ccorres dc xfdc
-   (invs') (UNIV \<inter> {s. ntfnPtr_' s = Ptr ntfnptr}) []
+   invs' (UNIV \<inter> {s. ntfnPtr_' s = Ptr ntfnptr}) []
    (cancelAllSignals ntfnptr) (Call cancelAllSignals_'proc)"
   apply (cinit lift: ntfnPtr_')
+   apply (rule ccorres_stateAssert)
    apply (rule ccorres_symb_exec_l [OF _ get_ntfn_inv' _ empty_fail_getNotification])
     apply (rule_tac xf'=ret__unsigned_longlong_'
                 and val="case ntfnObj ntfn of IdleNtfn \<Rightarrow> scast NtfnState_Idle
@@ -418,7 +547,7 @@ lemma cancelAllSignals_ccorres:
        apply (simp add: cnotification_relation_def Let_def
                  split: ntfn.split_asm)
       apply ceqv
-     apply (rule_tac A="invs' and ko_at' ntfn ntfnptr"
+     apply (rule_tac A="invs' and ksReadyQueues_asrt and ko_at' ntfn ntfnptr"
               in ccorres_guard_imp2[where A'=UNIV])
       apply wpc
         apply (simp add: notification_state_defs ccorres_cond_iffs)
@@ -458,8 +587,7 @@ lemma cancelAllSignals_ccorres:
             apply (rule cancel_all_ccorres_helper)
            apply ceqv
           apply (ctac add: rescheduleRequired_ccorres)
-         apply (wp cancelAllIPC_mapM_x_valid_queues)
-         apply (wp mapM_x_wp' weak_sch_act_wf_lift_linear
+         apply (wp mapM_x_wp' weak_sch_act_wf_lift_linear sts_valid_objs'
                    sts_st_tcb' | clarsimp simp: valid_tcb_state'_def split: if_split)+
         apply (simp add: guard_is_UNIV_def)
        apply (wp set_ntfn_valid_objs' hoare_vcg_const_Ball_lift
@@ -470,6 +598,10 @@ lemma cancelAllSignals_ccorres:
       apply (erule ko_at_projectKO_opt)
      apply (frule obj_at_valid_objs', clarsimp+)
      apply (clarsimp simp add: valid_obj'_def valid_ntfn'_def)
+     apply (frule invs_pspace_aligned')
+     apply (frule invs_pspace_distinct')
+     apply (frule ksReadyQueues_asrt_ksReadyQueues_head_end)
+     apply (frule (2) ksReadyQueues_asrt_ksReadyQueues_head_end_tcb_at')
      subgoal by (auto simp: typ_heap_simps cnotification_relation_def
                        Let_def tcb_queue_relation'_def
                        invs_valid_objs' valid_objs'_maxDomain valid_objs'_maxPriority
@@ -554,16 +686,16 @@ lemma tcb_queue_relation2_cong:
 
 context kernel_m begin
 
-lemma setThreadState_ccorres_valid_queues'_simple:
-  "ccorres dc xfdc (\<lambda>s. tcb_at' thread s \<and> valid_queues' s \<and> \<not> runnable' st \<and> sch_act_simple s)
+lemma setThreadState_ccorres_simple:
+  "ccorres dc xfdc (\<lambda>s. tcb_at' thread s \<and> \<not> runnable' st \<and> sch_act_simple s)
    ({s'. (\<forall>cl fl. cthread_state_relation_lifted st (cl\<lparr>tsType_CL := ts_' s' && mask 4\<rparr>, fl))}
     \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr thread}) []
          (setThreadState st thread) (Call setThreadState_'proc)"
   apply (cinit lift: tptr_' cong add: call_ignore_cong)
     apply (ctac (no_vcg) add: threadSet_tcbState_simple_corres)
    apply (ctac add: scheduleTCB_ccorres_valid_queues'_simple)
-  apply (wp threadSet_valid_queues'_and_not_runnable')
-  apply (clarsimp simp: weak_sch_act_wf_def valid_queues'_def)
+  apply (wp threadSet_tcbState_st_tcb_at')
+  apply (fastforce simp: weak_sch_act_wf_def)
   done
 
 lemma updateRestartPC_ccorres:
@@ -579,9 +711,7 @@ lemma updateRestartPC_ccorres:
   done
 
 crunches updateRestartPC
-  for valid_queues'[wp]: valid_queues'
-  and sch_act_simple[wp]: sch_act_simple
-  and valid_queues[wp]: Invariants_H.valid_queues
+  for sch_act_simple[wp]: sch_act_simple
   and valid_objs'[wp]: valid_objs'
   and tcb_at'[wp]: "tcb_at' p"
 
@@ -625,21 +755,12 @@ lemma suspend_ccorres:
           apply (ctac (no_vcg) add: updateRestartPC_ccorres)
          apply (rule ccorres_return_Skip)
         apply ceqv
-       apply (ctac(no_vcg) add: setThreadState_ccorres_valid_queues'_simple)
-        apply (ctac add: tcbSchedDequeue_ccorres')
-       apply (rule_tac Q="\<lambda>_.
-                           (\<lambda>s. \<forall>t' d p. (t' \<in> set (ksReadyQueues s (d, p)) \<longrightarrow>
-                                 obj_at' (\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d
-                                                              \<and> tcbPriority tcb = p) t' s \<and>
-                   (t' \<noteq> thread \<longrightarrow> st_tcb_at' runnable' t' s)) \<and>
-                   distinct (ksReadyQueues s (d, p))) and valid_queues' and valid_objs' and tcb_at' thread"
-                 in hoare_post_imp)
+       apply (ctac(no_vcg) add: setThreadState_ccorres_simple)
+        apply (ctac add: tcbSchedDequeue_ccorres)
+       apply (rule_tac Q="\<lambda>_. valid_objs' and tcb_at' thread and pspace_aligned' and pspace_distinct'"
+                    in hoare_post_imp)
         apply clarsimp
-        apply (drule_tac x="t" in spec)
-        apply (drule_tac x=d in spec)
-        apply (drule_tac x=p in spec)
-        apply (clarsimp elim!: obj_at'_weakenE simp: inQ_def)
-       apply (wp sts_valid_queues_partial)[1]
+       apply (wp sts_valid_objs')[1]
       apply clarsimp
       apply (wpsimp simp: valid_tcb_state'_def)
      apply clarsimp
@@ -654,8 +775,7 @@ lemma suspend_ccorres:
       apply (rule cancelIPC_sch_act_simple)
      apply (rule cancelIPC_tcb_at'[where t=thread])
     apply (rule delete_one_conc_fr.cancelIPC_invs)
-   apply (fastforce simp: invs_valid_queues' invs_queues invs_valid_objs'
-                          valid_tcb_state'_def)
+   apply (fastforce simp: invs_valid_objs' valid_tcb_state'_def)
   apply (auto simp: ThreadState_defs)
   done
 
@@ -839,7 +959,7 @@ lemma unbindMaybeNotification_ccorres:
    apply (wp getNotification_wp)
   apply (clarsimp )
   apply (frule (1) ko_at_valid_ntfn'[OF _ invs_valid_objs'])
-  by (auto simp: valid_ntfn'_def valid_bound_tcb'_def obj_at'_def
+  by (auto simp: valid_ntfn'_def obj_at'_def
                       objBitsKO_def is_aligned_def option_to_ctcb_ptr_def tcb_at_not_NULL
              split: ntfn.splits)
 
@@ -978,7 +1098,7 @@ lemma finaliseCap_True_cases_ccorres:
   apply (rule TrueI conjI impI TrueI)+
    apply (frule cap_get_tag_to_H, erule(1) cap_get_tag_isCap [THEN iffD2])
    apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def isNotificationCap_def
-                         isEndpointCap_def valid_obj'_def valid_ntfn'_def valid_bound_tcb'_def
+                         isEndpointCap_def valid_obj'_def valid_ntfn'_def
                   dest!: obj_at_valid_objs')
   apply clarsimp
   apply (frule cap_get_tag_to_H, erule(1) cap_get_tag_isCap [THEN iffD2])
@@ -1885,20 +2005,6 @@ lemma ep_queue_relation_shift2:
   apply (clarsimp split: option.split_asm)
   done
 
-lemma sched_queue_relation_shift:
-  "(option_map2 tcbSchedNext_C (f (cslift s))
-         = option_map2 tcbSchedNext_C (cslift s)
-    \<and> option_map2 tcbSchedPrev_C (f (cslift s))
-         = option_map2 tcbSchedPrev_C (cslift s))
-     \<Longrightarrow>  sched_queue_relation (f (cslift s)) ts qPrev qHead
-          =  sched_queue_relation (cslift s) ts qPrev qHead"
-  apply (induct ts arbitrary: qPrev qHead; clarsimp)
-  apply (simp add: option_map2_def fun_eq_iff
-                   map_option_case)
-  apply (drule_tac x=qHead in spec)+
-  apply (clarsimp split: option.split_asm)
-  done
-
 lemma cendpoint_relation_udpate_arch:
   "\<lbrakk> cslift x p = Some tcb ; cendpoint_relation (cslift x) v v' \<rbrakk>
     \<Longrightarrow> cendpoint_relation ((cslift x)(p \<mapsto> tcbArch_C_update f tcb)) v v'"
@@ -1931,27 +2037,24 @@ lemma archThreadSet_tcbVCPU_Basic_ccorres:
   apply (rule ccorres_guard_imp2)
    apply (rule ccorres_pre_getObject_tcb)
    apply (rule_tac P="tcb_at' tptr and ko_at' tcb tptr" and P'=UNIV in setObject_ccorres_helper)
-     apply (simp_all add: objBits_simps' archObjSize_def pageBits_def obj_tcb_at')
+     apply (simp_all add: objBits_simps' obj_tcb_at')
   apply (rule conseqPre, vcg, clarsimp)
   apply (rule cmap_relationE1[OF cmap_relation_tcb], assumption, erule ko_at_projectKO_opt)
   apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def update_tcb_map_tos
-                        typ_heap_simps' cpspace_relation_def update_tcb_map_tos)
-   apply (safe ; (clarsimp simp: cpspace_relation_def typ_heap_simps
-                                 carch_state_relation_def Let_def
-                                 update_tcb_map_to_tcb
-                                 cmachine_state_relation_def
-                                 update_tcb_map_tos)?)
+                        typ_heap_simps' cpspace_relation_def)
+  apply (safe ; (clarsimp simp: cpspace_relation_def typ_heap_simps
+                                carch_state_relation_def Let_def
+                                update_tcb_map_to_tcb
+                                cmachine_state_relation_def
+                                update_tcb_map_tos)?)
       apply (subst map_to_ctes_upd_tcb_no_ctes; simp add: tcb_cte_cases_def cteSizeBits_def)
      apply (erule cmap_relation_updI, erule ko_at_projectKO_opt, simp+)
       apply (clarsimp simp: ctcb_relation_def carch_tcb_relation_def ccontext_relation_def
                             atcbContextGet_def)
      apply clarsimp
     apply (rule cmap_relation_rel_upd[OF _ cendpoint_relation_udpate_arch], simp+)
-    apply (rule cmap_relation_rel_upd[OF _ cnotification_relation_udpate_arch], simp+)
-      apply (clarsimp simp add: cready_queues_relation_def Let_def tcb_queue_relation'_def)
-   apply (subst sched_queue_relation_shift; simp add: fun_eq_iff)
-   apply (safe ; case_tac "xa = tcb_ptr_to_ctcb_ptr tptr" ; clarsimp simp: option_map2_def map_option_case)
-    apply (clarsimp simp: cvariable_relation_upd_const)
+   apply (rule cmap_relation_rel_upd[OF _ cnotification_relation_udpate_arch], simp+)
+  apply (clarsimp simp: cvariable_relation_upd_const)
   done
 
 lemma setObject_vcpuTCB_updated_Basic_ccorres:
@@ -1962,7 +2065,7 @@ lemma setObject_vcpuTCB_updated_Basic_ccorres:
                                          (option_to_ctcb_ptr tptr :: tcb_C ptr)))) s)))"
   apply (rule ccorres_guard_imp2)
    apply (rule_tac P="ko_at' (vcpuTCBPtr_update t vcpu) vcpuptr" and P'=UNIV in setObject_ccorres_helper)
-     apply (simp_all add: objBits_simps archObjSize_def pageBits_def obj_tcb_at' vcpuBits_def)
+     apply (simp_all add: objBits_simps pageBits_def obj_tcb_at' vcpuBits_def)
   apply (rule conseqPre, vcg, clarsimp)
   apply (rule cmap_relationE1[OF cmap_relation_vcpu], assumption, erule ko_at_projectKO_opt)
   apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def typ_heap_simps'
diff --git a/proof/crefine/AARCH64/Interrupt_C.thy b/proof/crefine/AARCH64/Interrupt_C.thy
index ff57a72814..423709498a 100644
--- a/proof/crefine/AARCH64/Interrupt_C.thy
+++ b/proof/crefine/AARCH64/Interrupt_C.thy
@@ -259,7 +259,7 @@ supply [[goals_limit=20]]
     apply (simp add: syscall_error_to_H_cases)
    apply simp
   apply (clarsimp simp: Collect_const_mem tcb_at_invs')
-  apply (clarsimp simp: invs_queues invs_valid_objs'
+  apply (clarsimp simp: invs_valid_objs'
                         ct_in_state'_def
                         ccap_rights_relation_def
                         mask_def[where n=4] ThreadState_defs)
@@ -275,7 +275,7 @@ supply [[goals_limit=20]]
                     excaps_map_def excaps_in_mem_def word_less_nat_alt hd_conv_nth
                     slotcap_in_mem_def valid_tcb_state'_def
              dest!: interpret_excaps_eq split: bool.splits)+
-     apply (auto dest: st_tcb_at_idle_thread' ctes_of_valid')[4]
+     apply (auto dest: st_tcb_at_idle_thread' ctes_of_valid')[6]
     apply (drule ctes_of_valid')
      apply fastforce
     apply (clarsimp simp add:valid_cap_simps' AARCH64.maxIRQ_def)
diff --git a/proof/crefine/AARCH64/Invoke_C.thy b/proof/crefine/AARCH64/Invoke_C.thy
index 8433d438b3..f8507f2b61 100644
--- a/proof/crefine/AARCH64/Invoke_C.thy
+++ b/proof/crefine/AARCH64/Invoke_C.thy
@@ -80,15 +80,14 @@ lemma setDomain_ccorres:
                             and (\<lambda>s. curThread = ksCurThread s)"
               in hoare_strengthen_post)
       apply (wp threadSet_all_invs_but_sch_extra)
-     apply (clarsimp simp: valid_pspace_valid_objs' st_tcb_at_def[symmetric]
-                           sch_act_simple_def st_tcb_at'_def weak_sch_act_wf_def
-                    split: if_splits)
+     apply (fastforce simp: valid_pspace_valid_objs' st_tcb_at_def[symmetric]
+                            sch_act_simple_def st_tcb_at'_def weak_sch_act_wf_def
+                     split: if_splits)
     apply (simp add: guard_is_UNIV_def)
-   apply (rule_tac Q="\<lambda>_. invs' and tcb_at' t and sch_act_simple
-                          and (\<lambda>s. curThread = ksCurThread s \<and> (\<forall>p. t \<notin> set (ksReadyQueues s p)))"
+   apply (rule_tac Q="\<lambda>_. invs' and tcb_at' t and sch_act_simple and (\<lambda>s. curThread = ksCurThread s)"
             in hoare_strengthen_post)
     apply (wp weak_sch_act_wf_lift_linear tcbSchedDequeue_not_queued
-              tcbSchedDequeue_not_in_queue hoare_vcg_imp_lift hoare_vcg_all_lift)
+              hoare_vcg_imp_lift hoare_vcg_all_lift)
    apply (clarsimp simp: invs'_def valid_pspace'_def valid_state'_def)
   apply (fastforce simp: valid_tcb'_def tcb_cte_cases_def
                          invs'_def valid_state'_def valid_pspace'_def)
@@ -196,8 +195,8 @@ lemma decodeDomainInvocation_ccorres:
    apply clarsimp
    apply (vcg exspec=getSyscallArg_modifies)
 
-  apply (clarsimp simp: valid_tcb_state'_def invs_valid_queues' invs_valid_objs'
-                        invs_queues invs_sch_act_wf' ct_in_state'_def pred_tcb_at'
+  apply (clarsimp simp: valid_tcb_state'_def invs_valid_objs'
+                        invs_sch_act_wf' ct_in_state'_def pred_tcb_at'
                         rf_sr_ksCurThread word_sle_def word_sless_def sysargs_rel_to_n
                         mask_eq_iff_w2p mask_eq_iff_w2p word_size ThreadState_defs)
   apply (rule conjI)
@@ -207,7 +206,7 @@ lemma decodeDomainInvocation_ccorres:
    apply (drule_tac x="extraCaps ! 0" and P="\<lambda>v. valid_cap' (fst v) s" in bspec)
     apply (clarsimp simp: nth_mem interpret_excaps_test_null excaps_map_def)
    apply (clarsimp simp: valid_cap_simps' pred_tcb'_weakenE active_runnable')
-   apply (rule conjI)
+   apply (intro conjI; fastforce?)
     apply (fastforce simp: tcb_st_refs_of'_def elim:pred_tcb'_weakenE)
    apply (simp add: word_le_nat_alt unat_ucast unat_numDomains_to_H le_maxDomain_eq_less_numDomains)
   apply (clarsimp simp: ccap_relation_def cap_to_H_simps cap_thread_cap_lift)
@@ -760,15 +759,15 @@ lemma decodeCNodeInvocation_ccorres:
                               apply simp
                               apply (wp injection_wp_E[OF refl])
                               apply (rule hoare_post_imp_R)
-                               apply (rule_tac Q'="\<lambda>rv. valid_pspace' and valid_queues
+                               apply (rule_tac Q'="\<lambda>rv. valid_pspace'
                                                     and valid_cap' rv and valid_objs'
                                                          and tcb_at' thread and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)"
                                            in hoare_vcg_R_conj)
                                 apply (rule deriveCap_Null_helper[OF deriveCap_derived])
                                apply wp
                               apply (clarsimp simp: cte_wp_at_ctes_of)
-                              apply (simp add: is_derived'_def badge_derived'_def
-                                               valid_tcb_state'_def)
+                              apply (fastforce simp: is_derived'_def badge_derived'_def
+                                                     valid_tcb_state'_def)
                              apply (simp add: Collect_const_mem all_ex_eq_helper)
                              apply (vcg exspec=deriveCap_modifies)
                             apply wp
@@ -836,14 +835,14 @@ lemma decodeCNodeInvocation_ccorres:
                                   apply (simp add: conj_comms valid_tcb_state'_def)
                                   apply (wp injection_wp_E[OF refl])
                                   apply (rule hoare_post_imp_R)
-                                   apply (rule_tac Q'="\<lambda>rv. valid_pspace' and valid_queues
+                                   apply (rule_tac Q'="\<lambda>rv. valid_pspace'
                                                         and valid_cap' rv and valid_objs'
                                                              and tcb_at' thread and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)"
                                                in hoare_vcg_R_conj)
                                     apply (rule deriveCap_Null_helper [OF deriveCap_derived])
                                    apply wp
                                   apply (clarsimp simp: cte_wp_at_ctes_of)
-                                  apply (simp add: is_derived'_def badge_derived'_def)
+                                  apply (fastforce simp: is_derived'_def badge_derived'_def)
                                  apply (simp add: Collect_const_mem all_ex_eq_helper)
                                  apply (vcg exspec=deriveCap_modifies)
                                 apply (simp add: Collect_const_mem)
@@ -951,12 +950,14 @@ lemma decodeCNodeInvocation_ccorres:
                      apply (rule_tac Q'="\<lambda>a b. cte_wp_at' (\<lambda>x. True) a b \<and> invs' b \<and>
                        tcb_at' thread b  \<and> sch_act_wf (ksSchedulerAction b) b \<and> valid_tcb_state' Restart b
                        \<and> Q2 b" for Q2 in  hoare_post_imp_R)
-                       prefer 2
-                       apply (clarsimp simp:cte_wp_at_ctes_of)
-                       apply (drule ctes_of_valid')
-                         apply (erule invs_valid_objs')
-                        apply (clarsimp simp:valid_updateCapDataI invs_queues invs_valid_objs' invs_valid_pspace')
-                       apply (assumption)
+                      prefer 2
+                      apply (clarsimp simp:cte_wp_at_ctes_of)
+                      apply (drule ctes_of_valid')
+                       apply (erule invs_valid_objs')
+                      apply (frule invs_pspace_aligned')
+                      apply (frule invs_pspace_distinct')
+                      apply (clarsimp simp:valid_updateCapDataI invs_valid_objs' invs_valid_pspace')
+                      apply assumption
                      apply (wp hoare_vcg_all_lift_R injection_wp_E[OF refl]
                                lsfco_cte_at' hoare_vcg_const_imp_lift_R
                            )+
@@ -1351,7 +1352,7 @@ lemma decodeCNodeInvocation_ccorres:
    apply simp
    apply (vcg exspec=getSyscallArg_modifies)
   apply (clarsimp simp: valid_tcb_state'_def invs_valid_objs' invs_valid_pspace'
-                        ct_in_state'_def pred_tcb_at' invs_queues
+                        ct_in_state'_def pred_tcb_at'
                         cur_tcb'_def word_sle_def word_sless_def
                         unat_lt2p[where 'a=machine_word_len, folded word_bits_def])
   apply (rule conjI)
@@ -1383,9 +1384,6 @@ end
 
 context begin interpretation Arch . (*FIXME: arch_split*)
 
-crunch valid_queues[wp]: insertNewCap "valid_queues"
-  (wp: crunch_wps)
-
 lemmas setCTE_def3 = setCTE_def2[THEN eq_reflection]
 
 lemma setCTE_sch_act_wf[wp]:
@@ -3311,7 +3309,7 @@ lemma decodeUntypedInvocation_ccorres_helper:
                       and sch_act_simple and ct_active'" in hoare_post_imp_R)
                    prefer 2
                    apply (clarsimp simp: invs_valid_objs' invs_mdb'
-                      invs_queues ct_in_state'_def pred_tcb_at')
+                                         ct_in_state'_def pred_tcb_at')
                    apply (subgoal_tac "ksCurThread s \<noteq> ksIdleThread sa")
                     prefer 2
                     apply clarsimp
diff --git a/proof/crefine/AARCH64/IpcCancel_C.thy b/proof/crefine/AARCH64/IpcCancel_C.thy
index 540b3b7737..eab695a1e4 100644
--- a/proof/crefine/AARCH64/IpcCancel_C.thy
+++ b/proof/crefine/AARCH64/IpcCancel_C.thy
@@ -14,12 +14,12 @@ context kernel_m
 begin
 
 lemma cready_queues_index_to_C_in_range':
-  assumes prems: "qdom \<le> ucast maxDom" "prio \<le> ucast maxPrio"
+  assumes prems: "qdom \<le> maxDomain" "prio \<le> maxPriority"
   shows "cready_queues_index_to_C qdom prio < num_tcb_queues"
 proof -
   have P: "unat prio < numPriorities"
     using prems
-    by (simp add: numPriorities_def seL4_MaxPrio_def Suc_le_lessD unat_le_helper)
+    by (simp add: numPriorities_def Suc_le_lessD unat_le_helper maxDomain_def maxPriority_def)
   have Q: "unat qdom < numDomains"
     using prems
     by (simp add: maxDom_to_H le_maxDomain_eq_less_numDomains word_le_nat_alt)
@@ -33,36 +33,18 @@ lemmas cready_queues_index_to_C_in_range =
 
 lemma cready_queues_index_to_C_inj:
   "\<lbrakk> cready_queues_index_to_C qdom prio = cready_queues_index_to_C qdom' prio';
-     prio \<le> ucast maxPrio; prio' \<le> ucast maxPrio \<rbrakk> \<Longrightarrow> prio = prio' \<and> qdom = qdom'"
+     prio \<le> maxPriority; prio' \<le> maxPriority \<rbrakk> \<Longrightarrow> prio = prio' \<and> qdom = qdom'"
   apply (rule context_conjI)
-  apply (auto simp: cready_queues_index_to_C_def numPriorities_def
+  apply (auto simp: cready_queues_index_to_C_def numPriorities_def maxPriority_def
                     seL4_MaxPrio_def word_le_nat_alt dest: arg_cong[where f="\<lambda>x. x mod 256"])
   done
 
 lemma cready_queues_index_to_C_distinct:
-  "\<lbrakk> qdom = qdom' \<longrightarrow> prio \<noteq> prio'; prio \<le> ucast maxPrio; prio' \<le> ucast maxPrio \<rbrakk>
+  "\<lbrakk> qdom = qdom' \<longrightarrow> prio \<noteq> prio'; prio \<le> maxPriority; prio' \<le> maxPriority \<rbrakk>
    \<Longrightarrow> cready_queues_index_to_C qdom prio \<noteq> cready_queues_index_to_C qdom' prio'"
   apply (auto simp: cready_queues_index_to_C_inj)
   done
 
-lemma cstate_relation_ksReadyQueues_update:
-  "\<lbrakk> cstate_relation hs cs; arr = ksReadyQueues_' cs;
-     sched_queue_relation' (clift (t_hrs_' cs)) v (head_C v') (end_C v');
-     qdom \<le> ucast maxDom; prio \<le> ucast maxPrio \<rbrakk>
-    \<Longrightarrow> cstate_relation (ksReadyQueues_update (\<lambda>qs. qs ((qdom, prio) := v)) hs)
-                        (ksReadyQueues_'_update (\<lambda>_. Arrays.update arr
-                                                        (cready_queues_index_to_C qdom prio) v') cs)"
-  apply (clarsimp simp: cstate_relation_def Let_def
-                        cmachine_state_relation_def
-                        carch_state_relation_def carch_globals_def
-                        cready_queues_relation_def seL4_MinPrio_def minDom_def)
-  apply (frule cready_queues_index_to_C_in_range, assumption)
-  apply clarsimp
-  apply (frule_tac qdom=qdoma and prio=prioa in cready_queues_index_to_C_in_range, assumption)
-  apply (frule cready_queues_index_to_C_distinct, assumption+)
-  apply clarsimp
-  done
-
 lemma cmap_relation_drop_fun_upd:
   "\<lbrakk> cm x = Some v; \<And>v''. rel v'' v = rel v'' v' \<rbrakk>
       \<Longrightarrow> cmap_relation am (cm (x \<mapsto> v')) f rel
@@ -73,16 +55,6 @@ lemma cmap_relation_drop_fun_upd:
   apply (auto split: if_split)
   done
 
-lemma valid_queuesD':
-  "\<lbrakk> obj_at' (inQ d p) t s; valid_queues' s \<rbrakk>
-        \<Longrightarrow> t \<in> set (ksReadyQueues s (d, p))"
-  by (simp add: valid_queues'_def)
-
-lemma invs_valid_queues'[elim!]:
-  "invs' s \<Longrightarrow> valid_queues' s"
-  by (simp add: invs'_def valid_state'_def)
-
-
 lemma ntfn_ptr_get_queue_spec:
   "\<forall>s. \<Gamma> \<turnstile> {\<sigma>. s = \<sigma> \<and> \<sigma> \<Turnstile>\<^sub>c \<^bsup>\<sigma>\<^esup>ntfnPtr} \<acute>ret__struct_tcb_queue_C :== PROC ntfn_ptr_get_queue(\<acute>ntfnPtr)
        \<lbrace>head_C \<acute>ret__struct_tcb_queue_C = Ptr (ntfnQueue_head_CL (notification_lift (the (cslift s \<^bsup>s\<^esup>ntfnPtr)))) \<and>
@@ -233,22 +205,19 @@ lemma cancelSignal_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-            \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-           apply simp
-           apply (rule cendpoint_relation_ntfn_queue [OF invs_sym'], assumption+)
-           apply simp
-           apply (erule (1) map_to_ko_atI')
-          \<comment> \<open>ntfn relation\<close>
-          apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
-           apply (simp add: cnotification_relation_def Let_def NtfnState_Idle_def)
-          apply (simp add: carch_state_relation_def carch_globals_def)
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         apply (clarsimp simp: comp_def)
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+          apply simp
+          apply (rule cendpoint_relation_ntfn_queue [OF invs_sym'], assumption+)
+          apply simp
+          apply (erule (1) map_to_ko_atI')
+         \<comment> \<open>ntfn relation\<close>
+         apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
+         apply (simp add: cnotification_relation_def Let_def NtfnState_Idle_def)
+         apply (simp add: carch_state_relation_def carch_globals_def)
         apply (clarsimp simp: carch_state_relation_def carch_globals_def
                               typ_heap_simps' packed_heap_update_collapse_hrs)
        apply (simp add: cmachine_state_relation_def)
@@ -269,34 +238,31 @@ lemma cancelSignal_ccorres_helper:
                        typ_heap_simps')
       apply (elim conjE)
       apply (intro conjI)
-           \<comment> \<open>tcb relation\<close>
-           apply (erule ctcb_relation_null_queue_ptrs)
-           apply (clarsimp simp: comp_def)
-          \<comment> \<open>ep relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-          apply simp
-          apply (rule cendpoint_relation_ntfn_queue)
-              apply fastforce
-             apply assumption+
-          apply simp
-          apply (erule (1) map_to_ko_atI')
-         \<comment> \<open>ntfn relation\<close>
-         apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
-          apply (simp add: cnotification_relation_def Let_def isWaitingNtfn_def
-                    split: ntfn.splits split del: if_split)
-          apply (erule iffD1 [OF tcb_queue_relation'_cong [OF refl _ _ refl], rotated -1])
-           apply (clarsimp simp add: h_t_valid_clift_Some_iff)
-           apply (subst tcb_queue_relation'_next_canonical; assumption?)
-            apply fastforce
-           apply (simp add: notification_lift_def make_canonical_def canonical_bit_def)
-          apply (clarsimp simp: h_t_valid_clift_Some_iff notification_lift_def)
-          apply (subst tcb_queue_relation'_prev_canonical; assumption?)
-           apply fastforce
-          apply (simp add: make_canonical_def canonical_bit_def)
+          \<comment> \<open>tcb relation\<close>
+          apply (erule ctcb_relation_null_ep_ptrs)
+          apply (clarsimp simp: comp_def)
+         \<comment> \<open>ep relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
          apply simp
-        \<comment> \<open>queue relation\<close>
-        apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-        apply (clarsimp simp: comp_def)
+         apply (rule cendpoint_relation_ntfn_queue)
+             apply fastforce
+            apply assumption+
+         apply simp
+         apply (erule (1) map_to_ko_atI')
+        \<comment> \<open>ntfn relation\<close>
+        apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
+         apply (simp add: cnotification_relation_def Let_def isWaitingNtfn_def
+                   split: ntfn.splits split del: if_split)
+         apply (erule iffD1 [OF tcb_queue_relation'_cong [OF refl _ _ refl], rotated -1])
+          apply (clarsimp simp add: h_t_valid_clift_Some_iff)
+          apply (subst tcb_queue_relation'_next_canonical; assumption?)
+           apply fastforce
+          apply (simp add: notification_lift_def make_canonical_def canonical_bit_def)
+         apply (clarsimp simp: h_t_valid_clift_Some_iff notification_lift_def)
+         apply (subst tcb_queue_relation'_prev_canonical; assumption?)
+          apply fastforce
+         apply (simp add: make_canonical_def canonical_bit_def)
+        apply simp
        subgoal by (clarsimp simp: carch_state_relation_def carch_globals_def)
       subgoal by (simp add: cmachine_state_relation_def)
      subgoal by (simp add: h_t_valid_clift_Some_iff)
@@ -462,68 +428,6 @@ lemma isRunnable_ccorres [corres]:
        apply (simp add: ThreadState_defs)+
   done
 
-
-
-lemma tcb_queue_relation_update_head:
-  fixes getNext_update :: "(tcb_C ptr \<Rightarrow> tcb_C ptr) \<Rightarrow> tcb_C \<Rightarrow> tcb_C" and
-  getPrev_update :: "(tcb_C ptr \<Rightarrow> tcb_C ptr) \<Rightarrow> tcb_C \<Rightarrow> tcb_C"
-  assumes qr: "tcb_queue_relation getNext getPrev mp queue NULL qhead"
-  and     qh': "qhead' \<notin> tcb_ptr_to_ctcb_ptr ` set queue"
-  and  cs_tcb: "mp qhead' = Some tcb"
-  and valid_ep: "\<forall>t\<in>set queue. tcb_at' t s" "distinct queue"
-  and     qhN: "qhead' \<noteq> NULL"
-  and     fgN: "fg_cons getNext (getNext_update \<circ> (\<lambda>x _. x))"
-  and     fgP: "fg_cons getPrev (getPrev_update \<circ> (\<lambda>x _. x))"
-  and     npu: "\<And>f t. getNext (getPrev_update f t) = getNext t"
-  and     pnu: "\<And>f t. getPrev (getNext_update f t) = getPrev t"
-  shows   "tcb_queue_relation getNext getPrev
-                 (upd_unless_null qhead (getPrev_update (\<lambda>_. qhead') (the (mp qhead)))
-                       (mp(qhead' := Some (getPrev_update (\<lambda>_. NULL) (getNext_update (\<lambda>_. qhead)  tcb)))))
-                 (ctcb_ptr_to_tcb_ptr qhead' # queue) NULL qhead'"
-  using qr qh' cs_tcb valid_ep qhN
-  apply (subgoal_tac "qhead \<noteq> qhead'")
-  apply (clarsimp simp: pnu upd_unless_null_def fg_consD1 [OF fgN] fg_consD1 [OF fgP] npu)
-  apply (cases queue)
-    apply simp
-   apply (frule (2) tcb_queue_relation_next_not_NULL)
-    apply simp
-   apply (clarsimp simp: fg_consD1 [OF fgN] fg_consD1 [OF fgP] pnu npu)
-   apply (subst tcb_queue_relation_cong [OF refl refl refl, where mp' = mp])
-    apply (clarsimp simp: inj_eq)
-    apply (intro impI conjI)
-     apply (frule_tac x = x in imageI [where f = tcb_ptr_to_ctcb_ptr])
-     apply simp
-    apply simp
-   apply simp
-  apply clarsimp
-  apply (cases queue)
-   apply simp
-  apply simp
-  done
-
-lemma tcbSchedEnqueue_update:
-  assumes sr: "sched_queue_relation' mp queue qhead qend"
-  and     qh': "qhead' \<notin> tcb_ptr_to_ctcb_ptr ` set queue"
-  and  cs_tcb: "mp qhead' = Some tcb"
-  and valid_ep: "\<forall>t\<in>set queue. tcb_at' t s" "distinct queue"
-  and     qhN: "qhead' \<noteq> NULL"
-  shows
-  "sched_queue_relation'
-                   (upd_unless_null qhead (tcbSchedPrev_C_update (\<lambda>_. qhead') (the (mp qhead)))
-                (mp(qhead' \<mapsto> tcb\<lparr>tcbSchedNext_C := qhead, tcbSchedPrev_C := NULL\<rparr>)))
-            (ctcb_ptr_to_tcb_ptr qhead' # queue) qhead' (if qend = NULL then qhead' else qend)"
-  using sr qh' cs_tcb valid_ep qhN
-  apply -
-  apply (erule tcb_queue_relationE')
-  apply (rule tcb_queue_relationI')
-   apply (erule (5) tcb_queue_relation_update_head
-        [where getNext_update = tcbSchedNext_C_update and getPrev_update = tcbSchedPrev_C_update], simp_all)[1]
-  apply simp
-  apply (intro impI)
-  apply (erule (1) tcb_queue_relation_not_NULL')
-  apply simp
-  done
-
 lemma tcb_ptr_to_ctcb_ptr_imageD:
   "x \<in> tcb_ptr_to_ctcb_ptr ` S \<Longrightarrow> ctcb_ptr_to_tcb_ptr x \<in> S"
   apply (erule imageE)
@@ -536,93 +440,6 @@ lemma ctcb_ptr_to_tcb_ptr_imageI:
   apply simp
   done
 
-lemma tcb_queue'_head_end_NULL:
-  assumes qr: "tcb_queue_relation' getNext getPrev mp queue qhead qend"
-  and   tat: "\<forall>t\<in>set queue. tcb_at' t s"
-  shows "(qend = NULL) = (qhead = NULL)"
-  using qr tat
-  apply -
-  apply (erule tcb_queue_relationE')
-  apply (simp add: tcb_queue_head_empty_iff)
-  apply (rule impI)
-  apply (rule tcb_at_not_NULL)
-  apply (erule bspec)
-  apply simp
-  done
-
-lemma tcb_queue_relation_qhead_mem:
-  "\<lbrakk> tcb_queue_relation getNext getPrev mp queue NULL qhead;
-  (\<forall>tcb\<in>set queue. tcb_at' tcb t) \<rbrakk>
-  \<Longrightarrow> qhead \<noteq> NULL \<longrightarrow> ctcb_ptr_to_tcb_ptr qhead \<in> set queue"
-  by (clarsimp simp: tcb_queue_head_empty_iff tcb_queue_relation_head_hd)
-
-lemma tcb_queue_relation_qhead_valid:
-  "\<lbrakk> tcb_queue_relation getNext getPrev (cslift s') queue NULL qhead;
-  (s, s') \<in> rf_sr; (\<forall>tcb\<in>set queue. tcb_at' tcb s) \<rbrakk>
-  \<Longrightarrow> qhead \<noteq> NULL \<longrightarrow> s' \<Turnstile>\<^sub>c qhead"
-  apply (frule (1) tcb_queue_relation_qhead_mem)
-  apply clarsimp
-  apply(drule (3) tcb_queue_memberD)
-  apply (simp add: h_t_valid_clift_Some_iff)
-  done
-
-lemmas tcb_queue_relation_qhead_mem' = tcb_queue_relation_qhead_mem [OF tcb_queue_relation'_queue_rel]
-lemmas tcb_queue_relation_qhead_valid' = tcb_queue_relation_qhead_valid [OF tcb_queue_relation'_queue_rel]
-
-
-lemma valid_queues_valid_q:
-  "valid_queues s \<Longrightarrow> (\<forall>tcb\<in>set (ksReadyQueues s (qdom, prio)). tcb_at' tcb s) \<and> distinct (ksReadyQueues s (qdom, prio))"
-  apply (clarsimp simp: valid_queues_def valid_queues_no_bitmap_def)
-  apply (drule spec [where x = qdom])
-  apply (drule spec [where x = prio])
-  apply clarsimp
-  apply (drule (1) bspec, erule obj_at'_weakenE)
-  apply simp
-  done
-
-lemma invs_valid_q:
-  "invs' s \<Longrightarrow> (\<forall>tcb\<in>set (ksReadyQueues s (qdom, prio)). tcb_at' tcb s) \<and> distinct (ksReadyQueues s (qdom, prio))"
-  apply (rule valid_queues_valid_q)
-  apply (clarsimp simp: invs'_def valid_state'_def)
-  done
-
-lemma tcbQueued_not_in_queues:
-  assumes vq: "valid_queues s"
-  and    objat: "obj_at' (Not \<circ> tcbQueued) thread s"
-  shows   "thread \<notin> set (ksReadyQueues s (d, p))"
-  using vq objat
-  apply -
-  apply clarsimp
-  apply (drule (1) valid_queues_obj_at'D)
-  apply (erule obj_atE')+
-  apply (clarsimp simp: inQ_def)
-  done
-
-
-lemma rf_sr_sched_queue_relation:
-  "\<lbrakk> (s, s') \<in> rf_sr; d \<le> ucast maxDom; p \<le> ucast maxPrio \<rbrakk>
-  \<Longrightarrow> sched_queue_relation' (cslift s') (ksReadyQueues s (d, p))
-                                        (head_C (index (ksReadyQueues_' (globals s'))
-                                                       (cready_queues_index_to_C d p)))
-                                        (end_C (index (ksReadyQueues_' (globals s'))
-                                                      (cready_queues_index_to_C d p)))"
-  unfolding rf_sr_def cstate_relation_def cready_queues_relation_def
-  apply (clarsimp simp: Let_def seL4_MinPrio_def minDom_def)
-  done
-
-lemma ready_queue_not_in:
-  assumes  vq: "valid_queues s"
-  and     inq: "t \<in> set (ksReadyQueues s (d, p))"
-  and     neq: "d \<noteq> d' \<or> p \<noteq> p'"
-  shows   "t \<notin> set (ksReadyQueues s (d', p'))"
-proof
-  assume "t \<in> set (ksReadyQueues s (d', p'))"
-  hence "obj_at' (inQ d' p') t s" using vq by (rule valid_queues_obj_at'D)
-  moreover have "obj_at' (inQ d p) t s" using inq vq by (rule valid_queues_obj_at'D)
-  ultimately show False using neq
-    by (clarsimp elim!: obj_atE' simp: inQ_def)
-qed
-
 lemma ctcb_relation_unat_prio_eq:
   "ctcb_relation tcb tcb' \<Longrightarrow> unat (tcbPriority tcb) = unat (tcbPriority_C tcb')"
   apply (clarsimp simp: ctcb_relation_def)
@@ -656,137 +473,6 @@ lemma threadSet_queued_ccorres [corres]:
   apply (clarsimp simp: typ_heap_simps)
   done
 
-lemma ccorres_pre_getQueue:
-  assumes cc: "\<And>queue. ccorres r xf (P queue) (P' queue) hs (f queue) c"
-  shows   "ccorres r xf (\<lambda>s. P (ksReadyQueues s (d, p)) s \<and> d \<le> maxDomain \<and> p \<le> maxPriority)
-                        {s'. \<forall>queue. (let cqueue = index (ksReadyQueues_' (globals s'))
-                                                         (cready_queues_index_to_C d p) in
-                                      sched_queue_relation' (cslift s') queue (head_C cqueue) (end_C cqueue)) \<longrightarrow> s' \<in> P' queue}
-           hs (getQueue d p >>= (\<lambda>queue. f queue)) c"
-  apply (rule ccorres_guard_imp2)
-  apply (rule ccorres_symb_exec_l2)
-     defer
-     defer
-     apply (rule gq_sp)
-    defer
-    apply (rule ccorres_guard_imp)
-    apply (rule cc)
-     apply clarsimp
-     apply assumption
-    apply assumption
-   apply (clarsimp simp: getQueue_def gets_exs_valid)
-  apply clarsimp
-  apply (drule spec, erule mp)
-  apply (simp add: Let_def)
-  apply (erule rf_sr_sched_queue_relation)
-   apply (simp add: maxDom_to_H maxPrio_to_H)+
-  done
-
-lemma state_relation_queue_update_helper':
-  "\<lbrakk> (s, s') \<in> rf_sr;
-     (\<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s)
-                                       \<and> distinct (ksReadyQueues s (d, p)));
-          globals t = ksReadyQueues_'_update
-             (\<lambda>_. Arrays.update (ksReadyQueues_' (globals s')) prio' q')
-             (t_hrs_'_update f (globals s'));
-          sched_queue_relation' (cslift t) q (head_C q') (end_C q');
-          cslift t |` ( - tcb_ptr_to_ctcb_ptr ` S )
-             = cslift s' |` ( - tcb_ptr_to_ctcb_ptr ` S );
-          option_map tcb_null_sched_ptrs \<circ> cslift t
-            = option_map tcb_null_sched_ptrs \<circ> cslift s';
-          cslift_all_but_tcb_C t s';
-          zero_ranges_are_zero (gsUntypedZeroRanges s) (f (t_hrs_' (globals s')))
-              = zero_ranges_are_zero (gsUntypedZeroRanges s) (t_hrs_' (globals s'));
-          hrs_htd (t_hrs_' (globals t)) = hrs_htd (t_hrs_' (globals s'));
-          prio' = cready_queues_index_to_C qdom prio;
-          \<forall>x \<in> S. obj_at' (inQ qdom prio) x s
-                   \<or> (obj_at' (\<lambda>tcb. tcbPriority tcb = prio) x s
-                       \<and> obj_at' (\<lambda>tcb. tcbDomain tcb = qdom) x s)
-                   \<or> (tcb_at' x s \<and> (\<forall>d' p'. (d' \<noteq> qdom \<or> p' \<noteq> prio)
-                                         \<longrightarrow> x \<notin> set (ksReadyQueues s (d', p'))));
-          S \<noteq> {}; qdom \<le> ucast maxDom; prio \<le> ucast maxPrio \<rbrakk>
-      \<Longrightarrow> (s \<lparr>ksReadyQueues := (ksReadyQueues s)((qdom, prio) := q)\<rparr>, t) \<in> rf_sr"
-  apply (subst(asm) disj_imp_rhs)
-   apply (subst obj_at'_and[symmetric])
-   apply (rule disjI1, erule obj_at'_weakenE, simp add: inQ_def)
-  apply (subst(asm) disj_imp_rhs)
-   apply (subst(asm) obj_at'_and[symmetric])
-   apply (rule conjI, erule obj_at'_weakenE, simp)
-   apply (rule allI, rule allI)
-   apply (drule_tac x=d' in spec)
-   apply (drule_tac x=p' in spec)
-   apply clarsimp
-   apply (drule(1) bspec)
-   apply (clarsimp simp: inQ_def obj_at'_def)
-  apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def)
-  apply (intro conjI)
-      \<comment> \<open>cpspace_relation\<close>
-     apply (erule nonemptyE, drule(1) bspec)
-     apply (clarsimp simp: cpspace_relation_def)
-     apply (drule obj_at_ko_at', clarsimp)
-     apply (rule cmap_relationE1, assumption,
-            erule ko_at_projectKO_opt)
-     apply (frule null_sched_queue)
-     apply (frule null_sched_epD)
-     apply (intro conjI)
-       \<comment> \<open>tcb relation\<close>
-       apply (drule ctcb_relation_null_queue_ptrs,
-              simp_all)[1]
-      \<comment> \<open>endpoint relation\<close>
-      apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-      apply simp
-      apply (erule cendpoint_relation_upd_tcb_no_queues, simp+)
-     \<comment> \<open>ntfn relation\<close>
-     apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-     apply simp
-     apply (erule cnotification_relation_upd_tcb_no_queues, simp+)
-    \<comment> \<open>ready queues\<close>
-    apply (simp add: cready_queues_relation_def Let_def cready_queues_index_to_C_in_range
-                     seL4_MinPrio_def minDom_def)
-    apply clarsimp
-    apply (frule cready_queues_index_to_C_distinct, assumption+)
-    apply (clarsimp simp: cready_queues_index_to_C_in_range all_conj_distrib)
-    apply (rule iffD1 [OF tcb_queue_relation'_cong[OF refl], rotated -1],
-           drule spec, drule spec, erule mp, simp+)
-    apply clarsimp
-    apply (drule_tac x="tcb_ptr_to_ctcb_ptr x" in fun_cong)+
-    apply (clarsimp simp: restrict_map_def
-                   split: if_split_asm)
-   by (auto simp: carch_state_relation_def cmachine_state_relation_def)
-
-lemma state_relation_queue_update_helper:
-  "\<lbrakk> (s, s') \<in> rf_sr; valid_queues s;
-          globals t = ksReadyQueues_'_update
-             (\<lambda>_. Arrays.update (ksReadyQueues_' (globals s')) prio' q')
-             (t_hrs_'_update f (globals s'));
-          sched_queue_relation' (cslift t) q (head_C q') (end_C q');
-          cslift t |` ( - tcb_ptr_to_ctcb_ptr ` S )
-             = cslift s' |` ( - tcb_ptr_to_ctcb_ptr ` S );
-          option_map tcb_null_sched_ptrs \<circ> cslift t
-            = option_map tcb_null_sched_ptrs \<circ> cslift s';
-          cslift_all_but_tcb_C t s';
-          zero_ranges_are_zero (gsUntypedZeroRanges s) (f (t_hrs_' (globals s')))
-              = zero_ranges_are_zero (gsUntypedZeroRanges s) (t_hrs_' (globals s'));
-          hrs_htd (t_hrs_' (globals t)) = hrs_htd (t_hrs_' (globals s'));
-          prio' = cready_queues_index_to_C qdom prio;
-          \<forall>x \<in> S. obj_at' (inQ qdom prio) x s
-                   \<or> (obj_at' (\<lambda>tcb. tcbPriority tcb = prio) x s
-                       \<and> obj_at' (\<lambda>tcb. tcbDomain tcb = qdom) x s)
-                   \<or> (tcb_at' x s \<and> (\<forall>d' p'. (d' \<noteq> qdom \<or> p' \<noteq> prio)
-                                         \<longrightarrow> x \<notin> set (ksReadyQueues s (d', p'))));
-          S \<noteq> {}; qdom \<le> ucast maxDom; prio \<le> ucast maxPrio \<rbrakk>
-      \<Longrightarrow> (s \<lparr>ksReadyQueues := (ksReadyQueues s)((qdom, prio) := q)\<rparr>, t) \<in> rf_sr"
-  apply (subgoal_tac "\<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s)
-                           \<and> distinct(ksReadyQueues s (d, p))")
-   apply (erule(5) state_relation_queue_update_helper', simp_all)
-  apply (clarsimp simp: valid_queues_def valid_queues_no_bitmap_def)
-  apply (drule_tac x=d in spec)
-  apply (drule_tac x=p in spec)
-  apply (clarsimp)
-  apply (drule(1) bspec)
-  apply (erule obj_at'_weakenE, clarsimp)
-  done
-
 (* FIXME: move *)
 lemma cmap_relation_no_upd:
   "\<lbrakk> cmap_relation a c f rel; a p = Some ko; rel ko v; inj f \<rbrakk> \<Longrightarrow> cmap_relation a (c(f p \<mapsto> v)) f rel"
@@ -831,8 +517,8 @@ lemma cready_queues_index_to_C_def2:
 lemma ready_queues_index_spec:
   "\<forall>s. \<Gamma> \<turnstile> {s'. s' = s \<and> (Kernel_Config.numDomains \<le> 1 \<longrightarrow> dom_' s' = 0)}
        Call ready_queues_index_'proc
-       \<lbrace>\<acute>ret__unsigned_long = (dom_' s) * 0x100 + (prio_' s)\<rbrace>"
-  by vcg (simp add: numDomains_sge_1_simp)
+       \<lbrace>\<acute>ret__unsigned_long = (dom_' s) * word_of_nat numPriorities + (prio_' s)\<rbrace>"
+  by vcg (simp add: numDomains_sge_1_simp numPriorities_def)
 
 lemma prio_to_l1index_spec:
   "\<forall>s. \<Gamma> \<turnstile> {s} Call prio_to_l1index_'proc
@@ -927,56 +613,6 @@ lemma cbitmap_L2_relation_bit_set:
   apply (case_tac "da = d" ; clarsimp simp: num_domains_index_updates)
   done
 
-lemma carch_state_relation_enqueue_simp:
-  "carch_state_relation (ksArchState \<sigma>)
-    (t_hrs_'_update f
-      (globals \<sigma>' \<lparr>ksReadyQueuesL1Bitmap_' := l1upd, ksReadyQueuesL2Bitmap_' := l2upd \<rparr>)
-      \<lparr>ksReadyQueues_' := rqupd \<rparr>) =
-   carch_state_relation (ksArchState \<sigma>) (t_hrs_'_update f (globals \<sigma>'))"
-  unfolding carch_state_relation_def
-  by clarsimp
-
-lemma t_hrs_ksReadyQueues_upd_absorb:
-  "t_hrs_'_update f (g s) \<lparr>ksReadyQueues_' := rqupd \<rparr> =
-   t_hrs_'_update f (g s \<lparr>ksReadyQueues_' := rqupd\<rparr>)"
-  by simp
-
-lemma rf_sr_drop_bitmaps_enqueue_helper:
-  "\<lbrakk> (\<sigma>,\<sigma>') \<in> rf_sr ;
-     cbitmap_L1_relation ksqL1upd' ksqL1upd ; cbitmap_L2_relation ksqL2upd' ksqL2upd \<rbrakk>
-   \<Longrightarrow>
-   ((\<sigma>\<lparr>ksReadyQueues := ksqupd, ksReadyQueuesL1Bitmap := ksqL1upd, ksReadyQueuesL2Bitmap := ksqL2upd\<rparr>,
-     \<sigma>'\<lparr>idx___unsigned_long_' := i', queue_' := queue_upd',
-        globals := t_hrs_'_update f
-          (globals \<sigma>'
-             \<lparr>ksReadyQueuesL1Bitmap_' := ksqL1upd',
-              ksReadyQueuesL2Bitmap_' := ksqL2upd',
-              ksReadyQueues_' := ksqupd'\<rparr>)\<rparr>) \<in> rf_sr) =
-   ((\<sigma>\<lparr>ksReadyQueues := ksqupd\<rparr>,
-     \<sigma>'\<lparr>idx_' := i', queue_' := queue_upd',
-        globals := t_hrs_'_update f
-          (globals \<sigma>' \<lparr>ksReadyQueues_' := ksqupd'\<rparr>)\<rparr>) \<in> rf_sr)"
-  unfolding rf_sr_def cstate_relation_def Let_def
-             carch_state_relation_def cmachine_state_relation_def
-  by (clarsimp simp: rf_sr_cbitmap_L1_relation rf_sr_cbitmap_L2_relation)
-
-lemma cmachine_state_relation_enqueue_simp:
-  "cmachine_state_relation (ksMachineState \<sigma>)
-    (t_hrs_'_update f
-      (globals \<sigma>' \<lparr>ksReadyQueuesL1Bitmap_' := l1upd, ksReadyQueuesL2Bitmap_' := l2upd \<rparr>)
-      \<lparr>ksReadyQueues_' := rqupd \<rparr>) =
-   cmachine_state_relation (ksMachineState \<sigma>) (t_hrs_'_update f (globals \<sigma>'))"
-  unfolding cmachine_state_relation_def
-  by clarsimp
-
-lemma tcb_queue_relation'_empty_ksReadyQueues:
-  "\<lbrakk> sched_queue_relation' (cslift x) (q s) NULL NULL ; \<forall>t\<in> set (q s). tcb_at' t s  \<rbrakk> \<Longrightarrow> q s = []"
-  apply (clarsimp simp add: tcb_queue_relation'_def)
-  apply (subst (asm) eq_commute)
-  apply (cases "q s" rule: rev_cases, simp)
-  apply (clarsimp simp: tcb_at_not_NULL)
-  done
-
 lemma invert_prioToL1Index_c_simp:
   "p \<le> maxPriority
    \<Longrightarrow>
@@ -990,13 +626,248 @@ lemma c_invert_assist: "3 - (ucast (p :: priority) >> 6 :: machine_word) < 4"
   using prio_ucast_shiftr_wordRadix_helper'[simplified wordRadix_def]
   by - (rule word_less_imp_diff_less, simp_all)
 
+lemma addToBitmap_ccorres:
+  "ccorres dc xfdc
+     (K (tdom \<le> maxDomain \<and> prio \<le> maxPriority)) (\<lbrace>\<acute>dom = ucast tdom\<rbrace> \<inter> \<lbrace>\<acute>prio = ucast prio\<rbrace>) hs
+     (addToBitmap tdom prio) (Call addToBitmap_'proc)"
+  supply prio_and_dom_limit_helpers[simp] invert_prioToL1Index_c_simp[simp]
+  apply (rule ccorres_from_vcg)
+  apply (rule allI, rule conseqPre, vcg)
+  apply clarsimp
+  apply (frule maxDomain_le_unat_ucast_explicit)
+  apply (clarsimp simp: getQueue_def gets_def get_def setQueue_def modify_def
+                        put_def bind_def return_def bitmap_fun_defs)
+  apply (intro conjI impI allI)
+   apply (fastforce simp: c_invert_assist l2BitmapSize_def' wordRadix_def)
+  apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
+                        carch_state_relation_def cmachine_state_relation_def)
+  apply (rule conjI)
+   apply (clarsimp intro!: cbitmap_L1_relation_bit_set)
+  apply (fastforce dest!: cbitmap_L2_relation_bit_set simp: wordRadix_def mask_def)
+  done
+
+lemma rf_sr_tcb_update_twice:
+  "h_t_valid (hrs_htd (hrs2 (globals s') (t_hrs_' (gs2 (globals s'))))) c_guard
+      (ptr (t_hrs_' (gs2 (globals s'))) (globals s'))
+    \<Longrightarrow> ((s, globals_update (\<lambda>gs. t_hrs_'_update (\<lambda>ths.
+        hrs_mem_update (heap_update (ptr ths gs :: tcb_C ptr) (v ths gs))
+            (hrs_mem_update (heap_update (ptr ths gs) (v' ths gs)) (hrs2 gs ths))) (gs2 gs)) s') \<in> rf_sr)
+    = ((s, globals_update (\<lambda>gs. t_hrs_'_update (\<lambda>ths.
+        hrs_mem_update (heap_update (ptr ths gs) (v ths gs)) (hrs2 gs ths)) (gs2 gs)) s') \<in> rf_sr)"
+  by (simp add: rf_sr_def cstate_relation_def Let_def
+                cpspace_relation_def typ_heap_simps'
+                carch_state_relation_def cmachine_state_relation_def
+                packed_heap_update_collapse_hrs)
+
+lemmas rf_sr_tcb_update_no_queue_gen2 =
+  rf_sr_obj_update_helper[OF rf_sr_tcb_update_no_queue_gen, simplified]
+
+lemma tcb_queue_prepend_ccorres:
+  "ccorres ctcb_queue_relation ret__struct_tcb_queue_C_'
+     (\<lambda>s. tcb_at' tcbPtr s
+          \<and> (tcbQueueHead queue \<noteq> None \<longleftrightarrow> tcbQueueEnd queue \<noteq> None)
+          \<and> (\<forall>head. tcbQueueHead queue = Some head \<longrightarrow> tcb_at' head s))
+     (\<lbrace>ctcb_queue_relation queue \<acute>queue\<rbrace> \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr tcbPtr\<rbrace>) hs
+     (tcbQueuePrepend queue tcbPtr) (Call tcb_queue_prepend_'proc)"
+  (is "ccorres _ _ ?abs _ _ _ _")
+  supply if_split[split del]
+  apply (cinit lift: tcb_')
+   \<comment> \<open>cinit is not able to lift queue_' because queue_' is later modified in the C program\<close>
+   apply (rule_tac xf'=queue_' in ccorres_abstract, ceqv, rename_tac cqueue)
+   apply (rule_tac P="ctcb_queue_relation queue cqueue" in ccorres_gen_asm2)
+   apply (rule_tac xf'=ret__unsigned_long_'
+               and val="from_bool (tcbQueueEmpty queue)"
+               and R="?abs"
+               and R'="\<lbrace>\<acute>queue = cqueue\<rbrace>"
+                in ccorres_symb_exec_r_known_rv)
+      apply (rule conseqPre, vcg)
+      apply (fastforce dest: tcb_at_not_NULL
+                       simp: ctcb_queue_relation_def option_to_ctcb_ptr_def tcbQueueEmpty_def)
+     apply ceqv
+    apply (rule_tac r'=ctcb_queue_relation and xf'=queue_' in ccorres_split_nothrow)
+        apply (rule_tac Q="?abs"
+                    and Q'="\<lambda>s'. queue_' s' = cqueue"
+                     in ccorres_cond_both')
+          apply fastforce
+         apply clarsimp
+         apply (rule ccorres_return[where R=\<top>])
+         apply (rule conseqPre, vcg)
+         apply (fastforce simp: ctcb_queue_relation_def option_to_ctcb_ptr_def)
+        apply (rule ccorres_seq_skip'[THEN iffD1])
+        apply (rule ccorres_rhs_assoc)+
+        apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+            apply (rule ccorres_Guard)
+            apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb tcbPtr s
+                                            \<and> head_C cqueue = option_to_ctcb_ptr (tcbQueueHead queue)}"
+                        and R="\<lbrace>head_C cqueue = option_to_ctcb_ptr (tcbQueueHead queue)\<rbrace>"
+                         in threadSet_ccorres_lemma4[where P=\<top> and P'=\<top>])
+             apply (rule conseqPre, vcg)
+             apply clarsimp
+             apply (frule (1) obj_at_cslift_tcb)
+             apply (fastforce intro!: rf_sr_tcb_update_no_queue_gen2
+                                simp: typ_heap_simps' tcb_cte_cases_def cteSizeBits_def
+                                      ctcb_relation_def option_to_ctcb_ptr_def)
+            apply (clarsimp simp: ctcb_relation_def option_to_ctcb_ptr_def split: if_splits)
+           apply ceqv
+          apply simp
+          apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+              apply (rule ccorres_Guard)
+              apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr
+                                              \<and> ko_at' tcb (the (tcbQueueHead queue)) s
+                                              \<and> head_C cqueue = option_to_ctcb_ptr (tcbQueueHead queue)}"
+                          and R="\<lbrace>head_C cqueue = option_to_ctcb_ptr (tcbQueueHead queue)\<rbrace>"
+                           in threadSet_ccorres_lemma4[where P=\<top> and P'=\<top>])
+               apply (rule conseqPre, vcg)
+               apply clarsimp
+               apply (frule (1) obj_at_cslift_tcb)
+               apply (fastforce intro!: rf_sr_tcb_update_no_queue_gen2
+                                  simp: typ_heap_simps' tcb_cte_cases_def cteSizeBits_def
+                                        ctcb_relation_def option_to_ctcb_ptr_def tcbQueueEmpty_def)
+              apply fastforce
+             apply ceqv
+            apply (rule ccorres_return_Skip')
+           apply wpsimp
+          apply vcg
+         apply wpsimp
+        apply vcg
+       apply ceqv
+      apply csymbr
+      apply (fastforce intro: ccorres_return_C')
+     apply wpsimp
+    apply vcg
+   apply clarsimp
+   apply (vcg exspec=tcb_queue_empty_modifies)
+  apply clarsimp
+  apply (frule (1) tcb_at_h_t_valid)
+  by (force dest: tcb_at_h_t_valid
+            simp: ctcb_queue_relation_def option_to_ctcb_ptr_def tcbQueueEmpty_def)
+
+lemma tcb_queue_append_ccorres:
+  "ccorres ctcb_queue_relation ret__struct_tcb_queue_C_'
+     (\<lambda>s. tcb_at' tcbPtr s
+          \<and> (tcbQueueHead queue \<noteq> None \<longleftrightarrow> tcbQueueEnd queue \<noteq> None)
+          \<and> (\<forall>head. tcbQueueHead queue = Some head \<longrightarrow> tcb_at' head s)
+          \<and> (\<forall>end. tcbQueueEnd queue = Some end \<longrightarrow> tcb_at' end s))
+     (\<lbrace>ctcb_queue_relation queue \<acute>queue\<rbrace> \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr tcbPtr\<rbrace>) hs
+     (tcbQueueAppend queue tcbPtr) (Call tcb_queue_append_'proc)"
+  (is "ccorres _ _ ?abs _ _ _ _")
+  supply if_split[split del]
+  apply (cinit lift: tcb_')
+   \<comment> \<open>cinit is not able to lift queue_' because queue_' is later modified in the C program\<close>
+   apply (rule_tac xf'=queue_' in ccorres_abstract, ceqv, rename_tac cqueue)
+   apply (rule_tac P="ctcb_queue_relation queue cqueue
+                      \<and> (tcbQueueHead queue \<noteq> None \<longleftrightarrow> tcbQueueEnd queue \<noteq> None)"
+                in ccorres_gen_asm2)
+   apply (rule_tac xf'=ret__unsigned_long_'
+               and val="from_bool (tcbQueueEmpty queue)"
+               and R="?abs"
+               and R'="\<lbrace>\<acute>queue = cqueue\<rbrace>"
+                in ccorres_symb_exec_r_known_rv)
+      apply (rule conseqPre, vcg)
+      apply (fastforce dest: tcb_at_not_NULL
+                       simp: ctcb_queue_relation_def option_to_ctcb_ptr_def tcbQueueEmpty_def)
+     apply ceqv
+    apply (rule_tac r'=ctcb_queue_relation and xf'=queue_' in ccorres_split_nothrow)
+        apply (rule_tac Q="?abs"
+                    and Q'="\<lambda>s'. queue_' s' = cqueue"
+                     in ccorres_cond_both')
+          apply (fastforce dest: tcb_at_not_NULL
+                           simp: ctcb_queue_relation_def option_to_ctcb_ptr_def)
+         apply clarsimp
+         apply (rule ccorres_return[where R=\<top>])
+         apply (rule conseqPre, vcg)
+         apply (fastforce simp: ctcb_queue_relation_def option_to_ctcb_ptr_def)
+        apply (rule ccorres_seq_skip'[THEN iffD1])
+        apply (rule ccorres_rhs_assoc)+
+        apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+            apply (rule ccorres_Guard)
+            apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb tcbPtr s
+                                            \<and> end_C cqueue = option_to_ctcb_ptr (tcbQueueEnd queue)}"
+                        and R="\<lbrace>end_C cqueue = option_to_ctcb_ptr (tcbQueueEnd queue)\<rbrace>"
+                         in threadSet_ccorres_lemma4[where P=\<top> and P'=\<top>])
+             apply (rule conseqPre, vcg)
+             apply clarsimp
+             apply (frule (1) obj_at_cslift_tcb)
+             apply (fastforce intro!: rf_sr_tcb_update_no_queue_gen2
+                                simp: typ_heap_simps' tcb_cte_cases_def cteSizeBits_def
+                                      ctcb_relation_def option_to_ctcb_ptr_def)
+            apply (clarsimp simp: ctcb_relation_def option_to_ctcb_ptr_def split: if_splits)
+           apply ceqv
+          apply simp
+          apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+              apply (rule ccorres_Guard)
+              apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr
+                                              \<and> ko_at' tcb (the (tcbQueueEnd queue)) s
+                                              \<and> end_C cqueue = option_to_ctcb_ptr (tcbQueueEnd queue)}"
+                          and R="\<lbrace>end_C cqueue = option_to_ctcb_ptr (tcbQueueEnd queue)\<rbrace>"
+                           in threadSet_ccorres_lemma4[where P=\<top> and P'=\<top>])
+               apply (rule conseqPre, vcg)
+               apply clarsimp
+               apply (frule (1) obj_at_cslift_tcb)
+               apply (fastforce intro!: rf_sr_tcb_update_no_queue_gen2
+                                  simp: typ_heap_simps' tcb_cte_cases_def cteSizeBits_def
+                                        ctcb_relation_def option_to_ctcb_ptr_def tcbQueueEmpty_def)
+              apply fastforce
+             apply ceqv
+            apply (rule ccorres_return_Skip')
+           apply wpsimp
+          apply vcg
+         apply wpsimp
+        apply vcg
+       apply ceqv
+      apply csymbr
+      apply (fastforce intro: ccorres_return_C')
+     apply wpsimp
+    apply vcg
+   apply (vcg exspec=tcb_queue_empty_modifies)
+  apply clarsimp
+  apply (frule (1) tcb_at_h_t_valid)
+  by (force dest: tcb_at_h_t_valid
+            simp: ctcb_queue_relation_def option_to_ctcb_ptr_def tcbQueueEmpty_def)
+
+lemma getQueue_ccorres:
+  "ccorres ctcb_queue_relation queue_'
+     (K (tdom \<le> maxDomain \<and> prio \<le> maxPriority))
+     \<lbrace>\<acute>idx___unsigned_long = word_of_nat (cready_queues_index_to_C tdom prio)\<rbrace> hs
+     (getQueue tdom prio) (\<acute>queue :== \<acute>ksReadyQueues.[unat \<acute>idx___unsigned_long])"
+  apply (rule ccorres_from_vcg)
+  apply (rule allI, rule conseqPre, vcg)
+  apply (clarsimp simp: getQueue_def gets_def get_def bind_def return_def)
+  apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def)
+  apply (frule (1) cready_queues_index_to_C_in_range)
+  apply (clarsimp simp: unat_of_nat_eq cready_queues_relation_def)
+  done
+
+lemma setQueue_ccorres:
+  "ctcb_queue_relation queue cqueue \<Longrightarrow>
+   ccorres dc xfdc
+     (K (tdom \<le> maxDomain \<and> prio \<le> maxPriority))
+     \<lbrace>\<acute>idx___unsigned_long = word_of_nat (cready_queues_index_to_C tdom prio)\<rbrace> hs
+     (setQueue tdom prio queue)
+     (Basic (\<lambda>s. globals_update
+                  (ksReadyQueues_'_update
+                   (\<lambda>_. Arrays.update (ksReadyQueues_' (globals s))
+                                      (unat (idx___unsigned_long_' s)) cqueue)) s))"
+  apply (rule ccorres_from_vcg)
+  apply (rule allI, rule conseqPre, vcg)
+  apply (clarsimp simp: setQueue_def get_def modify_def put_def bind_def)
+  apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
+                        carch_state_relation_def cmachine_state_relation_def)
+  apply (frule (1) cready_queues_index_to_C_in_range)
+  apply (clarsimp simp: unat_of_nat_eq cready_queues_relation_def)
+  apply (frule cready_queues_index_to_C_distinct, assumption+)
+  apply (frule_tac qdom=d and prio=p in cready_queues_index_to_C_in_range)
+   apply fastforce
+  apply clarsimp
+  done
+
+crunch (empty_fail) empty_fail[wp]: isRunnable
+
 lemma tcbSchedEnqueue_ccorres:
   "ccorres dc xfdc
-           (valid_queues and tcb_at' t and valid_objs')
-           (UNIV \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace>)
-           hs
-           (tcbSchedEnqueue t)
-           (Call tcbSchedEnqueue_'proc)"
+     (tcb_at' t and valid_objs' and pspace_aligned' and pspace_distinct')
+     \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace> hs
+     (tcbSchedEnqueue t) (Call tcbSchedEnqueue_'proc)"
 proof -
   note prio_and_dom_limit_helpers[simp] word_sle_def[simp] maxDom_to_H[simp] maxPrio_to_H[simp]
   note invert_prioToL1Index_c_simp[simp]
@@ -1007,24 +878,12 @@ proof -
 
   show ?thesis
     apply (cinit lift: tcb_')
-     apply (rule_tac r'="\<lambda>rv rv'. rv = to_bool rv'" and xf'="ret__unsigned_longlong_'"
-              in ccorres_split_nothrow)
-         apply (rule threadGet_vcg_corres)
-         apply (rule allI, rule conseqPre, vcg)
-         apply clarsimp
-         apply (drule obj_at_ko_at', clarsimp)
-         apply (drule spec, drule(1) mp, clarsimp)
-         apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-        apply ceqv
-       apply (simp add: when_def unless_def del: Collect_const split del: if_split)
-       apply (rule ccorres_cond[where R=\<top>])
-         apply (simp add: to_bool_def)
-        apply (rule ccorres_rhs_assoc)+
-        apply csymbr
-        apply csymbr
-        apply csymbr
-        apply csymbr
-        apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="dom_'" in ccorres_split_nothrow)
+     apply (rule ccorres_stateAssert)+
+     apply (rule ccorres_symb_exec_l)
+        apply (rule ccorres_assert)
+        apply (thin_tac runnable)
+        apply (rule_tac r'="\<lambda>rv rv'. rv = to_bool rv'" and xf'="ret__unsigned_longlong_'"
+                     in ccorres_split_nothrow)
             apply (rule threadGet_vcg_corres)
             apply (rule allI, rule conseqPre, vcg)
             apply clarsimp
@@ -1032,244 +891,244 @@ proof -
             apply (drule spec, drule(1) mp, clarsimp)
             apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
            apply ceqv
-          apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="prio_'" in ccorres_split_nothrow)
-              apply (rule threadGet_vcg_corres)
-              apply (rule allI, rule conseqPre, vcg)
-              apply clarsimp
-              apply (drule obj_at_ko_at', clarsimp)
-              apply (drule spec, drule(1) mp, clarsimp)
-              apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-             apply ceqv
-            apply (rule ccorres_rhs_assoc2)+
-            apply (simp only: bind_assoc[symmetric])
-            apply (rule ccorres_split_nothrow_novcg_dc)
-               prefer 2
-               apply (rule ccorres_move_c_guard_tcb)
-               apply simp
-               apply ctac
-              prefer 2
-              apply (wp, clarsimp, wp+)
-             apply (rule_tac P="\<lambda>s. valid_queues s \<and> (\<forall>p. t \<notin> set (ksReadyQueues s p))
-                                  \<and> (\<exists>tcb. ko_at' tcb t s \<and> tcbDomain tcb =rva
-                                  \<and> tcbPriority tcb = rvb \<and> valid_tcb' tcb s)"
-                         and P'=UNIV in ccorres_from_vcg)
-             apply (rule allI, rule conseqPre, vcg)
-             apply (clarsimp simp: getQueue_def gets_def get_def setQueue_def modify_def
-                                   put_def bind_def return_def bitmap_fun_defs null_def)
-             apply (clarsimp simp: queue_in_range valid_tcb'_def)
-             apply (rule conjI; clarsimp simp: queue_in_range)
-              (* queue is empty, set t to be new queue *)
-              apply (drule (1) obj_at_cslift_tcb)
-              apply clarsimp
-              apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb"
-                       in rf_sr_sched_queue_relation)
-                apply clarsimp
-               apply clarsimp
-              apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL)
-               apply (simp add: valid_queues_valid_q)
-              apply (subgoal_tac
-                      "head_C (ksReadyQueues_' (globals x)
-                         .[cready_queues_index_to_C (tcbDomain tcb) (tcbPriority tcb)]) = NULL")
-               prefer 2
-               apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL; simp add: valid_queues_valid_q)
-              apply (subgoal_tac
-                       "end_C (ksReadyQueues_' (globals x)
-                          .[cready_queues_index_to_C (tcbDomain tcb) (tcbPriority tcb)]) = NULL")
-               prefer 2
-               apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL[symmetric]; simp add: valid_queues_valid_q)
-              apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                        unat_trans_ucast_helper\<close>)
-              apply (frule maxDomain_le_unat_ucast_explicit)
-              apply (clarsimp simp: cready_queues_index_to_C_def numPriorities_def)
-              apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-              apply (simp add: t_hrs_ksReadyQueues_upd_absorb)
-
-              apply (rule conjI)
-               apply (clarsimp simp: l2BitmapSize_def' wordRadix_def c_invert_assist)
-
-              apply (subst rf_sr_drop_bitmaps_enqueue_helper, assumption)
-                apply (fastforce intro: cbitmap_L1_relation_bit_set)
-               apply (fastforce intro: cbitmap_L2_relation_bit_set simp: wordRadix_def mask_def)
-              apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb" in rf_sr_sched_queue_relation)
-                apply clarsimp
-               apply clarsimp
-              apply (drule_tac qhead'="tcb_ptr_to_ctcb_ptr t" and s=\<sigma> in tcbSchedEnqueue_update,
-                     simp_all add: valid_queues_valid_q)[1]
-               apply (rule tcb_at_not_NULL, erule obj_at'_weakenE, simp)
-              apply (erule(1) state_relation_queue_update_helper[where S="{t}"],
-                     (simp | rule globals.equality)+,
-                     simp_all add: cready_queues_index_to_C_def2 numPriorities_def
-                                   t_hrs_ksReadyQueues_upd_absorb upd_unless_null_def
-                                   typ_heap_simps)[1]
-               apply (fastforce simp: tcb_null_sched_ptrs_def typ_heap_simps c_guard_clift
-                                elim: obj_at'_weaken)+
-             apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                       unat_trans_ucast_helper\<close>)
-             apply clarsimp
-             apply (rule conjI; clarsimp simp: queue_in_range)
-              (* invalid, disagreement between C and Haskell on emptiness of queue *)
-              apply (drule (1) obj_at_cslift_tcb)
-              apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-              apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb" in rf_sr_sched_queue_relation)
-                apply clarsimp
-               apply clarsimp
-              apply (clarsimp simp: cready_queues_index_to_C_def numPriorities_def)
-              apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL)
-               apply (simp add: valid_queues_valid_q)
-              apply clarsimp
-              apply (drule tcb_queue_relation'_empty_ksReadyQueues; simp add: valid_queues_valid_q)
-             (* queue was not empty, add t to queue and leave bitmaps alone *)
-             apply (drule (1) obj_at_cslift_tcb)
-             apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-             apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb" in rf_sr_sched_queue_relation)
-               apply clarsimp
-              apply clarsimp
-             apply (clarsimp simp: cready_queues_index_to_C_def numPriorities_def)
-             apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL)
-              apply (simp add: valid_queues_valid_q)
-             apply clarsimp
-             apply (frule_tac t=\<sigma> in tcb_queue_relation_qhead_mem')
-              apply (simp add: valid_queues_valid_q)
-             apply (frule(1) tcb_queue_relation_qhead_valid')
-              apply (simp add: valid_queues_valid_q)
-             apply (clarsimp simp: typ_heap_simps h_t_valid_clift_Some_iff numPriorities_def
-                                   cready_queues_index_to_C_def2)
-             apply (drule_tac qhead'="tcb_ptr_to_ctcb_ptr t" and s=\<sigma> in tcbSchedEnqueue_update,
-                    simp_all add: valid_queues_valid_q)[1]
+          apply (simp add: when_def unless_def del: Collect_const split del: if_split)
+          apply (rule ccorres_cond[where R=\<top>])
+            apply (simp add: to_bool_def)
+           apply (rule ccorres_rhs_assoc)+
+           apply csymbr
+           apply csymbr
+           apply csymbr
+           apply csymbr
+           apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="dom_'" in ccorres_split_nothrow)
+               apply (rule threadGet_vcg_corres)
+               apply (rule allI, rule conseqPre, vcg)
                apply clarsimp
-
-              apply (rule tcb_at_not_NULL, erule obj_at'_weakenE, simp)
-             apply (frule(2) obj_at_cslift_tcb[OF valid_queues_obj_at'D])
-             apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-             apply (erule_tac S="{t, v}" for v in state_relation_queue_update_helper,
-                    (simp | rule globals.equality)+,
-                    simp_all add: typ_heap_simps if_Some_helper numPriorities_def
-                                  cready_queues_index_to_C_def2 upd_unless_null_def
-                             del: fun_upd_restrict_conv
-                             cong: if_cong
-                             split del: if_split)[1]
-                 apply simp
-                 apply (rule conjI)
+               apply (drule obj_at_ko_at', clarsimp)
+               apply (drule spec, drule(1) mp, clarsimp)
+               apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+              apply ceqv
+             apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="prio_'" in ccorres_split_nothrow)
+                 apply (rule threadGet_vcg_corres)
+                 apply (rule allI, rule conseqPre, vcg)
+                 apply clarsimp
+                 apply (drule obj_at_ko_at', clarsimp)
+                 apply (drule spec, drule(1) mp, clarsimp)
+                 apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+                apply ceqv
+               apply (rule ccorres_rhs_assoc2)+
+               apply (simp only: bind_assoc[symmetric])
+               apply (rule ccorres_split_nothrow_novcg_dc)
+                  prefer 2
+                  apply (rule ccorres_move_c_guard_tcb)
+                  apply (simp only: dc_def[symmetric])
+                  apply ctac
+                 apply (rule ccorres_rhs_assoc)+
+                 apply (rule ccorres_symb_exec_r)
+                   apply (rule ccorres_Guard_Seq)
+                   apply (simp add: bind_assoc)
+                   apply (ctac add: getQueue_ccorres)
+                     apply (rename_tac queue cqueue)
+                     apply (rule_tac xf'=ret__unsigned_long_'
+                                 and val="from_bool (tcbQueueEmpty queue)"
+                                 and R="\<lambda>s. \<not> tcbQueueEmpty queue \<longrightarrow> tcb_at' (the (tcbQueueHead queue)) s
+                                            \<and> (tcbQueueHead queue \<noteq> None \<longleftrightarrow> tcbQueueEnd queue \<noteq> None)"
+                                 and R'="{s'. queue_' s' = cqueue}"
+                                  in ccorres_symb_exec_r_known_rv)
+                        apply (rule conseqPre, vcg)
+                        apply (fastforce dest: tcb_at_not_NULL
+                                         simp: ctcb_queue_relation_def option_to_ctcb_ptr_def
+                                               tcbQueueEmpty_def)
+                       apply ceqv
+                      apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                          apply (rule ccorres_cond[where R=\<top>])
+                            apply fastforce
+                           apply (ctac add: addToBitmap_ccorres)
+                          apply (rule ccorres_return_Skip)
+                         apply ceqv
+                        apply (ctac add: tcb_queue_prepend_ccorres)
+                          apply (rule ccorres_Guard)
+                          apply (rule setQueue_ccorres)
+                          apply fastforce
+                         apply wpsimp
+                        apply (vcg exspec=tcb_queue_prepend_modifies)
+                       apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift')
+                      apply (vcg exspec=addToBitmap_modifies)
+                     apply vcg
+                    apply wpsimp
+                   apply vcg
                   apply clarsimp
-                  apply (drule_tac s="tcb_ptr_to_ctcb_ptr t" in sym, simp)
-                 apply (clarsimp simp add: fun_upd_twist)
-                prefer 4
-                apply (simp add: obj_at'_weakenE[OF _ TrueI])
-                apply (rule disjI1, erule (1) valid_queues_obj_at'D)
-               apply clarsimp
-              apply (fastforce simp: tcb_null_sched_ptrs_def)
-             apply (simp add: typ_heap_simps c_guard_clift)
-            apply (simp add: guard_is_UNIV_def)
-           apply simp
-           apply (wp threadGet_wp)
-          apply vcg
-         apply simp
-         apply (wp threadGet_wp)
-        apply vcg
-       apply (rule ccorres_return_Skip)
-      apply simp
-      apply (wp threadGet_wp)
-     apply vcg
-    apply (fastforce simp: valid_objs'_def obj_at'_def ran_def projectKOs typ_at'_def
-                           valid_obj'_def inQ_def
-                    dest!: valid_queues_obj_at'D)
-  done
+                  apply vcg
+                 apply (rule conseqPre, vcg)
+                 apply clarsimp
+                apply wpsimp
+               apply (clarsimp simp: guard_is_UNIV_def)
+              apply (wpsimp wp: threadGet_wp)
+             apply vcg
+            apply clarsimp
+            apply (wpsimp wp: threadGet_wp)
+           apply vcg
+          apply (rule ccorres_return_Skip)
+         apply (wpsimp wp: threadGet_wp)
+        apply (vcg expsec=thread_state_get_tcbQueued_modifies)
+       apply wpsimp
+      apply (wpsimp wp: isRunnable_wp)
+     apply wpsimp
+    apply normalise_obj_at'
+    apply (rename_tac tcb)
+    apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+    apply (clarsimp simp: valid_tcb'_def)
+    apply (frule (1) obj_at_cslift_tcb)
+    apply (rule conjI)
+     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
+     apply (frule (3) obj_at'_tcbQueueHead_ksReadyQueues)
+     apply (force dest!: tcbQueueHead_iff_tcbQueueEnd simp: tcbQueueEmpty_def obj_at'_def)
+    apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+    apply (rule conjI)
+     apply (clarsimp simp: maxDomain_def)
+    apply (cut_tac qdom="tcbDomain tcb" and prio="tcbPriority tcb"
+                in cready_queues_index_to_C_in_range)
+      apply fastforce
+     apply fastforce
+    apply (clarsimp simp: word_less_nat_alt cready_queues_index_to_C_def2)
+    done
 qed
 
-lemmas tcbSchedDequeue_update
-    = tcbDequeue_update[where tn=tcbSchedNext_C and tn_update=tcbSchedNext_C_update
-                          and tp'=tcbSchedPrev_C and tp_update=tcbSchedPrev_C_update,
-                        simplified]
-
-lemma tcb_queue_relation_prev_next:
-  "\<lbrakk> tcb_queue_relation tn tp' mp queue qprev qhead;
-     tcbp \<in> set queue; distinct (ctcb_ptr_to_tcb_ptr qprev # queue);
-     \<forall>t \<in> set queue. tcb_at' t s; qprev \<noteq> tcb_Ptr 0 \<longrightarrow> mp qprev \<noteq> None;
-     mp (tcb_ptr_to_ctcb_ptr tcbp) = Some tcb \<rbrakk>
-      \<Longrightarrow> (tn tcb \<noteq> tcb_Ptr 0 \<longrightarrow> tn tcb \<in> tcb_ptr_to_ctcb_ptr ` set queue
-                       \<and> mp (tn tcb) \<noteq> None \<and> tn tcb \<noteq> tcb_ptr_to_ctcb_ptr tcbp)
-        \<and> (tp' tcb \<noteq> tcb_Ptr 0 \<longrightarrow> (tp' tcb \<in> tcb_ptr_to_ctcb_ptr ` set queue
-                                         \<or> tp' tcb = qprev)
-                       \<and> mp (tp' tcb) \<noteq> None \<and> tp' tcb \<noteq> tcb_ptr_to_ctcb_ptr tcbp)
-        \<and> (tn tcb \<noteq> tcb_Ptr 0 \<longrightarrow> tn tcb \<noteq> tp' tcb)"
-  apply (induct queue arbitrary: qprev qhead)
-   apply simp
-  apply simp
-  apply (erule disjE)
-   apply clarsimp
-   apply (case_tac "queue")
-    apply clarsimp
-   apply clarsimp
-   apply (rule conjI)
-    apply clarsimp
-   apply clarsimp
-   apply (drule_tac f=ctcb_ptr_to_tcb_ptr in arg_cong[where y="tp' tcb"], simp)
-  apply clarsimp
-  apply fastforce
-  done
-
-lemma tcb_queue_relation_prev_next':
-  "\<lbrakk> tcb_queue_relation' tn tp' mp queue qhead qend; tcbp \<in> set queue; distinct queue;
-       \<forall>t \<in> set queue. tcb_at' t s; mp (tcb_ptr_to_ctcb_ptr tcbp) = Some tcb \<rbrakk>
-      \<Longrightarrow> (tn tcb \<noteq> tcb_Ptr 0 \<longrightarrow> tn tcb \<in> tcb_ptr_to_ctcb_ptr ` set queue
-                       \<and> mp (tn tcb) \<noteq> None \<and> tn tcb \<noteq> tcb_ptr_to_ctcb_ptr tcbp)
-        \<and> (tp' tcb \<noteq> tcb_Ptr 0 \<longrightarrow> tp' tcb \<in> tcb_ptr_to_ctcb_ptr ` set queue
-                       \<and> mp (tp' tcb) \<noteq> None \<and> tp' tcb \<noteq> tcb_ptr_to_ctcb_ptr tcbp)
-        \<and> (tn tcb \<noteq> tcb_Ptr 0 \<longrightarrow> tn tcb \<noteq> tp' tcb)"
-  apply (clarsimp simp: tcb_queue_relation'_def split: if_split_asm)
-  apply (drule(1) tcb_queue_relation_prev_next, simp_all)
-   apply (fastforce dest: tcb_at_not_NULL)
-  apply clarsimp
-  done
-
-(* L1 bitmap only updated if L2 entry bits end up all zero *)
-lemma rf_sr_drop_bitmaps_dequeue_helper_L2:
-  "\<lbrakk> (\<sigma>,\<sigma>') \<in> rf_sr ;
-     cbitmap_L2_relation ksqL2upd' ksqL2upd \<rbrakk>
-   \<Longrightarrow>
-((\<sigma>\<lparr>ksReadyQueues := ksqupd,
-   ksReadyQueuesL2Bitmap := ksqL2upd\<rparr>,
- \<sigma>'\<lparr>idx___unsigned_long_' := i',
-   queue_' := queue_upd',
-   globals := globals \<sigma>'
-     \<lparr>ksReadyQueuesL2Bitmap_' := ksqL2upd',
-      ksReadyQueues_' := ksqupd'\<rparr>\<rparr>)
-         \<in> rf_sr)
- =
-((\<sigma>\<lparr>ksReadyQueues := ksqupd\<rparr>,
- \<sigma>'\<lparr>idx___unsigned_long_' := i',
-   queue_' := queue_upd',
-   globals := globals \<sigma>'
-     \<lparr>ksReadyQueues_' := ksqupd'\<rparr>\<rparr>) \<in> rf_sr)
-"
-  unfolding rf_sr_def cstate_relation_def Let_def
-             carch_state_relation_def cmachine_state_relation_def
-  by (clarsimp simp: rf_sr_cbitmap_L1_relation rf_sr_cbitmap_L2_relation)
-
-lemma rf_sr_drop_bitmaps_dequeue_helper:
-  "\<lbrakk> (\<sigma>,\<sigma>') \<in> rf_sr ;
-     cbitmap_L1_relation ksqL1upd' ksqL1upd ; cbitmap_L2_relation ksqL2upd' ksqL2upd \<rbrakk>
-   \<Longrightarrow>
-((\<sigma>\<lparr>ksReadyQueues := ksqupd,
-   ksReadyQueuesL2Bitmap := ksqL2upd,
-   ksReadyQueuesL1Bitmap := ksqL1upd\<rparr>,
- \<sigma>'\<lparr>idx___unsigned_long_' := i',
-   queue_' := queue_upd',
-   globals := globals \<sigma>'
-     \<lparr>ksReadyQueuesL2Bitmap_' := ksqL2upd',
-      ksReadyQueuesL1Bitmap_' := ksqL1upd',
-      ksReadyQueues_' := ksqupd'\<rparr>\<rparr>)
-         \<in> rf_sr)
- =
-((\<sigma>\<lparr>ksReadyQueues := ksqupd\<rparr>,
- \<sigma>'\<lparr>idx___unsigned_long_' := i',
-   queue_' := queue_upd',
-   globals := globals \<sigma>'
-     \<lparr>ksReadyQueues_' := ksqupd'\<rparr>\<rparr>) \<in> rf_sr)
-"
-  unfolding rf_sr_def cstate_relation_def Let_def
-             carch_state_relation_def cmachine_state_relation_def
-  by (clarsimp simp: rf_sr_cbitmap_L1_relation rf_sr_cbitmap_L2_relation)
+lemma tcbSchedAppend_ccorres:
+  "ccorres dc xfdc
+     (tcb_at' t and valid_objs' and pspace_aligned' and pspace_distinct')
+     \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace> hs
+     (tcbSchedAppend t) (Call tcbSchedAppend_'proc)"
+proof -
+  note prio_and_dom_limit_helpers[simp] word_sle_def[simp] maxDom_to_H[simp] maxPrio_to_H[simp]
+  note invert_prioToL1Index_c_simp[simp]
+  (* when numDomains = 1, array bounds checks would become _ = 0 rather than _ < 1, changing the
+     shape of the proof compared to when numDomains > 1 *)
+  note word_less_1[simp del]
+  show ?thesis
+    apply (cinit lift: tcb_')
+     apply (rule ccorres_stateAssert)+
+     apply (rule ccorres_symb_exec_l)
+        apply (rule ccorres_assert)
+        apply (thin_tac "runnable")
+        apply (rule_tac r'="\<lambda>rv rv'. rv = to_bool rv'" and xf'="ret__unsigned_longlong_'"
+                     in ccorres_split_nothrow)
+            apply (rule threadGet_vcg_corres)
+            apply (rule allI, rule conseqPre, vcg)
+            apply clarsimp
+            apply (drule obj_at_ko_at', clarsimp)
+            apply (drule spec, drule(1) mp, clarsimp)
+            apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+           apply ceqv
+          apply (simp add: when_def unless_def del: Collect_const split del: if_split)
+          apply (rule ccorres_cond[where R=\<top>])
+            apply (simp add: to_bool_def)
+           apply (rule ccorres_rhs_assoc)+
+           apply csymbr
+           apply csymbr
+           apply csymbr
+           apply csymbr
+           apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="dom_'" in ccorres_split_nothrow)
+               apply (rule threadGet_vcg_corres)
+               apply (rule allI, rule conseqPre, vcg)
+               apply clarsimp
+               apply (drule obj_at_ko_at', clarsimp)
+               apply (drule spec, drule(1) mp, clarsimp)
+               apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+              apply ceqv
+             apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="prio_'" in ccorres_split_nothrow)
+                 apply (rule threadGet_vcg_corres)
+                 apply (rule allI, rule conseqPre, vcg)
+                 apply clarsimp
+                 apply (drule obj_at_ko_at', clarsimp)
+                 apply (drule spec, drule(1) mp, clarsimp)
+                 apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+                apply ceqv
+               apply (rule ccorres_rhs_assoc2)+
+               apply (simp only: bind_assoc[symmetric])
+               apply (rule ccorres_split_nothrow_novcg_dc)
+                  prefer 2
+                  apply (rule ccorres_move_c_guard_tcb)
+                  apply (simp only: dc_def[symmetric])
+                  apply ctac
+                 apply (rule ccorres_rhs_assoc)+
+                 apply (rule ccorres_symb_exec_r)
+                   apply (rule ccorres_Guard_Seq)
+                   apply (simp add: bind_assoc)
+                   apply (ctac add: getQueue_ccorres)
+                     apply (rename_tac queue cqueue)
+                     apply (rule_tac xf'=ret__unsigned_long_'
+                                 and val="from_bool (tcbQueueEmpty queue)"
+                                 and R="\<lambda>s. \<not> tcbQueueEmpty queue \<longrightarrow> tcb_at' (the (tcbQueueHead queue)) s
+                                            \<and> (tcbQueueHead queue \<noteq> None \<longleftrightarrow> tcbQueueEnd queue \<noteq> None)"
+                                 and R'="{s'. queue_' s' = cqueue}"
+                                  in ccorres_symb_exec_r_known_rv)
+                        apply (rule conseqPre, vcg)
+                        apply (fastforce dest: tcb_at_not_NULL
+                                         simp: ctcb_queue_relation_def option_to_ctcb_ptr_def
+                                               tcbQueueEmpty_def)
+                       apply ceqv
+                      apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                          apply (rule ccorres_cond[where R=\<top>])
+                            apply (fastforce dest!: tcb_at_not_NULL
+                                              simp: ctcb_queue_relation_def option_to_ctcb_ptr_def)
+                           apply (ctac add: addToBitmap_ccorres)
+                          apply (rule ccorres_return_Skip)
+                         apply ceqv
+                        apply (ctac add: tcb_queue_append_ccorres)
+                          apply (rule ccorres_Guard)
+                          apply (rule setQueue_ccorres)
+                          apply fastforce
+                         apply wpsimp
+                        apply (vcg exspec=tcb_queue_prepend_modifies)
+                       apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift')
+                      apply (vcg exspec=addToBitmap_modifies)
+                     apply vcg
+                    apply wpsimp
+                   apply vcg
+                  apply clarsimp
+                  apply vcg
+                 apply (rule conseqPre, vcg)
+                 apply clarsimp
+                apply wpsimp
+               apply (clarsimp simp: guard_is_UNIV_def)
+              apply (wpsimp wp: threadGet_wp)
+             apply vcg
+            apply clarsimp
+            apply (wpsimp wp: threadGet_wp)
+           apply clarsimp
+           apply vcg
+          apply (rule ccorres_return_Skip)
+         apply (wpsimp wp: threadGet_wp)
+        apply (vcg expsec=thread_state_get_tcbQueued_modifies)
+       apply wpsimp
+      apply (wpsimp wp: isRunnable_wp)
+     apply wpsimp
+    apply normalise_obj_at'
+    apply (rename_tac tcb)
+    apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+    apply (clarsimp simp: valid_tcb'_def)
+    apply (frule (1) obj_at_cslift_tcb)
+    apply (rule conjI)
+     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
+     apply (frule (3) obj_at'_tcbQueueHead_ksReadyQueues)
+     apply (frule (3) obj_at'_tcbQueueEnd_ksReadyQueues)
+     apply (force dest!: tcbQueueHead_iff_tcbQueueEnd simp: tcbQueueEmpty_def obj_at'_def)
+    apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+    apply (rule conjI)
+     apply (clarsimp simp: maxDomain_def)
+    apply (cut_tac qdom="tcbDomain tcb" and prio="tcbPriority tcb"
+                in cready_queues_index_to_C_in_range)
+      apply fastforce
+     apply fastforce
+    apply (clarsimp simp: word_less_nat_alt cready_queues_index_to_C_def2 tcbQueueEmpty_def)
+    done
+qed
 
 (* FIXME same proofs as bit_set, maybe can generalise? *)
 lemma cbitmap_L1_relation_bit_clear:
@@ -1286,27 +1145,6 @@ lemma cbitmap_L1_relation_bit_clear:
                      invertL1Index_def l2BitmapSize_def'
                      le_maxDomain_eq_less_numDomains word_le_nat_alt num_domains_index_updates)
 
-lemma cready_queues_relation_empty_queue_helper:
-  "\<lbrakk> tcbDomain ko \<le> maxDomain ; tcbPriority ko \<le> maxPriority ;
-     cready_queues_relation (cslift \<sigma>') (ksReadyQueues_' (globals \<sigma>')) (ksReadyQueues \<sigma>)\<rbrakk>
-   \<Longrightarrow>
-   cready_queues_relation (cslift \<sigma>')
-          (Arrays.update (ksReadyQueues_' (globals \<sigma>')) (unat (tcbDomain ko) * 256 + unat (tcbPriority ko))
-            (tcb_queue_C.end_C_update (\<lambda>_. NULL)
-              (head_C_update (\<lambda>_. NULL)
-                (ksReadyQueues_' (globals \<sigma>').[unat (tcbDomain ko) * 256 + unat (tcbPriority ko)]))))
-          ((ksReadyQueues \<sigma>)((tcbDomain ko, tcbPriority ko) := []))"
-  unfolding cready_queues_relation_def Let_def
-  using maxPrio_to_H[simp] maxDom_to_H[simp]
-  apply clarsimp
-  apply (frule (1) cready_queues_index_to_C_in_range[simplified maxDom_to_H maxPrio_to_H])
-  apply (fold cready_queues_index_to_C_def[simplified numPriorities_def])
-  apply (case_tac "qdom = tcbDomain ko",
-          simp_all add: prio_and_dom_limit_helpers seL4_MinPrio_def
-                        minDom_def)
-   apply (fastforce simp: cready_queues_index_to_C_in_range simp: cready_queues_index_to_C_distinct)+
-  done
-
 lemma cbitmap_L2_relationD:
   "\<lbrakk> cbitmap_L2_relation cbitmap2 abitmap2 ; d \<le> maxDomain ; i < l2BitmapSize \<rbrakk> \<Longrightarrow>
     cbitmap2.[unat d].[i] = abitmap2 (d, i)"
@@ -1336,61 +1174,301 @@ lemma cbitmap_L2_relation_bit_clear:
   apply (case_tac "da = d" ; clarsimp simp: num_domains_index_updates)
   done
 
-lemma tcbSchedDequeue_ccorres':
+lemma removeFromBitmap_ccorres:
   "ccorres dc xfdc
-           ((\<lambda>s. \<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s)
-                     \<and> distinct (ksReadyQueues s (d, p)))
-             and valid_queues' and tcb_at' t and valid_objs')
-           (UNIV \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace>)
-           []
-           (tcbSchedDequeue t)
-           (Call tcbSchedDequeue_'proc)"
+     (K (tdom \<le> maxDomain \<and> prio \<le> maxPriority)) (\<lbrace>\<acute>dom = ucast tdom\<rbrace> \<inter> \<lbrace>\<acute>prio = ucast prio\<rbrace>) hs
+     (removeFromBitmap tdom prio) (Call removeFromBitmap_'proc)"
 proof -
-
   note prio_and_dom_limit_helpers[simp] word_sle_def[simp]
 
   (* when numDomains = 1, array bounds checks would become _ = 0 rather than _ < 1, changing the
      shape of the proof compared to when numDomains > 1 *)
   include no_less_1_simps
 
-  have ksQ_tcb_at': "\<And>s ko d p.
-    \<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s)
-                                          \<and> distinct (ksReadyQueues s (d, p)) \<Longrightarrow>
-    \<forall>t\<in>set (ksReadyQueues s (d, p)). tcb_at' t s"
-    by (fastforce dest: spec elim: obj_at'_weakenE)
-
-  have invert_l1_index_limit: "\<And>p. invertL1Index (prioToL1Index p) < 4"
+  have invert_l1_index_limit: "\<And>p. invertL1Index (prioToL1Index p) < l2BitmapSize"
     unfolding invertL1Index_def l2BitmapSize_def' prioToL1Index_def
     by simp
 
   show ?thesis
-  apply (cinit lift: tcb_')
-   apply (rule_tac r'="\<lambda>rv rv'. rv = to_bool rv'" and xf'="ret__unsigned_longlong_'"
-            in ccorres_split_nothrow)
-       apply (rule threadGet_vcg_corres)
-       apply (rule allI, rule conseqPre, vcg)
-       apply clarsimp
-       apply (drule obj_at_ko_at', clarsimp)
-       apply (drule spec, drule(1) mp, clarsimp)
-       apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-      apply ceqv
-     apply (simp add: when_def del: Collect_const split del: if_split)
-     apply (rule ccorres_cond[where R=\<top>])
-       apply (simp add: to_bool_def)
-      apply (rule ccorres_rhs_assoc)+
-      apply csymbr
-      apply csymbr
-      apply csymbr
-      apply csymbr
-      apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="dom_'" in ccorres_split_nothrow)
-          apply (rule threadGet_vcg_corres)
+    supply if_split[split del]
+    (* pull out static assms *)
+    apply simp
+    apply (rule ccorres_grab_asm[where P=\<top>, simplified])
+    apply (cinit lift: dom_' prio_')
+     apply clarsimp
+     apply csymbr
+     apply csymbr
+     (* we can clear up all C guards now *)
+     apply (clarsimp simp: maxDomain_le_unat_ucast_explicit word_and_less')
+     apply (simp add: invert_prioToL1Index_c_simp word_less_nat_alt)
+     apply (simp add: invert_l1_index_limit[simplified l2BitmapSize_def'])
+     apply ccorres_rewrite
+     (* handle L2 update *)
+     apply (rule_tac ccorres_split_nothrow_novcg_dc)
+        apply (rule_tac P=\<top> and P'=UNIV in ccorres_from_vcg)
+        apply (rule allI, rule conseqPre, vcg)
+        apply (clarsimp simp: simpler_gets_def get_def modify_def
+                              put_def bind_def return_def bitmap_fun_defs)
+        apply (frule rf_sr_cbitmap_L2_relation)
+        apply (erule cbitmap_L2_relation_update)
+        apply (erule (1) cbitmap_L2_relation_bit_clear)
+       (* the check on the C side is identical to checking the L2 entry, rewrite the condition *)
+       apply (simp add: getReadyQueuesL2Bitmap_def)
+       apply (rule ccorres_symb_exec_l3, rename_tac l2)
+          apply (rule_tac C'="{s. l2 = 0}"
+                      and Q="\<lambda>s. l2 = ksReadyQueuesL2Bitmap s (tdom, invertL1Index (prioToL1Index prio))"
+                   in ccorres_rewrite_cond_sr[where Q'=UNIV])
+           apply clarsimp
+           apply (frule rf_sr_cbitmap_L2_relation)
+           apply (clarsimp simp: cbitmap_L2_relationD invert_l1_index_limit split: if_split)
+          (* unset L1 bit when L2 entry is empty *)
+          apply (rule ccorres_from_vcg[where P=\<top> and P'=UNIV])
           apply (rule allI, rule conseqPre, vcg)
-          apply clarsimp
-          apply (drule obj_at_ko_at', clarsimp)
-          apply (drule spec, drule(1) mp, clarsimp)
-          apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-         apply ceqv
-        apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="prio_'" in ccorres_split_nothrow)
+          apply (clarsimp simp: simpler_gets_def get_def modify_def
+                                put_def bind_def return_def bitmap_fun_defs)
+          apply (frule rf_sr_cbitmap_L1_relation)
+          apply (erule cbitmap_L1_relation_update)
+          apply (erule (1) cbitmap_L1_relation_bit_clear)
+         apply wpsimp+
+     apply (fastforce simp: guard_is_UNIV_def)
+    apply clarsimp
+    done
+qed
+
+lemma ctcb_ptr_to_tcb_ptr_option_to_ctcb_ptr[simp]:
+  "ctcb_ptr_to_tcb_ptr (option_to_ctcb_ptr (Some ptr)) = ptr"
+  by (clarsimp simp: option_to_ctcb_ptr_def)
+
+lemma tcb_queue_remove_ccorres:
+  "ccorres ctcb_queue_relation ret__struct_tcb_queue_C_'
+     (\<lambda>s. tcb_at' tcbPtr s \<and> valid_objs' s
+          \<and> (tcbQueueHead queue \<noteq> None \<longleftrightarrow> tcbQueueEnd queue \<noteq> None))
+     (\<lbrace>ctcb_queue_relation queue \<acute>queue\<rbrace> \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr tcbPtr\<rbrace>) hs
+     (tcbQueueRemove queue tcbPtr) (Call tcb_queue_remove_'proc)"
+  (is "ccorres _ _ ?abs _ _ _ _")
+  supply if_split[split del]
+  apply (cinit' lift: tcb_')
+   apply (rename_tac tcb')
+   apply (simp only: tcbQueueRemove_def)
+    \<comment> \<open>cinit is not able to lift queue_' because queue_' is later modified in the C program\<close>
+   apply (rule_tac xf'=queue_' in ccorres_abstract, ceqv, rename_tac cqueue)
+   apply (rule_tac P="ctcb_queue_relation queue cqueue" in ccorres_gen_asm2)
+   apply (rule ccorres_pre_getObject_tcb, rename_tac tcb)
+   apply (rule ccorres_symb_exec_l, rename_tac beforePtrOpt)
+      apply (rule ccorres_symb_exec_l, rename_tac afterPtrOpt)
+         apply (rule ccorres_move_c_guard_tcb)
+         apply (rule_tac xf'="before___ptr_to_struct_tcb_C_'"
+                     and val="option_to_ctcb_ptr beforePtrOpt"
+                     and R="ko_at' tcb tcbPtr and K (tcbSchedPrev tcb = beforePtrOpt)"
+                     and R'=UNIV
+                      in ccorres_symb_exec_r_known_rv)
+            apply (rule conseqPre, vcg)
+            apply (fastforce dest: obj_at_cslift_tcb simp: typ_heap_simps ctcb_relation_def)
+           apply ceqv
+          apply (rule ccorres_move_c_guard_tcb)
+          apply (rule_tac xf'="after___ptr_to_struct_tcb_C_'"
+                      and val="option_to_ctcb_ptr afterPtrOpt"
+                      and R="ko_at' tcb tcbPtr and K (tcbSchedNext tcb = afterPtrOpt)"
+                       in ccorres_symb_exec_r_known_rv[where R'=UNIV])
+             apply (rule conseqPre, vcg)
+             apply (fastforce dest: obj_at_cslift_tcb simp: typ_heap_simps ctcb_relation_def)
+            apply ceqv
+           apply (rule ccorres_cond_seq)
+           apply (rule ccorres_cond[where R="?abs"])
+             apply (fastforce dest: tcb_at_not_NULL
+                              simp: ctcb_queue_relation_def option_to_ctcb_ptr_def)
+            apply (rule ccorres_rhs_assoc)+
+            apply csymbr
+            apply csymbr
+            apply (fastforce intro: ccorres_return_C')
+           apply (rule ccorres_cond_seq)
+           apply (rule_tac Q="?abs" and Q'=\<top> in ccorres_cond_both')
+             apply (fastforce dest: tcb_at_not_NULL
+                              simp: ctcb_queue_relation_def option_to_ctcb_ptr_def split: if_splits)
+            apply clarsimp
+            apply (rule ccorres_assert2)
+            apply (rule ccorres_rhs_assoc)+
+            apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                apply (rule ccorres_move_c_guard_tcb)+
+                apply (rule_tac P=\<top> and P'="tcb_at' tcbPtr"
+                            and Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb (the afterPtrOpt) s}"
+                             in threadSet_ccorres_lemma3)
+                 apply (rule conseqPre, vcg)
+                 apply clarsimp
+                 apply (frule (1) obj_at_cslift_tcb)
+                 apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                   simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                         tcb_cte_cases_def cteSizeBits_def)
+                apply fastforce
+               apply ceqv
+              apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                  apply (rule ccorres_move_c_guard_tcb)
+                  apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb tcbPtr s}"
+                               in threadSet_ccorres_lemma3[where P=\<top> and P'=\<top>, simplified])
+                   apply (rule conseqPre, vcg)
+                   apply clarsimp
+                   apply (frule (1) obj_at_cslift_tcb[where thread=tcbPtr])
+                   apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                     simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                           tcb_cte_cases_def cteSizeBits_def)
+                  apply clarsimp
+                 apply ceqv
+                apply (rule ccorres_symb_exec_r)
+                  apply (fastforce intro: ccorres_return_C')
+                 apply vcg
+                apply (rule conseqPre, vcg)
+                apply clarsimp
+               apply wpsimp
+              apply vcg
+             apply wpsimp
+            apply vcg
+           apply (rule ccorres_cond_seq)
+           apply (rule_tac Q="?abs" and Q'=\<top> in ccorres_cond_both')
+             apply (fastforce dest: tcb_at_not_NULL
+                              simp: ctcb_queue_relation_def option_to_ctcb_ptr_def split: if_splits)
+            apply clarsimp
+            apply (rule ccorres_assert2)
+            apply (rule ccorres_rhs_assoc)+
+            apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                apply (rule ccorres_move_c_guard_tcb)+
+                apply (rule_tac P=\<top> and P'="tcb_at' tcbPtr"
+                            and Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb (the beforePtrOpt) s}"
+                             in threadSet_ccorres_lemma3)
+                 apply (rule conseqPre, vcg)
+                 apply clarsimp
+                 apply (frule (1) obj_at_cslift_tcb)
+                 apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                   simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                         tcb_cte_cases_def cteSizeBits_def)
+                apply fastforce
+               apply ceqv
+              apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                  apply (rule ccorres_move_c_guard_tcb)
+                  apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb tcbPtr s}"
+                               in threadSet_ccorres_lemma3[where P=\<top> and P'=\<top>, simplified])
+                   apply (rule conseqPre, vcg)
+                   apply clarsimp
+                   apply (frule (1) obj_at_cslift_tcb[where thread=tcbPtr])
+                   apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                     simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                           tcb_cte_cases_def cteSizeBits_def)
+                  apply clarsimp
+                 apply ceqv
+                apply (rule ccorres_symb_exec_r)
+                  apply (fastforce intro: ccorres_return_C')
+                 apply vcg
+                apply (rule conseqPre, vcg)
+                apply clarsimp
+               apply wpsimp
+              apply vcg
+             apply wpsimp
+            apply vcg
+           apply clarsimp
+           apply (rule ccorres_assert2)+
+           apply (rule ccorres_rhs_assoc)+
+           apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+               apply (rule ccorres_move_c_guard_tcb)+
+               apply (rule_tac Q="\<lambda>s tcb'. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb' (the beforePtrOpt) s}"
+                            in threadSet_ccorres_lemma3[where P=\<top> and P'=\<top>, simplified])
+                apply (rule conseqPre, vcg)
+                apply clarsimp
+                apply (frule (1) obj_at_cslift_tcb)
+                apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                  simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                        tcb_cte_cases_def cteSizeBits_def)
+               apply clarsimp
+              apply ceqv
+             apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                 apply (rule ccorres_move_c_guard_tcb)+
+                 apply (rule_tac P=\<top> and P'="tcb_at' tcbPtr"
+                             and Q="\<lambda>s tcb'. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb' (the afterPtrOpt) s}"
+                              in threadSet_ccorres_lemma3)
+                  apply (rule conseqPre, vcg)
+                  apply clarsimp
+                  apply (frule (1) obj_at_cslift_tcb)
+                  apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                    simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                          tcb_cte_cases_def cteSizeBits_def)
+                 apply clarsimp
+                apply ceqv
+               apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                   apply (rule ccorres_move_c_guard_tcb)
+                   apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb tcbPtr s}"
+                                in threadSet_ccorres_lemma3[where P=\<top> and P'=\<top>, simplified])
+                    apply (rule conseqPre, vcg)
+                    apply clarsimp
+                    apply (frule (1) obj_at_cslift_tcb[where thread=tcbPtr])
+                    apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                      simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                            tcb_cte_cases_def cteSizeBits_def)
+                   apply clarsimp
+                  apply ceqv
+                 apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                     apply (rule ccorres_move_c_guard_tcb)
+                     apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb tcbPtr s}"
+                                  in threadSet_ccorres_lemma3[where P=\<top> and P'=\<top>, simplified])
+                      apply (rule conseqPre, vcg)
+                      apply clarsimp
+                      apply (frule (1) obj_at_cslift_tcb[where thread=tcbPtr])
+                      apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                        simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                              tcb_cte_cases_def cteSizeBits_def)
+                     apply fastforce
+                    apply ceqv
+                   apply (fastforce intro: ccorres_return_C')
+                  apply (wpsimp | vcg)+
+  apply (clarsimp split: if_splits)
+  apply normalise_obj_at'
+  apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+  by (intro conjI impI;
+      clarsimp simp: ctcb_queue_relation_def typ_heap_simps option_to_ctcb_ptr_def
+                     valid_tcb'_def)
+
+lemma tcbQueueRemove_tcb_at'_head:
+  "\<lbrace>\<lambda>s. valid_objs' s \<and> (\<forall>head. tcbQueueHead queue = Some head \<longrightarrow> tcb_at' head s)\<rbrace>
+   tcbQueueRemove queue t
+   \<lbrace>\<lambda>rv s. \<not> tcbQueueEmpty rv \<longrightarrow> tcb_at' (the (tcbQueueHead rv)) s\<rbrace>"
+  unfolding tcbQueueRemove_def
+  apply (wpsimp wp: getTCB_wp haskell_assert_wp hoare_vcg_imp_lift')
+  apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+  apply (fastforce simp: valid_tcb'_def tcbQueueEmpty_def obj_at'_def)
+  done
+
+lemma tcbSchedDequeue_ccorres:
+  "ccorres dc xfdc
+     (tcb_at' t and valid_objs' and pspace_aligned' and pspace_distinct')
+     \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace> hs
+     (tcbSchedDequeue t) (Call tcbSchedDequeue_'proc)"
+proof -
+  note prio_and_dom_limit_helpers[simp] word_sle_def[simp] maxDom_to_H[simp] maxPrio_to_H[simp]
+  note invert_prioToL1Index_c_simp[simp]
+
+  (* when numDomains = 1, array bounds checks would become _ = 0 rather than _ < 1, changing the
+     shape of the proof compared to when numDomains > 1 *)
+  include no_less_1_simps
+
+  show ?thesis
+    apply (cinit lift: tcb_')
+     apply (rule ccorres_stateAssert)+
+     apply (rule_tac r'="\<lambda>rv rv'. rv = to_bool rv'" and xf'="ret__unsigned_longlong_'"
+                  in ccorres_split_nothrow)
+         apply (rule threadGet_vcg_corres)
+         apply (rule allI, rule conseqPre, vcg)
+         apply clarsimp
+         apply (drule obj_at_ko_at', clarsimp)
+         apply (drule spec, drule(1) mp, clarsimp)
+         apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+        apply ceqv
+       apply (simp add: when_def del: Collect_const split del: if_split)
+       apply (rule ccorres_cond[where R=\<top>])
+         apply (simp add: to_bool_def)
+        apply (rule ccorres_rhs_assoc)+
+        apply csymbr
+        apply csymbr
+        apply csymbr
+        apply csymbr
+        apply csymbr
+        apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="dom_'" in ccorres_split_nothrow)
             apply (rule threadGet_vcg_corres)
             apply (rule allI, rule conseqPre, vcg)
             apply clarsimp
@@ -1398,308 +1476,80 @@ proof -
             apply (drule spec, drule(1) mp, clarsimp)
             apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
            apply ceqv
-          apply (rule ccorres_rhs_assoc2)+
-          apply (simp only: bind_assoc[symmetric])
-          apply (rule ccorres_split_nothrow_novcg_dc)
-             prefer 2
-             apply (rule ccorres_move_c_guard_tcb)
-             apply ctac
-            prefer 2
-            apply (wp, clarsimp, wp+)
-           apply (rule_tac P="(\<lambda>s. \<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s)
-                                         \<and> distinct(ksReadyQueues s (d, p)))
-                                and valid_queues' and obj_at' (inQ rva rvb) t
-                                and (\<lambda>s. rva \<le> maxDomain \<and> rvb \<le> maxPriority)"
-                       and P'=UNIV in ccorres_from_vcg)
-           apply (rule allI, rule conseqPre, vcg)
-           apply (clarsimp simp: getQueue_def gets_def get_def setQueue_def modify_def
-                                 put_def bind_def return_def bitmap_fun_defs when_def
-                                 null_def)
-
-           apply (rule conjI; clarsimp simp: queue_in_range[simplified maxDom_to_H maxPrio_to_H])
-            apply (rule conjI; clarsimp simp: queue_in_range[simplified maxDom_to_H maxPrio_to_H])
-             apply (frule(1) valid_queuesD')
-             apply (drule (1) obj_at_cslift_tcb, clarsimp simp: inQ_def)
-             apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko" in rf_sr_sched_queue_relation)
-               apply (fastforce simp: maxDom_to_H maxPrio_to_H)+
-             apply (frule_tac s=\<sigma> in tcb_queue_relation_prev_next'; (fastforce simp: ksQ_tcb_at')?)
-             apply (drule_tac s=\<sigma> in tcbSchedDequeue_update, assumption,
-                    simp_all add: remove1_filter ksQ_tcb_at')[1]
-             apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                       unat_trans_ucast_helper\<close>)
-             apply (clarsimp simp: maxDomain_le_unat_ucast_explicit)
-             apply (intro conjI;
-                    clarsimp simp: h_val_field_clift'
-                                   h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)+
-               apply (drule(2) filter_empty_unfiltered_contr, simp)+
-             apply (rule conjI; clarsimp)
-              apply (rule conjI)
-               apply (fastforce simp: c_invert_assist l2BitmapSize_def' wordRadix_def)
-              apply (rule conjI; clarsimp)
-               apply (subst rf_sr_drop_bitmaps_dequeue_helper, assumption)
-                 apply (fastforce intro: cbitmap_L1_relation_bit_clear)
-                apply (simp add: invert_prioToL1Index_c_simp)
-                apply (frule rf_sr_cbitmap_L2_relation)
-                apply (clarsimp simp: cbitmap_L2_relation_def
-                                      word_size prioToL1Index_def wordRadix_def mask_def
-                                      word_le_nat_alt
-                                      numPriorities_def wordBits_def l2BitmapSize_def'
-                                      invertL1Index_def numDomains_less_numeric_explicit)
-                apply (case_tac "d = tcbDomain ko"
-                       ; fastforce simp: le_maxDomain_eq_less_numDomains
-                                         numDomains_less_numeric_explicit)
-               apply (drule (1) obj_at_cslift_tcb, clarsimp simp: inQ_def)
-               apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko"
-                        in rf_sr_sched_queue_relation)
-                 apply (fold_subgoals (prefix))[2]
-                subgoal premises prems using prems by (fastforce simp: maxDom_to_H maxPrio_to_H)+
-
-               apply (frule_tac s=\<sigma> in tcb_queue_relation_prev_next', assumption)
-                  prefer 3
-                  apply fastforce
-                 apply (fold_subgoals (prefix))[2]
-                subgoal premises prems using prems by ((fastforce simp: ksQ_tcb_at')+)
-               apply (drule_tac s=\<sigma> in tcbSchedDequeue_update, assumption,
-                      simp_all add: remove1_filter ksQ_tcb_at')[1]
-               (* trivial case, setting queue to empty *)
-               apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def carch_state_relation_def
-                                     cmachine_state_relation_def)
-               apply (erule (2) cready_queues_relation_empty_queue_helper)
-              (* impossible case, C L2 update disagrees with Haskell update *)
-              apply (simp add: invert_prioToL1Index_c_simp)
-              apply (subst (asm) num_domains_index_updates)
-               subgoal by (simp add: le_maxDomain_eq_less_numDomains word_le_nat_alt)
-              apply (subst (asm) Arrays.index_update)
-               apply (simp add: invert_l1_index_limit)
-
-              apply (frule rf_sr_cbitmap_L2_relation)
-              apply (drule_tac i="invertL1Index (prioToL1Index (tcbPriority ko))"
-                       in cbitmap_L2_relationD, assumption)
-               apply (fastforce simp: l2BitmapSize_def' invert_l1_index_limit)
-              apply (fastforce simp: prioToL1Index_def invertL1Index_def mask_def wordRadix_def)
-             (* impossible case *)
-             apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-             apply (drule(2) filter_empty_unfiltered_contr, fastforce)
-
-            apply (frule (1) valid_queuesD')
-            apply (drule (1) obj_at_cslift_tcb, clarsimp simp: inQ_def)
-            apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko"
-                     in rf_sr_sched_queue_relation)
-              apply fold_subgoals[2]
-              apply (fastforce simp: maxDom_to_H maxPrio_to_H)+
-            apply (clarsimp simp: h_val_field_clift'
-                                  h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)
-            apply (frule_tac s=\<sigma> in tcb_queue_relation_prev_next', assumption)
-               prefer 3
-               apply fastforce
-              apply (fold_subgoals (prefix))[2]
-             subgoal premises prems using prems by (fastforce simp: ksQ_tcb_at')+
-            apply (drule_tac s=\<sigma> in tcbSchedDequeue_update, assumption,
-                   simp_all add: remove1_filter ksQ_tcb_at')[1]
-            apply (clarsimp simp:  filter_noteq_op upd_unless_null_def)
-            apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                      unat_trans_ucast_helper\<close>)
-            apply (clarsimp simp: maxDomain_le_unat_ucast_explicit)
-            apply (rule conjI, clarsimp)
-             apply (clarsimp simp: h_val_field_clift'
-                                   h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)
-             apply (rule conjI; clarsimp)
-              apply (simp add: typ_heap_simps)
-              apply (clarsimp simp: h_t_valid_c_guard [OF h_t_valid_field, OF h_t_valid_clift]
-                                    h_t_valid_field[OF h_t_valid_clift] h_t_valid_clift)
-              apply (erule_tac S="set (ksReadyQueues \<sigma> (tcbDomain ko, tcbPriority ko))"
-                       in state_relation_queue_update_helper',
-                     (simp | rule globals.equality)+,
-                     simp_all add: clift_field_update if_Some_helper numPriorities_def
-                                   cready_queues_index_to_C_def2 typ_heap_simps
-                                   maxDom_to_H maxPrio_to_H
-                             cong: if_cong split del: if_split)[1]
-
-               apply (fastforce simp: tcb_null_sched_ptrs_def typ_heap_simps c_guard_clift
-                                elim: obj_at'_weaken)+
-             apply (erule_tac S="set (ksReadyQueues \<sigma> (tcbDomain ko, tcbPriority ko))"
-                      in state_relation_queue_update_helper',
-                    (simp | rule globals.equality)+,
-                    simp_all add: clift_field_update if_Some_helper numPriorities_def
-                                  cready_queues_index_to_C_def2
-                                  maxDom_to_H maxPrio_to_H
-                            cong: if_cong split del: if_split,
-                    simp_all add: typ_heap_simps')[1]
-              subgoal by (fastforce simp: tcb_null_sched_ptrs_def)
-             subgoal by fastforce
+          apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="prio_'" in ccorres_split_nothrow)
+              apply (rule threadGet_vcg_corres)
+              apply (rule allI, rule conseqPre, vcg)
+              apply clarsimp
+              apply (drule obj_at_ko_at', clarsimp)
+              apply (drule spec, drule(1) mp, clarsimp)
+              apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+             apply ceqv
+            apply (rule ccorres_symb_exec_r)
+              apply (rule ccorres_Guard_Seq)
+              apply (simp add: bind_assoc)
+              apply (ctac add: getQueue_ccorres)
+                apply (rule_tac r'=ctcb_queue_relation and xf'=new_queue_' in ccorres_split_nothrow)
+                    apply (ctac add: tcb_queue_remove_ccorres)
+                   apply ceqv
+                  apply (rename_tac queue' newqueue)
+                  apply (rule ccorres_Guard_Seq)
+                  apply (ctac add: setQueue_ccorres)
+                    apply (rule ccorres_split_nothrow_novcg_dc)
+                       apply ctac
+                      apply (rule_tac xf'=ret__unsigned_long_'
+                                  and val="from_bool (tcbQueueEmpty queue')"
+                                  and R="\<lambda>s. \<not> tcbQueueEmpty queue' \<longrightarrow> tcb_at' (the (tcbQueueHead queue')) s"
+                                  in ccorres_symb_exec_r_known_rv[where R'=UNIV])
+                         apply (rule conseqPre, vcg)
+                         apply (fastforce dest: tcb_at_not_NULL
+                                          simp: ctcb_queue_relation_def option_to_ctcb_ptr_def
+                                                tcbQueueEmpty_def split: option.splits)
+                        apply ceqv
+                       apply (rule ccorres_cond[where R=\<top>])
+                         apply fastforce
+                        apply (ctac add: removeFromBitmap_ccorres)
+                       apply (rule ccorres_return_Skip)
+                      apply vcg
+                     apply (wpsimp wp: hoare_vcg_imp_lift')
+                    apply (clarsimp simp: guard_is_UNIV_def)
+                   apply (wpsimp wp: hoare_vcg_imp_lift')
+                  apply vcg
+                 apply ((wpsimp wp: tcbQueueRemove_tcb_at'_head | wp (once) hoare_drop_imps)+)[1]
+                apply (vcg exspec=tcb_queue_remove_modifies)
+               apply wpsimp
+              apply vcg
+             apply vcg
+            apply (rule conseqPre, vcg)
             apply clarsimp
-            apply (rule conjI; clarsimp)
-             apply (rule conjI)
-              apply (fastforce simp: c_invert_assist l2BitmapSize_def' wordRadix_def)
-             apply (rule conjI; clarsimp)
-              (* invalid, missing bitmap updates on haskell side *)
-              apply (fold_subgoals (prefix))[2]
-             subgoal premises prems using prems
-               by (fastforce dest!: tcb_queue_relation'_empty_ksReadyQueues
-                              elim: obj_at'_weaken)+
-            apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-            apply (erule_tac S="set (ksReadyQueues \<sigma> (tcbDomain ko, tcbPriority ko))"
-                     in state_relation_queue_update_helper',
-                   (simp | rule globals.equality)+,
-                   simp_all add: clift_field_update if_Some_helper numPriorities_def
-                                 cready_queues_index_to_C_def2
-                                 maxDom_to_H maxPrio_to_H
-                           cong: if_cong split del: if_split)[1]
-               apply (fold_subgoals (prefix))[4]
-            subgoal premises prems using prems
-              by - (fastforce simp: typ_heap_simps c_guard_clift tcb_null_sched_ptrs_def
-                                    clift_heap_update_same[OF h_t_valid_clift])+
-           apply (rule conjI; clarsimp simp: queue_in_range[simplified maxDom_to_H maxPrio_to_H])
-            apply (frule (1) valid_queuesD')
-            apply (drule (1) obj_at_cslift_tcb, clarsimp simp: inQ_def)
-            apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko"
-                     in rf_sr_sched_queue_relation)
-              apply (fold_subgoals (prefix))[2]
-             subgoal premises prems using prems by (fastforce simp: maxDom_to_H maxPrio_to_H)+
-            apply (clarsimp simp: h_val_field_clift'
-                                  h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)
-            apply (frule_tac s=\<sigma> in tcb_queue_relation_prev_next')
-                apply fastforce
-               prefer 3
-               apply fastforce
-              apply (fold_subgoals (prefix))[2]
-             subgoal premises prems using prems by (fastforce simp: ksQ_tcb_at')+
-            apply (drule_tac s=\<sigma> in tcbSchedDequeue_update, assumption,
-                   simp_all add: remove1_filter ksQ_tcb_at')[1]
-            apply (clarsimp simp:  filter_noteq_op upd_unless_null_def)
-            apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                      unat_trans_ucast_helper\<close>)
-            apply (clarsimp simp: maxDomain_le_unat_ucast_explicit)
-            apply (rule conjI; clarsimp)
-             apply (clarsimp simp: h_val_field_clift'
-                                   h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)
-             apply (clarsimp simp: typ_heap_simps)
-             apply (rule conjI; clarsimp simp: typ_heap_simps)
-             apply (drule(2) filter_empty_unfiltered_contr[simplified filter_noteq_op], simp)
-            apply (rule conjI)
-             apply (fastforce simp: c_invert_assist l2BitmapSize_def' wordRadix_def)
-            apply (rule conjI; clarsimp)
-             (* impossible case, C L2 update disagrees with Haskell update *)
-             apply (subst (asm) num_domains_index_updates)
-              apply (simp add: le_maxDomain_eq_less_numDomains word_le_nat_alt)
-             apply (subst (asm) Arrays.index_update)
-              subgoal using invert_l1_index_limit
-                by (fastforce simp add: invert_prioToL1Index_c_simp intro: nat_Suc_less_le_imp)
-             apply (frule rf_sr_cbitmap_L2_relation)
-             apply (simp add: invert_prioToL1Index_c_simp)
-             apply (drule_tac i="invertL1Index (prioToL1Index (tcbPriority ko))"
-                      in cbitmap_L2_relationD, assumption)
-              subgoal by (simp add: invert_l1_index_limit l2BitmapSize_def')
-             apply (fastforce simp: prioToL1Index_def invertL1Index_def mask_def wordRadix_def)
-
-            apply (simp add: invert_prioToL1Index_c_simp)
-            apply (subst rf_sr_drop_bitmaps_dequeue_helper_L2, assumption)
-             subgoal by (fastforce dest: rf_sr_cbitmap_L2_relation elim!: cbitmap_L2_relation_bit_clear)
-
-            (* trivial case, setting queue to empty *)
-            apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def carch_state_relation_def
-                                  cmachine_state_relation_def)
-            apply (erule (2) cready_queues_relation_empty_queue_helper)
-
-           apply (frule (1) valid_queuesD')
-           apply (drule (1) obj_at_cslift_tcb, clarsimp simp: inQ_def)
-           apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko"
-                    in rf_sr_sched_queue_relation)
-             apply (fold_subgoals (prefix))[2]
-            subgoal premises prems using prems by (fastforce simp: maxDom_to_H maxPrio_to_H)+
-           apply (clarsimp simp: h_val_field_clift'
-                                 h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)
-           apply (simp add: invert_prioToL1Index_c_simp)
-           apply (frule_tac s=\<sigma> in tcb_queue_relation_prev_next')
-               apply (fastforce simp add: ksQ_tcb_at')+
-           apply (drule_tac s=\<sigma> in tcbSchedDequeue_update, assumption,
-                  simp_all add: remove1_filter ksQ_tcb_at')[1]
-           apply (clarsimp simp: filter_noteq_op upd_unless_null_def)
-           apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                     unat_trans_ucast_helper\<close>)
-           apply (clarsimp simp: maxDomain_le_unat_ucast_explicit)
-           apply (rule conjI, clarsimp)
-            apply (clarsimp simp: h_val_field_clift'
-                                  h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)
-            apply (clarsimp simp: typ_heap_simps)
-            apply (rule conjI; clarsimp simp: typ_heap_simps)
-             apply (erule_tac S="set (ksReadyQueues \<sigma> (tcbDomain ko, tcbPriority ko))"
-                      in state_relation_queue_update_helper',
-                    (simp | rule globals.equality)+,
-                    simp_all add: clift_field_update if_Some_helper numPriorities_def
-                                  cready_queues_index_to_C_def2
-                                  maxDom_to_H maxPrio_to_H
-                            cong: if_cong split del: if_split)[1]
-                apply (fastforce simp: tcb_null_sched_ptrs_def)
-               apply (fastforce simp: typ_heap_simps c_guard_clift)
-              apply (fastforce simp: typ_heap_simps)
-             apply (fastforce simp: tcb_null_sched_ptrs_def)
-            apply (erule_tac S="set (ksReadyQueues \<sigma> (tcbDomain ko, tcbPriority ko))"
-                     in state_relation_queue_update_helper',
-                   (simp | rule globals.equality)+,
-                   simp_all add: clift_field_update if_Some_helper numPriorities_def
-                                 cready_queues_index_to_C_def2
-                                 maxDom_to_H maxPrio_to_H
-                           cong: if_cong split del: if_split)[1]
-               apply (fold_subgoals (prefix))[4]
-            subgoal premises prems using prems
-              by - (fastforce simp: typ_heap_simps c_guard_clift tcb_null_sched_ptrs_def
-                                    clift_heap_update_same[OF h_t_valid_clift])+
-           apply (clarsimp)
-           apply (rule conjI; clarsimp simp: typ_heap_simps)
-            apply (rule conjI)
-             apply (fastforce simp: c_invert_assist l2BitmapSize_def' wordRadix_def)
-            apply (rule conjI; clarsimp)
-             (* invalid, missing bitmap updates on haskell side *)
-             apply (drule tcb_queue_relation'_empty_ksReadyQueues)
-              apply (fold_subgoals (prefix))[2]
-             subgoal premises prems using prems by (fastforce elim: obj_at'_weaken)+
-            (* invalid, missing bitmap updates on haskell side *)
-            apply (drule tcb_queue_relation'_empty_ksReadyQueues)
-             apply (fold_subgoals (prefix))[2]
-            subgoal premises prems using prems by (fastforce elim: obj_at'_weaken)+
-           apply (erule_tac S="set (ksReadyQueues \<sigma> (tcbDomain ko, tcbPriority ko))"
-                    in state_relation_queue_update_helper',
-                  (simp | rule globals.equality)+,
-                  simp_all add: clift_field_update if_Some_helper numPriorities_def
-                                cready_queues_index_to_C_def2 typ_heap_simps
-                                maxDom_to_H maxPrio_to_H
-                          cong: if_cong split del: if_split)[1]
-            apply (fold_subgoals (prefix))[3]
-           subgoal premises prems using prems
-            by (fastforce simp: typ_heap_simps c_guard_clift tcb_null_sched_ptrs_def)+
-          apply (simp add: guard_is_UNIV_def)
-         apply simp
-         apply (wp threadGet_wp)
+           apply (wpsimp wp: threadGet_wp)
+          apply vcg
+         apply clarsimp
+         apply (wpsimp wp: threadGet_wp)
         apply vcg
-       apply simp
-       apply (wp threadGet_wp)
-      apply vcg
-     apply (rule ccorres_return_Skip)
-    apply simp
-    apply (wp threadGet_wp)
-   apply vcg
-  by (fastforce simp: valid_objs'_def obj_at'_def ran_def projectKOs typ_at'_def
-                      valid_obj'_def valid_tcb'_def inQ_def)
+       apply (rule ccorres_return_Skip)
+      apply (wpsimp wp: threadGet_wp)
+     apply (vcg expsec=thread_state_get_tcbQueued_modifies)
+    apply normalise_obj_at'
+    apply (rename_tac tcb)
+    apply (frule (1) obj_at_cslift_tcb)
+    apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+    apply (clarsimp simp: valid_tcb'_def)
+    apply (cut_tac qdom="tcbDomain tcb" and prio="tcbPriority tcb"
+                in cready_queues_index_to_C_in_range)
+      apply fastforce
+     apply fastforce
+    apply (rule conjI)
+     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
+     apply (frule (3) obj_at'_tcbQueueHead_ksReadyQueues)
+     apply (force dest!: tcbQueueHead_iff_tcbQueueEnd simp: tcbQueueEmpty_def obj_at'_def)
+    by (fastforce simp: word_less_nat_alt
+                        cready_queues_index_to_C_def2 ctcb_relation_def
+                        typ_heap_simps le_maxDomain_eq_less_numDomains(2) unat_trans_ucast_helper)
 qed
 
-lemma tcbSchedDequeue_ccorres:
-  "ccorres dc xfdc
-           (valid_queues and valid_queues' and tcb_at' t and valid_objs')
-           (UNIV \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace>)
-           []
-           (tcbSchedDequeue t)
-           (Call tcbSchedDequeue_'proc)"
-  apply (rule ccorres_guard_imp [OF tcbSchedDequeue_ccorres'])
-   apply (clarsimp simp: valid_queues_def valid_queues_no_bitmap_def)
-   apply (drule_tac x=d in spec)
-   apply (drule_tac x=p in spec)
-   apply (clarsimp)
-   apply (drule(1) bspec)
-   apply (erule obj_at'_weakenE)
-   apply (clarsimp)+
-  done
-
 lemma tcb_queue_relation_append:
   "\<lbrakk> tcb_queue_relation tn tp' mp queue qprev qhead; queue \<noteq> [];
      qend' \<notin> tcb_ptr_to_ctcb_ptr ` set queue; mp qend' = Some tcb;
@@ -1718,211 +1568,6 @@ lemma tcb_queue_relation_append:
   apply clarsimp
   done
 
-lemma tcbSchedAppend_update:
-  assumes sr: "sched_queue_relation' mp queue qhead qend"
-  and     qh': "qend' \<notin> tcb_ptr_to_ctcb_ptr ` set queue"
-  and  cs_tcb: "mp qend' = Some tcb"
-  and valid_ep: "\<forall>t\<in>set queue. tcb_at' t s" "distinct queue"
-  and     qhN: "qend' \<noteq> NULL"
-  shows
-  "sched_queue_relation'
-            (upd_unless_null qend (tcbSchedNext_C_update (\<lambda>_. qend') (the (mp qend)))
-                (mp(qend' \<mapsto> tcb\<lparr>tcbSchedNext_C := NULL, tcbSchedPrev_C := qend\<rparr>)))
-            (queue @ [ctcb_ptr_to_tcb_ptr qend']) (if queue = [] then qend' else qhead) qend'"
-  using sr qh' valid_ep cs_tcb qhN
-  apply -
-  apply (rule rev_cases[where xs=queue])
-   apply (simp add: tcb_queue_relation'_def upd_unless_null_def)
-  apply (clarsimp simp: tcb_queue_relation'_def upd_unless_null_def tcb_at_not_NULL)
-  apply (drule_tac qend'=qend' and tn_update=tcbSchedNext_C_update
-             and tp_update=tcbSchedPrev_C_update and qend="tcb_ptr_to_ctcb_ptr y"
-             in tcb_queue_relation_append, simp_all)
-   apply (fastforce simp add: tcb_at_not_NULL)
-  apply (simp add: fun_upd_twist)
-  done
-
-lemma tcb_queue_relation_qend_mems:
-  "\<lbrakk> tcb_queue_relation' getNext getPrev mp queue qhead qend;
-     \<forall>x \<in> set queue. tcb_at' x s \<rbrakk>
-      \<Longrightarrow> (qend = NULL \<longrightarrow> queue = [])
-       \<and> (qend \<noteq> NULL \<longrightarrow> ctcb_ptr_to_tcb_ptr qend \<in> set queue)"
-  apply (clarsimp simp: tcb_queue_relation'_def)
-  apply (drule bspec, erule last_in_set)
-  apply (simp add: tcb_at_not_NULL)
-  done
-
-lemma tcbSchedAppend_ccorres:
-  "ccorres dc xfdc
-           (valid_queues and tcb_at' t and valid_objs')
-           (UNIV \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace>)
-           []
-           (tcbSchedAppend t)
-           (Call tcbSchedAppend_'proc)"
-proof -
-  note prio_and_dom_limit_helpers[simp] word_sle_def[simp] maxDom_to_H[simp] maxPrio_to_H[simp]
-
-  (* when numDomains = 1, array bounds checks would become _ = 0 rather than _ < 1, changing the
-     shape of the proof compared to when numDomains > 1 *)
-  include no_less_1_simps
-
-  show ?thesis
-  apply (cinit lift: tcb_')
-   apply (rule_tac r'="\<lambda>rv rv'. rv = to_bool rv'"
-               and xf'="ret__unsigned_longlong_'" in ccorres_split_nothrow)
-       apply (rule threadGet_vcg_corres)
-       apply (rule allI, rule conseqPre, vcg)
-       apply clarsimp
-       apply (drule obj_at_ko_at', clarsimp)
-       apply (drule spec, drule(1) mp, clarsimp)
-       apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-      apply ceqv
-     apply (simp add: when_def unless_def del: Collect_const split del: if_split)
-     apply (rule ccorres_cond[where R=\<top>])
-       apply (simp add: to_bool_def)
-      apply (rule ccorres_rhs_assoc)+
-      apply csymbr
-      apply csymbr
-      apply csymbr
-      apply csymbr
-      apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv"
-          and xf'="dom_'" in ccorres_split_nothrow)
-          apply (rule threadGet_vcg_corres)
-          apply (rule allI, rule conseqPre, vcg)
-          apply clarsimp
-          apply (drule obj_at_ko_at', clarsimp)
-          apply (drule spec, drule(1) mp, clarsimp)
-          apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-         apply ceqv
-        apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv"
-            and xf'="prio_'" in ccorres_split_nothrow)
-            apply (rule threadGet_vcg_corres)
-            apply (rule allI, rule conseqPre, vcg)
-            apply clarsimp
-            apply (drule obj_at_ko_at', clarsimp)
-            apply (drule spec, drule(1) mp, clarsimp)
-            apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-           apply ceqv
-          apply (rule ccorres_rhs_assoc2)+
-          apply (simp only: bind_assoc[symmetric])
-          apply (rule ccorres_split_nothrow_novcg_dc)
-             prefer 2
-             apply (rule ccorres_move_c_guard_tcb)
-             apply ctac
-            prefer 2
-            apply (wp, clarsimp, wp+)
-           apply (rule_tac P="\<lambda>s. valid_queues s \<and> (\<forall>p. t \<notin> set (ksReadyQueues s p))
-                                  \<and> (\<exists>tcb. ko_at' tcb t s \<and> tcbDomain tcb =rva
-                                  \<and> tcbPriority tcb = rvb \<and> valid_tcb' tcb s)"
-                       and P'=UNIV in ccorres_from_vcg)
-           apply (rule allI, rule conseqPre, vcg)
-           apply (clarsimp simp: getQueue_def gets_def get_def setQueue_def modify_def
-                                 put_def bind_def return_def bitmap_fun_defs null_def)
-           apply (clarsimp simp: queue_in_range valid_tcb'_def)
-           apply (rule conjI; clarsimp simp: queue_in_range)
-            apply (drule (1) obj_at_cslift_tcb)
-            apply clarsimp
-            apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb"
-                     in rf_sr_sched_queue_relation)
-              apply clarsimp
-             apply clarsimp
-            apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL)
-             apply (simp add: valid_queues_valid_q)
-            apply (frule_tac s=\<sigma> in tcb_queue_relation_qend_mems,  simp add: valid_queues_valid_q)
-            apply (drule_tac qend'="tcb_ptr_to_ctcb_ptr t" and s=\<sigma> in tcbSchedAppend_update,
-                   simp_all add: valid_queues_valid_q)[1]
-             apply (rule tcb_at_not_NULL, erule obj_at'_weakenE, simp)
-            apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-            apply (simp add: invert_prioToL1Index_c_simp)
-            apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                      unat_trans_ucast_helper\<close>)
-            apply (clarsimp simp: maxDomain_le_unat_ucast_explicit)
-            apply (rule conjI; clarsimp)
-             apply (rule conjI)
-              apply (fastforce simp: c_invert_assist l2BitmapSize_def' wordRadix_def)
-             apply (simp add: t_hrs_ksReadyQueues_upd_absorb)
-             apply (subst rf_sr_drop_bitmaps_enqueue_helper, assumption)
-               apply (fastforce intro: cbitmap_L1_relation_bit_set)
-              subgoal by (fastforce intro: cbitmap_L2_relation_bit_set simp: wordRadix_def mask_def)
-             apply (erule(1) state_relation_queue_update_helper[where S="{t}"],
-                    (simp | rule globals.equality)+,
-                    simp_all add: cready_queues_index_to_C_def2 numPriorities_def
-                                  t_hrs_ksReadyQueues_upd_absorb upd_unless_null_def
-                                  typ_heap_simps)[1]
-               apply (fastforce simp: tcb_null_sched_ptrs_def elim: obj_at'_weaken)
-              apply (fastforce simp: typ_heap_simps c_guard_clift)
-             apply (fastforce simp: tcb_null_sched_ptrs_def elim: obj_at'_weaken)
-            apply (clarsimp simp: upd_unless_null_def cready_queues_index_to_C_def numPriorities_def)
-           apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                     unat_trans_ucast_helper\<close>)
-           apply (clarsimp simp: maxDomain_le_unat_ucast_explicit)
-           apply (rule conjI; clarsimp simp: queue_in_range)
-            apply (drule (1) obj_at_cslift_tcb)
-            apply clarsimp
-            apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb"
-                     in rf_sr_sched_queue_relation)
-              apply clarsimp
-             apply clarsimp
-            apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL)
-             apply (simp add: valid_queues_valid_q)
-            apply (frule_tac s=\<sigma> in tcb_queue_relation_qend_mems,
-                   simp add: valid_queues_valid_q)
-            apply (drule_tac qend'="tcb_ptr_to_ctcb_ptr t" and s=\<sigma> in tcbSchedAppend_update,
-                   simp_all add: valid_queues_valid_q)[1]
-              apply clarsimp
-             apply (rule tcb_at_not_NULL, erule obj_at'_weakenE, simp)
-            apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-            apply (clarsimp simp: upd_unless_null_def cready_queues_index_to_C_def numPriorities_def)
-           apply (drule (1) obj_at_cslift_tcb)
-           apply clarsimp
-           apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb"
-                    in rf_sr_sched_queue_relation)
-             apply clarsimp
-            apply clarsimp
-           apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL)
-            apply (simp add: valid_queues_valid_q)
-           apply (frule_tac s=\<sigma> in tcb_queue_relation_qend_mems,
-                  simp add: valid_queues_valid_q)
-           apply (drule_tac qend'="tcb_ptr_to_ctcb_ptr t" and s=\<sigma> in tcbSchedAppend_update,
-                  simp_all add: valid_queues_valid_q)[1]
-             apply clarsimp
-            apply (rule tcb_at_not_NULL, erule obj_at'_weakenE, simp)
-           apply (clarsimp simp: cready_queues_index_to_C_def2 numPriorities_def)
-           apply (frule(2) obj_at_cslift_tcb[OF valid_queues_obj_at'D])
-           apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-           apply (erule_tac S="{t, v}" for v in state_relation_queue_update_helper,
-                  (simp | rule globals.equality)+,
-                  simp_all add: typ_heap_simps if_Some_helper numPriorities_def
-                                cready_queues_index_to_C_def2 upd_unless_null_def
-                           cong: if_cong split del: if_split
-                           del: fun_upd_restrict_conv)[1]
-               apply simp
-               apply (rule conjI)
-                apply clarsimp
-                apply (drule_tac s="tcb_ptr_to_ctcb_ptr t" in sym, simp)
-               apply (clarsimp simp add: fun_upd_twist)
-              prefer 4
-              apply (simp add: obj_at'_weakenE[OF _ TrueI])
-              apply (rule disjI1, erule valid_queues_obj_at'D)
-              subgoal by simp
-             subgoal by simp
-            subgoal by (fastforce simp: tcb_null_sched_ptrs_def)
-           subgoal by (fastforce simp: typ_heap_simps c_guard_clift)
-          apply (simp add: guard_is_UNIV_def)
-         apply simp
-         apply (wp threadGet_wp)
-        apply vcg
-       apply simp
-       apply (wp threadGet_wp)
-      apply vcg
-     apply (rule ccorres_return_Skip)
-    apply simp
-    apply (wp threadGet_wp)
-   apply vcg
-  by (fastforce simp: valid_objs'_def obj_at'_def ran_def projectKOs typ_at'_def
-                         valid_obj'_def inQ_def
-                   dest!: valid_queues_obj_at'D)
-qed
-
 lemma isStopped_spec:
   "\<forall>s. \<Gamma> \<turnstile> ({s} \<inter> {s. cslift s (thread_' s) \<noteq> None}) Call isStopped_'proc
        {s'. ret__unsigned_long_' s' = from_bool (tsType_CL (thread_state_lift (tcbState_C (the (cslift s (thread_' s))))) \<in>
@@ -1968,8 +1613,11 @@ lemma tcb_at_1:
   done
 
 lemma rescheduleRequired_ccorres:
-  "ccorres dc xfdc (valid_queues and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and valid_objs')
-           UNIV [] rescheduleRequired (Call rescheduleRequired_'proc)"
+  "ccorres dc xfdc
+     ((\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and valid_objs'
+      and pspace_aligned' and pspace_distinct')
+     UNIV []
+     rescheduleRequired (Call rescheduleRequired_'proc)"
   apply cinit
    apply (rule ccorres_symb_exec_l)
       apply (rule ccorres_split_nothrow_novcg[where r'=dc and xf'=xfdc])
@@ -2079,10 +1727,12 @@ lemma cguard_UNIV:
   by fastforce
 
 lemma lookupBitmapPriority_le_maxPriority:
-  "\<lbrakk> ksReadyQueuesL1Bitmap s d \<noteq> 0 ; valid_queues s \<rbrakk>
+  "\<lbrakk> ksReadyQueuesL1Bitmap s d \<noteq> 0 ;
+     \<forall>d p. d > maxDomain \<or> p > maxPriority \<longrightarrow> tcbQueueEmpty (ksReadyQueues s (d, p));
+     valid_bitmaps s \<rbrakk>
    \<Longrightarrow> lookupBitmapPriority d s \<le> maxPriority"
-   unfolding valid_queues_def valid_queues_no_bitmap_def
-   by (fastforce dest!: bitmapQ_from_bitmap_lookup bitmapQ_ksReadyQueuesI intro: ccontr)
+  apply (clarsimp simp: valid_bitmaps_def)
+  by (fastforce dest!: bitmapQ_from_bitmap_lookup bitmapQ_ksReadyQueuesI intro: ccontr)
 
 lemma rf_sr_ksReadyQueuesL1Bitmap_not_zero:
   "\<lbrakk> (\<sigma>, s') \<in> rf_sr ; d \<le> maxDomain ; ksReadyQueuesL1Bitmap_' (globals s').[unat d] \<noteq> 0 \<rbrakk>
@@ -2092,10 +1742,10 @@ lemma rf_sr_ksReadyQueuesL1Bitmap_not_zero:
   done
 
 lemma ksReadyQueuesL1Bitmap_word_log2_max:
-    "\<lbrakk>valid_queues s; ksReadyQueuesL1Bitmap s d \<noteq> 0\<rbrakk>
-    \<Longrightarrow> word_log2 (ksReadyQueuesL1Bitmap s d) < l2BitmapSize"
-    unfolding valid_queues_def
-    by (fastforce dest: word_log2_nth_same bitmapQ_no_L1_orphansD)
+  "\<lbrakk>valid_bitmaps s; ksReadyQueuesL1Bitmap s d \<noteq> 0\<rbrakk>
+   \<Longrightarrow> word_log2 (ksReadyQueuesL1Bitmap s d) < l2BitmapSize"
+  unfolding valid_bitmaps_def
+  by (fastforce dest: word_log2_nth_same bitmapQ_no_L1_orphansD)
 
 lemma word_log2_max_word64[simp]:
   "word_log2 (w :: 64 word) < 64"
@@ -2103,7 +1753,7 @@ lemma word_log2_max_word64[simp]:
   by (simp add: word_size)
 
 lemma rf_sr_ksReadyQueuesL2Bitmap_simp:
-  "\<lbrakk> (\<sigma>, s') \<in> rf_sr ; d \<le> maxDomain ; valid_queues \<sigma> ; ksReadyQueuesL1Bitmap \<sigma> d \<noteq> 0 \<rbrakk>
+  "\<lbrakk> (\<sigma>, s') \<in> rf_sr ; d \<le> maxDomain ; valid_bitmaps \<sigma> ; ksReadyQueuesL1Bitmap \<sigma> d \<noteq> 0 \<rbrakk>
    \<Longrightarrow> ksReadyQueuesL2Bitmap_' (globals s').[unat d].[word_log2 (ksReadyQueuesL1Bitmap \<sigma> d)] =
       ksReadyQueuesL2Bitmap \<sigma> (d, word_log2 (ksReadyQueuesL1Bitmap \<sigma> d))"
   apply (frule rf_sr_cbitmap_L2_relation)
@@ -2112,9 +1762,9 @@ lemma rf_sr_ksReadyQueuesL2Bitmap_simp:
   done
 
 lemma ksReadyQueuesL2Bitmap_nonzeroI:
-  "\<lbrakk> d \<le> maxDomain ; valid_queues s ; ksReadyQueuesL1Bitmap s d \<noteq> 0 \<rbrakk>
+  "\<lbrakk> d \<le> maxDomain ; valid_bitmaps s ; ksReadyQueuesL1Bitmap s d \<noteq> 0 \<rbrakk>
    \<Longrightarrow> ksReadyQueuesL2Bitmap s (d, invertL1Index (word_log2 (ksReadyQueuesL1Bitmap s d))) \<noteq> 0"
-   unfolding valid_queues_def
+   unfolding valid_bitmaps_def
    apply clarsimp
    apply (frule bitmapQ_no_L1_orphansD)
     apply (erule word_log2_nth_same)
@@ -2281,9 +1931,9 @@ lemma threadGet_get_obj_at'_has_domain:
 lemma possibleSwitchTo_ccorres:
   shows
   "ccorres dc xfdc
-         (valid_queues and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
+         ((\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
             and st_tcb_at' runnable' t and (\<lambda>s. ksCurDomain s \<le> maxDomain)
-            and valid_objs')
+            and valid_objs' and pspace_aligned' and pspace_distinct')
          ({s. target_' s = tcb_ptr_to_ctcb_ptr t}
           \<inter> UNIV) []
      (possibleSwitchTo t )
@@ -2331,8 +1981,8 @@ lemma possibleSwitchTo_ccorres:
 
 lemma scheduleTCB_ccorres':
   "ccorres dc xfdc
-           (tcb_at' thread and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and valid_queues
-                           and valid_objs')
+           (tcb_at' thread and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
+                           and valid_objs' and pspace_aligned' and pspace_distinct')
            (UNIV \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr thread})
            []
   (do (runnable, curThread, action) \<leftarrow> do
@@ -2382,24 +2032,26 @@ lemma scheduleTCB_ccorres':
            apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
                                  cscheduler_action_relation_def)
           apply wp+
-     apply (simp add: isRunnable_def isStopped_def)
-    apply wp
+   apply (simp add: isRunnable_def isStopped_def)
    apply (simp add: guard_is_UNIV_def)
   apply clarsimp
   apply (clarsimp simp: st_tcb_at'_def obj_at'_def weak_sch_act_wf_def)
   done
 
 lemma scheduleTCB_ccorres_valid_queues'_pre:
-        "ccorresG rf_sr \<Gamma> dc xfdc (tcb_at' thread and st_tcb_at' (not runnable') thread and valid_queues' and valid_queues and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and valid_objs')
-         (UNIV \<inter> \<lbrace>\<acute>tptr = tcb_ptr_to_ctcb_ptr thread\<rbrace>) []
-         (do (runnable, curThread, action) \<leftarrow> do
-             runnable \<leftarrow> isRunnable thread;
-             curThread \<leftarrow> getCurThread;
-             action \<leftarrow> getSchedulerAction;
-             return (runnable, curThread, action) od;
-             when (\<not> runnable \<and> curThread = thread \<and> action = ResumeCurrentThread) rescheduleRequired
-          od)
-         (Call scheduleTCB_'proc)"
+  "ccorresG rf_sr \<Gamma> dc xfdc
+     (tcb_at' thread and st_tcb_at' (not runnable') thread
+      and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
+      and valid_objs' and pspace_aligned' and pspace_distinct')
+     \<lbrace>\<acute>tptr = tcb_ptr_to_ctcb_ptr thread\<rbrace> []
+     (do (runnable, curThread, action) \<leftarrow> do runnable \<leftarrow> isRunnable thread;
+                                             curThread \<leftarrow> getCurThread;
+                                             action \<leftarrow> getSchedulerAction;
+                                             return (runnable, curThread, action)
+                                          od;
+         when (\<not> runnable \<and> curThread = thread \<and> action = ResumeCurrentThread) rescheduleRequired
+      od)
+     (Call scheduleTCB_'proc)"
   supply empty_fail_cond[simp]
   apply (cinit' lift: tptr_')
    apply (rule ccorres_rhs_assoc2)+
@@ -2440,17 +2092,17 @@ lemma scheduleTCB_ccorres_valid_queues'_pre:
                            split: scheduler_action.split_asm)
           apply wp+
      apply (simp add: isRunnable_def isStopped_def)
-    apply wp
    apply (simp add: guard_is_UNIV_def)
   apply (clarsimp simp: st_tcb_at'_def obj_at'_def)
   done
 
-
 lemmas scheduleTCB_ccorres_valid_queues'
     = scheduleTCB_ccorres_valid_queues'_pre[unfolded bind_assoc return_bind split_conv]
 
 lemma rescheduleRequired_ccorres_valid_queues'_simple:
-  "ccorresG rf_sr \<Gamma> dc xfdc (valid_queues' and sch_act_simple) UNIV [] rescheduleRequired (Call rescheduleRequired_'proc)"
+  "ccorresG rf_sr \<Gamma> dc xfdc
+     sch_act_simple UNIV []
+     rescheduleRequired (Call rescheduleRequired_'proc)"
   apply cinit
    apply (rule ccorres_symb_exec_l)
       apply (rule ccorres_split_nothrow_novcg[where r'=dc and xf'=xfdc])
@@ -2483,16 +2135,17 @@ lemma rescheduleRequired_ccorres_valid_queues'_simple:
                  split: scheduler_action.split_asm)
 
 lemma scheduleTCB_ccorres_valid_queues'_pre_simple:
-        "ccorresG rf_sr \<Gamma> dc xfdc (tcb_at' thread and st_tcb_at' (not runnable') thread and valid_queues' and sch_act_simple)
-         (UNIV \<inter> \<lbrace>\<acute>tptr = tcb_ptr_to_ctcb_ptr thread\<rbrace>) []
-         (do (runnable, curThread, action) \<leftarrow> do
-             runnable \<leftarrow> isRunnable thread;
-             curThread \<leftarrow> getCurThread;
-             action \<leftarrow> getSchedulerAction;
-             return (runnable, curThread, action) od;
-             when (\<not> runnable \<and> curThread = thread \<and> action = ResumeCurrentThread) rescheduleRequired
-          od)
-         (Call scheduleTCB_'proc)"
+  "ccorresG rf_sr \<Gamma> dc xfdc
+     (tcb_at' thread and st_tcb_at' (not runnable') thread and valid_queues' and sch_act_simple)
+     \<lbrace>\<acute>tptr = tcb_ptr_to_ctcb_ptr thread\<rbrace> []
+     (do (runnable, curThread, action) \<leftarrow> do runnable \<leftarrow> isRunnable thread;
+                                             curThread \<leftarrow> getCurThread;
+                                             action \<leftarrow> getSchedulerAction;
+                                             return (runnable, curThread, action)
+                                          od;
+         when (\<not> runnable \<and> curThread = thread \<and> action = ResumeCurrentThread) rescheduleRequired
+      od)
+     (Call scheduleTCB_'proc)"
   supply empty_fail_cond[simp]
   apply (cinit' lift: tptr_' simp del: word_neq_0_conv)
    apply (rule ccorres_rhs_assoc2)+
@@ -2531,11 +2184,10 @@ lemma scheduleTCB_ccorres_valid_queues'_pre_simple:
            apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
                                  cscheduler_action_relation_def)
           apply wp+
-     apply (simp add: isRunnable_def isStopped_def)
-    apply wp
+   apply (simp add: isRunnable_def isStopped_def)
    apply (simp add: guard_is_UNIV_def)
   apply clarsimp
-  apply (clarsimp simp: st_tcb_at'_def obj_at'_def valid_queues'_def)
+  apply (clarsimp simp: st_tcb_at'_def obj_at'_def)
   done
 
 lemmas scheduleTCB_ccorres_valid_queues'_simple
@@ -2555,47 +2207,34 @@ lemma threadSet_weak_sch_act_wf_runnable':
   apply (clarsimp)
 done
 
-lemma threadSet_valid_queues_and_runnable': "\<lbrace>\<lambda>s. valid_queues s \<and> (\<forall>p. thread \<in> set (ksReadyQueues s p) \<longrightarrow> runnable' st)\<rbrace>
-                 threadSet (tcbState_update (\<lambda>_. st)) thread
-               \<lbrace>\<lambda>rv s. valid_queues s\<rbrace>"
-  apply (wp threadSet_valid_queues)
-  apply (clarsimp simp: inQ_def)
-done
-
 lemma setThreadState_ccorres[corres]:
    "ccorres dc xfdc
-   (\<lambda>s. tcb_at' thread s \<and> valid_queues s \<and> valid_objs' s \<and> valid_tcb_state' st s \<and>
-                 (ksSchedulerAction s = SwitchToThread thread \<longrightarrow> runnable' st) \<and>
-                 (\<forall>p. thread \<in> set (ksReadyQueues s p) \<longrightarrow> runnable' st) \<and>
-                 sch_act_wf (ksSchedulerAction s) s)
-     ({s'. (\<forall>cl fl. cthread_state_relation_lifted st (cl\<lparr>tsType_CL := ts_' s' && mask 4\<rparr>, fl))}
+   (\<lambda>s. tcb_at' thread s \<and> valid_objs' s \<and> valid_tcb_state' st s
+        \<and> (ksSchedulerAction s = SwitchToThread thread \<longrightarrow> runnable' st)
+        \<and> sch_act_wf (ksSchedulerAction s) s \<and> pspace_aligned' s \<and> pspace_distinct' s)
+   ({s'. (\<forall>cl fl. cthread_state_relation_lifted st (cl\<lparr>tsType_CL := ts_' s' && mask 4\<rparr>, fl))}
     \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr thread}) hs
-         (setThreadState st thread) (Call setThreadState_'proc)"
+   (setThreadState st thread) (Call setThreadState_'proc)"
    apply (cinit lift: tptr_' cong add: call_ignore_cong)
    apply (ctac (no_vcg) add: threadSet_tcbState_simple_corres)
     apply (ctac add: scheduleTCB_ccorres)
-  apply (wp threadSet_weak_sch_act_wf_runnable' threadSet_valid_queues_and_runnable'
-            threadSet_valid_objs')
-  by (clarsimp simp: weak_sch_act_wf_def valid_queues_def valid_tcb'_tcbState_update)
-
-lemma threadSet_valid_queues'_and_not_runnable': "\<lbrace>tcb_at' thread and valid_queues' and (\<lambda>s. (\<not> runnable' st))\<rbrace>
-                  threadSet (tcbState_update (\<lambda>_. st)) thread
-               \<lbrace>\<lambda>rv. tcb_at' thread and st_tcb_at' (not runnable') thread and valid_queues' \<rbrace>"
-
-  apply (wp threadSet_valid_queues' threadSet_tcbState_st_tcb_at')
-  apply (clarsimp simp: pred_neg_def valid_queues'_def inQ_def)+
-done
+  apply (wp threadSet_weak_sch_act_wf_runnable' threadSet_valid_objs')
+  apply (clarsimp simp: weak_sch_act_wf_def valid_tcb'_tcbState_update)
+  done
 
 lemma setThreadState_ccorres_valid_queues':
-   "ccorres dc xfdc
-   (\<lambda>s. tcb_at' thread s \<and> valid_queues' s \<and> \<not> runnable' st \<and> weak_sch_act_wf (ksSchedulerAction s) s \<and> Invariants_H.valid_queues s \<and> (\<forall>p. thread \<notin> set (ksReadyQueues s p)) \<and> sch_act_not thread s \<and> valid_objs' s \<and> valid_tcb_state' st s)
+  "ccorres dc xfdc
+     (\<lambda>s. tcb_at' thread s \<and> \<not> runnable' st \<and> weak_sch_act_wf (ksSchedulerAction s) s
+          \<and> sch_act_not thread s \<and> valid_objs' s \<and> valid_tcb_state' st s
+          \<and> pspace_aligned' s \<and> pspace_distinct' s)
      ({s'. (\<forall>cl fl. cthread_state_relation_lifted st (cl\<lparr>tsType_CL := ts_' s' && mask 4\<rparr>, fl))}
-    \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr thread}) []
-         (setThreadState st thread) (Call setThreadState_'proc)"
+      \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr thread}) []
+     (setThreadState st thread) (Call setThreadState_'proc)"
    apply (cinit lift: tptr_' cong add: call_ignore_cong)
    apply (ctac (no_vcg) add: threadSet_tcbState_simple_corres)
     apply (ctac add: scheduleTCB_ccorres_valid_queues')
-   apply (wp threadSet_valid_queues'_and_not_runnable' threadSet_weak_sch_act_wf_runnable' threadSet_valid_queues_and_runnable' threadSet_valid_objs')
+   apply (wp threadSet_weak_sch_act_wf_runnable' threadSet_valid_objs'
+             threadSet_tcbState_st_tcb_at')
   by (clarsimp simp: valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)
 
 lemma simp_list_case_return:
@@ -2617,22 +2256,20 @@ lemma cancelSignal_ccorres [corres]:
    apply (rule ccorres_rhs_assoc2)
    apply (ctac (no_vcg) add: cancelSignal_ccorres_helper)
      apply (ctac add: setThreadState_ccorres_valid_queues')
-    apply ((wp setNotification_nosch setNotification_ksQ hoare_vcg_all_lift set_ntfn_valid_objs' | simp add: valid_tcb_state'_def split del: if_split)+)[1]
+    apply ((wp setNotification_nosch hoare_vcg_all_lift set_ntfn_valid_objs' | simp add: valid_tcb_state'_def split del: if_split)+)[1]
    apply (simp add: ThreadState_defs)
   apply (rule conjI, clarsimp, rule conjI, clarsimp)
     apply (frule (1) ko_at_valid_ntfn'[OF _ invs_valid_objs'])
    subgoal by ((auto simp: obj_at'_def projectKOs st_tcb_at'_def invs'_def valid_state'_def
                      isTS_defs cte_wp_at_ctes_of
                      cthread_state_relation_def sch_act_wf_weak valid_ntfn'_def
-             dest!: valid_queues_not_runnable'_not_ksQ[where t=thread] |
-           clarsimp simp: eq_commute)+)
+               | clarsimp simp: eq_commute)+)
    apply (clarsimp)
    apply (frule (1) ko_at_valid_ntfn'[OF _ invs_valid_objs'])
    apply (frule (2) ntfn_blocked_in_queueD)
    by (auto simp: obj_at'_def projectKOs st_tcb_at'_def invs'_def valid_state'_def
                      isTS_defs cte_wp_at_ctes_of valid_ntfn'_def
                      cthread_state_relation_def sch_act_wf_weak isWaitingNtfn_def
-             dest!: valid_queues_not_runnable'_not_ksQ[where t=thread]
              split: ntfn.splits option.splits
          |  clarsimp simp: eq_commute
          | drule_tac x=thread in bspec)+
@@ -2920,23 +2557,20 @@ lemma cancelIPC_ccorres_helper:
                         cpspace_relation_def update_ep_map_tos typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-       \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            subgoal by (clarsimp simp: comp_def)
-        \<comment> \<open>ep relation\<close>
-           apply (rule cpspace_relation_ep_update_ep, assumption+)
-            subgoal by (simp add: cendpoint_relation_def Let_def EPState_Idle_def)
-           subgoal by simp
-           \<comment> \<open>ntfn relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-          apply simp
-          apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
-           subgoal by simp
-          apply (erule (1) map_to_ko_atI')
-         apply (simp add: heap_to_user_data_def Let_def)
-        \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         subgoal by (clarsimp simp: comp_def)
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           subgoal by (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (rule cpspace_relation_ep_update_ep, assumption+)
+           subgoal by (simp add: cendpoint_relation_def Let_def EPState_Idle_def)
+          subgoal by simp
+          \<comment> \<open>ntfn relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+          subgoal by simp
+         apply (erule (1) map_to_ko_atI')
+        apply (simp add: heap_to_user_data_def Let_def)
         subgoal by (clarsimp simp: carch_state_relation_def carch_globals_def
                                    packed_heap_update_collapse_hrs)
        subgoal by (simp add: cmachine_state_relation_def)
@@ -2957,44 +2591,48 @@ lemma cancelIPC_ccorres_helper:
                        cpspace_relation_def update_ep_map_tos typ_heap_simps')
       apply (elim conjE)
       apply (intro conjI)
-      \<comment> \<open>tcb relation\<close>
-           apply (erule ctcb_relation_null_queue_ptrs)
-           subgoal by (clarsimp simp: comp_def)
-       \<comment> \<open>ep relation\<close>
-          apply (rule cpspace_relation_ep_update_ep, assumption+)
-           apply (simp add: cendpoint_relation_def Let_def isSendEP_def isRecvEP_def split: endpoint.splits split del: if_split)
+          \<comment> \<open>tcb relation\<close>
+          apply (erule ctcb_relation_null_ep_ptrs)
+          subgoal by (clarsimp simp: comp_def)
+         \<comment> \<open>ep relation\<close>
+         apply (rule cpspace_relation_ep_update_ep, assumption+)
+          apply (simp add: cendpoint_relation_def Let_def isSendEP_def isRecvEP_def
+                    split: endpoint.splits split del: if_split)
            \<comment> \<open>recv case\<close>
-            apply (subgoal_tac "pspace_canonical' \<sigma>")
-             prefer 2
-             apply fastforce
-            apply (clarsimp
-                     simp: h_t_valid_clift_Some_iff ctcb_offset_defs mask_shiftl_decompose
-                           tcb_queue_relation'_next_mask tcb_queue_relation'_prev_mask
-                           tcb_queue_relation'_next_canonical tcb_queue_relation'_prev_canonical
-                     simp flip: canonical_bit_def make_canonical_def
-                     cong: tcb_queue_relation'_cong)
-            subgoal by (intro impI conjI; simp)
-           \<comment> \<open>send case\<close>
-            apply (subgoal_tac "pspace_canonical' \<sigma>")
-             prefer 2
-             apply fastforce
-           apply (clarsimp
-                    simp: h_t_valid_clift_Some_iff ctcb_offset_defs mask_shiftl_decompose
-                          tcb_queue_relation'_next_mask tcb_queue_relation'_prev_mask
-                          tcb_queue_relation'_next_canonical tcb_queue_relation'_prev_canonical
-                    simp flip: canonical_bit_def
-                    cong: tcb_queue_relation'_cong)
+           apply (subgoal_tac "pspace_canonical' \<sigma>")
+            prefer 2
+            apply fastforce
+           apply (clarsimp simp: h_t_valid_clift_Some_iff ctcb_offset_defs mask_shiftl_decompose
+                                 tcb_queue_relation'_next_mask tcb_queue_relation'_prev_mask
+                                 tcb_queue_relation'_next_canonical tcb_queue_relation'_prev_canonical
+                      simp flip: canonical_bit_def make_canonical_def
+                           cong: tcb_queue_relation'_cong)
            subgoal by (intro impI conjI; simp)
-          subgoal by simp
-                \<comment> \<open>ntfn relation\<close>
-         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-         apply simp
-         apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
-         apply simp
-         apply (erule (1) map_to_ko_atI')
-         \<comment> \<open>queue relation\<close>
-        apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-        subgoal by (clarsimp simp: comp_def)
+          \<comment> \<open>send case\<close>
+          apply (subgoal_tac "pspace_canonical' \<sigma>")
+           prefer 2
+           apply fastforce
+         apply (clarsimp simp: h_t_valid_clift_Some_iff ctcb_offset_defs mask_shiftl_decompose
+                               tcb_queue_relation'_next_mask tcb_queue_relation'_prev_mask
+                               tcb_queue_relation'_next_canonical tcb_queue_relation'_prev_canonical
+                    simp flip: canonical_bit_def
+                         cong: tcb_queue_relation'_cong)
+          subgoal by (intro impI conjI; simp)
+         \<comment> \<open>send case\<close>
+         apply (subgoal_tac "pspace_canonical' \<sigma>")
+          prefer 2
+          apply fastforce
+         apply (clarsimp simp: h_t_valid_clift_Some_iff ctcb_offset_defs
+                               tcb_queue_relation'_next_mask tcb_queue_relation'_prev_mask
+                               tcb_queue_relation'_next_canonical tcb_queue_relation'_prev_canonical
+                    simp flip: canonical_bit_def
+                         cong: tcb_queue_relation'_cong)
+        \<comment> \<open>ntfn relation\<close>
+        apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+        apply simp
+        apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+        apply simp
+        apply (erule (1) map_to_ko_atI')
        subgoal by (clarsimp simp: carch_state_relation_def carch_globals_def
                                   packed_heap_update_collapse_hrs)
       subgoal by (simp add: cmachine_state_relation_def)
@@ -3207,37 +2845,35 @@ lemma cancelIPC_ccorres1:
      subgoal by (auto simp: obj_at'_def projectKOs pred_tcb_at'_def invs'_def valid_state'_def
                      isTS_defs cte_wp_at_ctes_of
                      cthread_state_relation_def sch_act_wf_weak valid_ep'_def
-             dest!: valid_queues_not_runnable'_not_ksQ[where t=thread] split: thread_state.splits)
+                     split: thread_state.splits)
     apply clarsimp
     apply (frule (2) ep_blocked_in_queueD_recv)
     apply (frule (1) ko_at_valid_ep'[OF _ invs_valid_objs'])
     subgoal by (auto simp: obj_at'_def projectKOs pred_tcb_at'_def invs'_def valid_state'_def
                          isTS_defs cte_wp_at_ctes_of isRecvEP_def
                          cthread_state_relation_def sch_act_wf_weak valid_ep'_def
-                 dest!: valid_queues_not_runnable'_not_ksQ[where t=thread] split: thread_state.splits endpoint.splits)
+                    split: thread_state.splits endpoint.splits)
    apply (rule conjI)
     apply (clarsimp simp: inQ_def)
-   apply (rule conjI)
-    apply clarsimp
    apply clarsimp
    apply (rule conjI)
     subgoal by (auto simp: obj_at'_def projectKOs pred_tcb_at'_def invs'_def valid_state'_def
                          isTS_defs cte_wp_at_ctes_of
                          cthread_state_relation_def sch_act_wf_weak valid_ep'_def
-                 dest!: valid_queues_not_runnable'_not_ksQ[where t=thread] split: thread_state.splits)
+                    split: thread_state.splits)
    apply clarsimp
    apply (rule conjI)
     subgoal by (auto simp: obj_at'_def projectKOs pred_tcb_at'_def invs'_def valid_state'_def
                          isTS_defs cte_wp_at_ctes_of
                          cthread_state_relation_def sch_act_wf_weak valid_ep'_def
-                 dest!: valid_queues_not_runnable'_not_ksQ[where t=thread] split: thread_state.splits)
+                    split: thread_state.splits)
    apply clarsimp
    apply (frule (2) ep_blocked_in_queueD_send)
    apply (frule (1) ko_at_valid_ep'[OF _ invs_valid_objs'])
    subgoal by (auto simp: obj_at'_def projectKOs pred_tcb_at'_def invs'_def valid_state'_def
                         isTS_defs cte_wp_at_ctes_of isSendEP_def
                         cthread_state_relation_def sch_act_wf_weak valid_ep'_def
-                dest!: valid_queues_not_runnable'_not_ksQ[where t=thread] split: thread_state.splits endpoint.splits)[1]
+                   split: thread_state.splits endpoint.splits)[1]
   apply (auto simp: isTS_defs cthread_state_relation_def typ_heap_simps weak_sch_act_wf_def)
   apply (case_tac ts,
            auto simp: isTS_defs cthread_state_relation_def typ_heap_simps)
diff --git a/proof/crefine/AARCH64/Ipc_C.thy b/proof/crefine/AARCH64/Ipc_C.thy
index 1293163cbc..792734f8c1 100644
--- a/proof/crefine/AARCH64/Ipc_C.thy
+++ b/proof/crefine/AARCH64/Ipc_C.thy
@@ -1385,18 +1385,14 @@ lemma getRestartPC_ccorres [corres]:
   done
 
 lemma asUser_tcbFault_obj_at:
-  "\<lbrace>obj_at' (\<lambda>tcb. P (tcbFault tcb)) t\<rbrace> asUser t' m
-   \<lbrace>\<lambda>rv. obj_at' (\<lambda>tcb. P (tcbFault tcb)) t\<rbrace>"
+  "asUser t' m \<lbrace>obj_at' (\<lambda>tcb. P (tcbFault tcb)) t\<rbrace>"
   apply (simp add: asUser_def split_def)
   apply (wp threadGet_wp)
   apply (simp cong: if_cong)
   done
 
 lemma asUser_atcbContext_obj_at:
-  "t \<noteq> t' \<Longrightarrow>
-    \<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>
-      asUser t' m
-    \<lbrace>\<lambda>rv. obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
+  "t \<noteq> t' \<Longrightarrow> asUser t' m \<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
   apply (simp add: asUser_def split_def atcbContextGet_def atcbContextSet_def)
   apply (wp threadGet_wp)
   apply simp
@@ -4401,10 +4397,6 @@ lemma doReplyTransfer_ccorres [corres]:
           \<inter> \<lbrace>\<acute>grant = from_bool grant\<rbrace>)  hs
     (doReplyTransfer sender receiver slot grant)
     (Call doReplyTransfer_'proc)"
-proof -
-  have invs_valid_queues_strg: "\<And>s. invs' s \<longrightarrow> valid_queues s"
-    by clarsimp
-  show ?thesis
   apply (cinit lift: sender_' receiver_' slot_' grant_')
    apply (rule getThreadState_ccorres_foo)
    apply (rule ccorres_assert2)
@@ -4436,7 +4428,7 @@ proof -
         apply (ctac(no_vcg) add: cteDeleteOne_ccorres[where w="scast cap_reply_cap"])
          apply (ctac(no_vcg) add: setThreadState_ccorres)
           apply (ctac(no_vcg) add: possibleSwitchTo_ccorres)
-         apply (wpsimp wp: sts_running_valid_queues setThreadState_st_tcb)+
+         apply (wpsimp wp: sts_valid_objs' setThreadState_st_tcb)+
         apply (wp cteDeleteOne_sch_act_wf)
        apply vcg
       apply (rule conseqPre, vcg)
@@ -4445,8 +4437,7 @@ proof -
      apply wp
      apply (simp add: cap_get_tag_isCap)
      apply (strengthen invs_weak_sch_act_wf_strg
-                       cte_wp_at_imp_consequent'[where P="\<lambda>ct. Ex (ccap_relation (cteCap ct))" for ct]
-                       invs_valid_queues_strg)
+                       cte_wp_at_imp_consequent'[where P="\<lambda>ct. Ex (ccap_relation (cteCap ct))" for ct])
      apply (simp add: cap_reply_cap_def)
      apply (wp doIPCTransfer_reply_or_replyslot)
     apply (clarsimp simp: seL4_Fault_NullFault_def ccorres_cond_iffs
@@ -4481,19 +4472,20 @@ proof -
               apply (ctac (no_vcg))
                apply (simp only: K_bind_def)
                apply (ctac add: possibleSwitchTo_ccorres)
-              apply (wp sts_running_valid_queues setThreadState_st_tcb | simp)+
-             apply (ctac add: setThreadState_ccorres_valid_queues'_simple)
+              apply (wp sts_valid_objs' setThreadState_st_tcb | simp)+
+             apply (ctac add: setThreadState_ccorres_simple)
              apply wp
-            apply ((wp threadSet_valid_queues threadSet_sch_act threadSet_valid_queues' hoare_weak_lift_imp
+            apply ((wp threadSet_sch_act hoare_weak_lift_imp
                        threadSet_valid_objs' threadSet_weak_sch_act_wf
                          | simp add: valid_tcb_state'_def)+)[1]
            apply (clarsimp simp: guard_is_UNIV_def ThreadState_defs mask_def option_to_ctcb_ptr_def)
 
-          apply (rule_tac Q="\<lambda>rv. valid_queues and tcb_at' receiver and valid_queues' and
+          apply (rule_tac Q="\<lambda>rv. tcb_at' receiver and
                                 valid_objs' and sch_act_simple and (\<lambda>s. ksCurDomain s \<le> maxDomain) and
-                                (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)" in hoare_post_imp)
+                                (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and
+                                pspace_aligned' and pspace_distinct'" in hoare_post_imp)
            apply (clarsimp simp: inQ_def weak_sch_act_wf_def)
-          apply (wp threadSet_valid_queues threadSet_sch_act handleFaultReply_sch_act_wf)
+          apply (wp threadSet_sch_act handleFaultReply_sch_act_wf)
          apply (clarsimp simp: guard_is_UNIV_def)
         apply assumption
        apply clarsimp
@@ -4502,7 +4494,7 @@ proof -
        apply (erule(1) cmap_relation_ko_atE [OF cmap_relation_tcb])
        apply (clarsimp simp: ctcb_relation_def typ_heap_simps)
       apply wp
-      apply (strengthen vp_invs_strg' invs_valid_queues')
+      apply (strengthen vp_invs_strg')
       apply (wp cteDeleteOne_tcbFault cteDeleteOne_sch_act_wf)
      apply vcg
     apply (rule conseqPre, vcg)
@@ -4518,7 +4510,6 @@ proof -
                         cap_get_tag_isCap)
   apply fastforce
   done
-qed
 
 lemma ccorres_getCTE_cte_at:
   "ccorresG rf_sr \<Gamma> r xf P P' hs (getCTE p >>= f) c
@@ -4538,7 +4529,7 @@ lemma ccorres_getCTE_cte_at:
   done
 
 lemma setupCallerCap_ccorres [corres]:
-  "ccorres dc xfdc (valid_queues and valid_pspace' and (\<lambda>s. \<forall>d p. sender \<notin> set (ksReadyQueues s (d, p)))
+  "ccorres dc xfdc (valid_pspace'
                     and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and sch_act_not sender
                     and tcb_at' sender and tcb_at' receiver
                     and tcb_at' sender and tcb_at' receiver)
@@ -4670,23 +4661,20 @@ lemma sendIPC_dequeue_ccorres_helper:
                          typ_heap_simps')
         apply (elim conjE)
         apply (intro conjI)
-             \<comment> \<open>tcb relation\<close>
-             apply (erule ctcb_relation_null_queue_ptrs)
-             apply (clarsimp simp: comp_def)
-            \<comment> \<open>ep relation\<close>
-            apply (rule cpspace_relation_ep_update_ep, assumption+)
-             apply (simp add: cendpoint_relation_def Let_def EPState_Idle_def
-                              tcb_queue_relation'_def)
-            apply simp
-           \<comment> \<open>ntfn relation\<close>
-           apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+            \<comment> \<open>tcb relation\<close>
+            apply (erule ctcb_relation_null_ep_ptrs)
+            apply (clarsimp simp: comp_def)
+           \<comment> \<open>ep relation\<close>
+           apply (rule cpspace_relation_ep_update_ep, assumption+)
+            apply (simp add: cendpoint_relation_def Let_def EPState_Idle_def
+                             tcb_queue_relation'_def)
            apply simp
-           apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
-            apply simp
-           apply (erule (1) map_to_ko_atI')
-          \<comment> \<open>queue relation\<close>
-          apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-          apply (clarsimp simp: comp_def)
+          \<comment> \<open>ntfn relation\<close>
+          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+          apply simp
+          apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+           apply simp
+          apply (erule (1) map_to_ko_atI')
          apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs)
         apply (simp add: cmachine_state_relation_def)
        apply (simp add: h_t_valid_clift_Some_iff)
@@ -4710,31 +4698,27 @@ lemma sendIPC_dequeue_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-             \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (rule cpspace_relation_ep_update_ep, assumption+)
-            apply (clarsimp simp: cendpoint_relation_def Let_def
-                                  isRecvEP_def isSendEP_def mask_shiftl_decompose
-                                  tcb_queue_relation'_def valid_ep'_def
-                       simp flip: canonical_bit_def
-                           split: endpoint.splits list.splits
-                       split del: if_split)
-            apply (subgoal_tac "tcb_at' (if x22 = [] then x21 else last x22) \<sigma>") (* FIXME AARCH64: clean up names *)
-             apply (erule (1) tcb_and_not_mask_canonical[OF invs_pspace_canonical'])
-             apply (simp (no_asm) add: objBits_simps')
-            apply (clarsimp split: if_split)
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (rule cpspace_relation_ep_update_ep, assumption+)
+           apply (clarsimp simp: cendpoint_relation_def Let_def
+                                 isRecvEP_def isSendEP_def mask_shiftl_decompose
+                                 tcb_queue_relation'_def valid_ep'_def
+                      simp flip: canonical_bit_def
+                          split: endpoint.splits list.splits)
+           apply (subgoal_tac "tcb_at' (if x22 = [] then x21 else last x22) \<sigma>") (* FIXME AARCH64: clean up names *)
+            apply (erule (1) tcb_and_not_mask_canonical[OF invs_pspace_canonical'])
+            apply (simp (no_asm) add: objBits_simps')
+           apply (clarsimp split: if_split)
            apply simp
-          \<comment> \<open>ntfn relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         \<comment> \<open>ntfn relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
           apply simp
-          apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
-           apply simp
-          apply (erule (1) map_to_ko_atI')
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         apply (clarsimp simp: comp_def)
+         apply (erule (1) map_to_ko_atI')
         apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs)
        apply (simp add: cmachine_state_relation_def)
       apply (simp add: h_t_valid_clift_Some_iff)
@@ -4759,11 +4743,10 @@ lemma rf_sr_tcb_update_twice:
                 packed_heap_update_collapse_hrs)
 
 lemma sendIPC_block_ccorres_helper:
-  "ccorres dc xfdc (tcb_at' thread and valid_queues and valid_objs' and
-                    pspace_canonical' and
+  "ccorres dc xfdc (tcb_at' thread and valid_objs' and pspace_canonical' and
+                    pspace_aligned' and pspace_distinct' and
                     sch_act_not thread and ep_at' epptr and
-                    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s \<and>
-                         (\<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))) and
+                    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and
                     K (bos = ThreadState_BlockedOnSend
                       \<and> epptr' = epptr \<and> badge' = badge
                       \<and> cg = from_bool canGrant \<and> cgr = from_bool canGrantReply
@@ -4821,7 +4804,7 @@ lemma sendIPC_block_ccorres_helper:
        apply ceqv
       apply clarsimp
       apply ctac
-     apply (wp threadSet_weak_sch_act_wf_runnable' threadSet_valid_queues
+     apply (wp threadSet_weak_sch_act_wf_runnable'
                threadSet_valid_objs')
     apply (clarsimp simp: guard_is_UNIV_def)
    apply (clarsimp simp: sch_act_wf_weak valid_tcb'_def valid_tcb_state'_def
@@ -4926,6 +4909,19 @@ lemma tcb_queue_relation_qend_valid':
   apply (simp add: h_t_valid_clift_Some_iff)
   done
 
+lemma tcb_queue'_head_end_NULL:
+  assumes qr: "tcb_queue_relation' getNext getPrev mp queue qhead qend"
+  and   tat: "\<forall>t\<in>set queue. tcb_at' t s"
+  shows "(qend = NULL) = (qhead = NULL)"
+  using qr tat
+  apply -
+  apply (erule tcb_queue_relationE')
+  apply (simp add: tcb_queue_head_empty_iff split: if_splits)
+  apply (rule tcb_at_not_NULL)
+  apply (erule bspec)
+  apply simp
+  done
+
 lemma tcbEPAppend_spec:
   "\<forall>s queue. \<Gamma> \<turnstile> \<lbrace>s. \<exists>t. (t, s) \<in> rf_sr
                       \<and> (\<forall>tcb\<in>set queue. tcb_at' tcb t) \<and> distinct queue
@@ -5048,34 +5044,31 @@ lemma sendIPC_enqueue_ccorres_helper:
        apply (elim conjE)
        apply (intro conjI)
             \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (rule cpspace_relation_ep_update_ep', assumption+)
-            apply (clarsimp simp: cendpoint_relation_def Let_def
-                                  mask_def [where n=3] EPState_Send_def)
-            apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask)
-            apply (rule conjI, simp add: mask_def)
-            subgoal
-              apply (clarsimp simp: valid_pspace'_def objBits_simps' mask_shiftl_decompose
-                              simp flip: canonical_bit_def)
-              apply (erule (1) tcb_and_not_mask_canonical)
-              by (simp (no_asm) add: tcbBlockSizeBits_def)
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (rule cpspace_relation_ep_update_ep', assumption+)
+           apply (clarsimp simp: cendpoint_relation_def Let_def
+                                 mask_def [where n=3] EPState_Send_def)
+           apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask)
+           apply (rule conjI, simp add: mask_def)
+           subgoal
+             apply (clarsimp simp: valid_pspace'_def objBits_simps' mask_shiftl_decompose
+                             simp flip: canonical_bit_def)
+             apply (erule (1) tcb_and_not_mask_canonical)
+             by (simp (no_asm) add: tcbBlockSizeBits_def)
+          apply (simp add: isSendEP_def isRecvEP_def)
+         \<comment> \<open>ntfn relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cnotification_relation_ep_queue, assumption+)
            apply (simp add: isSendEP_def isRecvEP_def)
-          \<comment> \<open>ntfn relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
           apply simp
-          apply (rule cnotification_relation_ep_queue, assumption+)
-            apply (simp add: isSendEP_def isRecvEP_def)
-           apply simp
-          apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
-          apply (erule(2) map_to_ko_at_updI')
-           apply (simp only:projectKOs injectKO_ep objBits_simps)
-           apply clarsimp
-          apply (clarsimp simp: obj_at'_def)
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         apply (clarsimp simp: comp_def)
+         apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
+         apply (erule(2) map_to_ko_at_updI')
+          apply (simp only:projectKOs injectKO_ep objBits_simps)
+          apply clarsimp
+         apply (clarsimp simp: obj_at'_def)
         apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs)
        apply (simp add: cmachine_state_relation_def)
       apply (simp add: typ_heap_simps')
@@ -5092,44 +5085,41 @@ lemma sendIPC_enqueue_ccorres_helper:
                        typ_heap_simps')
       apply (elim conjE)
       apply (intro conjI)
-           \<comment> \<open>tcb relation\<close>
-           apply (erule ctcb_relation_null_queue_ptrs)
-           apply (clarsimp simp: comp_def)
+          \<comment> \<open>tcb relation\<close>
+          apply (erule ctcb_relation_null_ep_ptrs)
+          apply (clarsimp simp: comp_def)
           \<comment> \<open>ep relation\<close>
           apply (rule cpspace_relation_ep_update_ep', assumption+)
-           apply (clarsimp simp: cendpoint_relation_def Let_def
-                                 mask_def [where n=3] EPState_Send_def
-                          split: if_split)
-           subgoal
-             apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask
-                                 valid_ep'_def
-                           dest: tcb_queue_relation_next_not_NULL)
-             apply (rule conjI, clarsimp)
-              apply (rule conjI, fastforce simp: mask_def)
-              apply (clarsimp simp: valid_pspace'_def objBits_simps' mask_shiftl_decompose
-                              simp flip: canonical_bit_def)
-              apply (erule (1) tcb_and_not_mask_canonical)
-              apply (simp (no_asm) add: tcbBlockSizeBits_def)
+          apply (clarsimp simp: cendpoint_relation_def Let_def
+                                mask_def [where n=3] EPState_Send_def
+                         split: if_split)
+          subgoal
+            apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask
+                                  valid_ep'_def
+                            dest: tcb_queue_relation_next_not_NULL)
+            apply (rule conjI, clarsimp)
+             apply (rule conjI, fastforce simp: mask_def)
              apply (clarsimp simp: valid_pspace'_def objBits_simps' mask_shiftl_decompose
                              simp flip: canonical_bit_def)
-             apply (rule conjI, solves \<open>simp (no_asm) add: mask_def\<close>)
              apply (erule (1) tcb_and_not_mask_canonical)
              apply (simp (no_asm) add: tcbBlockSizeBits_def)
-             done
+            apply (clarsimp simp: valid_pspace'_def objBits_simps' mask_shiftl_decompose
+                            simp flip: canonical_bit_def)
+            apply (rule conjI, solves \<open>simp (no_asm) add: mask_def\<close>)
+            apply (erule (1) tcb_and_not_mask_canonical)
+            apply (simp (no_asm) add: tcbBlockSizeBits_def)
+            done
+         apply (simp add: isSendEP_def isRecvEP_def)
+        \<comment> \<open>ntfn relation\<close>
+        apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+        apply simp
+        apply (rule cnotification_relation_ep_queue, assumption+)
           apply (simp add: isSendEP_def isRecvEP_def)
-         \<comment> \<open>ntfn relation\<close>
-         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
          apply simp
-         apply (rule cnotification_relation_ep_queue, assumption+)
-           apply (simp add: isSendEP_def isRecvEP_def)
-          apply simp
-         apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
-         apply (erule(2) map_to_ko_at_updI')
-          apply (clarsimp simp: objBitsKO_def)
-         apply (clarsimp simp: obj_at'_def)
-        \<comment> \<open>queue relation\<close>
-        apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-        apply (clarsimp simp: comp_def)
+        apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
+        apply (erule(2) map_to_ko_at_updI')
+         apply (clarsimp simp: objBitsKO_def)
+        apply (clarsimp simp: obj_at'_def)
        apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs)
       apply (simp add: cmachine_state_relation_def)
      apply (simp add: h_t_valid_clift_Some_iff)
@@ -5149,8 +5139,7 @@ lemma ctcb_relation_blockingIPCCanGrantD:
 
 lemma sendIPC_ccorres [corres]:
   "ccorres dc xfdc (invs' and st_tcb_at' simple' thread
-                          and sch_act_not thread and ep_at' epptr and
-                          (\<lambda>s. \<forall>d p. thread \<notin> set (ksReadyQueues s (d, p))))
+                          and sch_act_not thread and ep_at' epptr)
      (UNIV \<inter> \<lbrace>\<acute>blocking = from_bool blocking\<rbrace>
            \<inter> \<lbrace>\<acute>do_call = from_bool do_call\<rbrace>
            \<inter> \<lbrace>\<acute>badge = badge\<rbrace>
@@ -5181,8 +5170,7 @@ lemma sendIPC_ccorres [corres]:
      apply ceqv
     apply (rule_tac A="invs' and st_tcb_at' simple' thread
                           and sch_act_not thread and ko_at' ep epptr
-                          and ep_at' epptr
-                          and (\<lambda>s. \<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))"
+                          and ep_at' epptr"
                  in ccorres_guard_imp2 [where A'=UNIV])
      apply wpc
        \<comment> \<open>RecvEP case\<close>
@@ -5230,12 +5218,11 @@ lemma sendIPC_ccorres [corres]:
               apply (ctac add: setThreadState_ccorres)
              apply (rule ccorres_return_Skip)
             apply (wpsimp wp: hoare_drop_imps hoare_vcg_all_lift possibleSwitchTo_sch_act_not
-                              possibleSwitchTo_sch_act_not sts_st_tcb'
-                              possibleSwitchTo_ksQ' sts_valid_queues sts_ksQ'
+                              possibleSwitchTo_sch_act_not sts_st_tcb' sts_valid_objs'
                           simp: valid_tcb_state'_def)+
           apply vcg
-         apply (wpsimp wp: doIPCTransfer_sch_act setEndpoint_ksQ hoare_vcg_all_lift
-                          set_ep_valid_objs' setEndpoint_valid_mdb'
+         apply (wpsimp wp: doIPCTransfer_sch_act hoare_vcg_all_lift
+                           set_ep_valid_objs' setEndpoint_valid_mdb'
                 | wp (once) hoare_drop_imp
                 | strengthen sch_act_wf_weak)+
        apply (fastforce simp: guard_is_UNIV_def ThreadState_defs Collect_const_mem mask_def
@@ -5356,11 +5343,10 @@ lemma ctcb_relation_blockingIPCCanGrantReplyD:
   done
 
 lemma receiveIPC_block_ccorres_helper:
-  "ccorres dc xfdc (tcb_at' thread and valid_queues and valid_objs' and
-                    pspace_canonical' and
+  "ccorres dc xfdc (tcb_at' thread and valid_objs' and
+                    pspace_canonical' and pspace_aligned' and pspace_distinct' and
                     sch_act_not thread and ep_at' epptr and
-                    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s \<and>
-                     (\<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))) and
+                    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and
                     K (epptr = epptr && ~~ mask 4) and
                     K (isEndpointCap cap \<and> ccap_relation cap cap'))
                    UNIV hs
@@ -5402,7 +5388,7 @@ lemma receiveIPC_block_ccorres_helper:
        apply ceqv
       apply clarsimp
       apply ctac
-     apply (wp threadSet_valid_queues hoare_vcg_all_lift threadSet_valid_objs'
+     apply (wp hoare_vcg_all_lift threadSet_valid_objs'
                threadSet_weak_sch_act_wf_runnable')
     apply (clarsimp simp: guard_is_UNIV_def)
    apply (clarsimp simp: sch_act_wf_weak valid_tcb'_def valid_tcb_state'_def
@@ -5468,44 +5454,41 @@ lemma receiveIPC_enqueue_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-             \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (rule cpspace_relation_ep_update_ep', assumption+)
-            apply (clarsimp simp: cendpoint_relation_def Let_def
-                                  mask_def [where n=3] EPState_Recv_def
-                           split: if_split)
-            subgoal
-              apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask
-                                  valid_ep'_def
-                            dest: tcb_queue_relation_next_not_NULL)
-              apply (rule conjI, clarsimp)
-               apply (rule conjI, fastforce simp: mask_def)
-               apply (clarsimp simp: valid_pspace'_def objBits_simps' mask_shiftl_decompose
-                               simp flip: canonical_bit_def)
-               apply (erule (1) tcb_and_not_mask_canonical)
-               apply (simp (no_asm) add: tcbBlockSizeBits_def)
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (rule cpspace_relation_ep_update_ep', assumption+)
+           apply (clarsimp simp: cendpoint_relation_def Let_def
+                                 mask_def [where n=3] EPState_Recv_def
+                          split: if_split)
+           subgoal
+             apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask
+                                   valid_ep'_def
+                             dest: tcb_queue_relation_next_not_NULL)
+             apply (rule conjI, clarsimp)
+              apply (rule conjI, fastforce simp: mask_def)
               apply (clarsimp simp: valid_pspace'_def objBits_simps' mask_shiftl_decompose
                               simp flip: canonical_bit_def)
-              apply (rule conjI, solves \<open>simp (no_asm) add: mask_def\<close>)
               apply (erule (1) tcb_and_not_mask_canonical)
               apply (simp (no_asm) add: tcbBlockSizeBits_def)
-              done
+             apply (clarsimp simp: valid_pspace'_def objBits_simps' mask_shiftl_decompose
+                             simp flip: canonical_bit_def)
+             apply (rule conjI, solves \<open>simp (no_asm) add: mask_def\<close>)
+             apply (erule (1) tcb_and_not_mask_canonical)
+             apply (simp (no_asm) add: tcbBlockSizeBits_def)
+             done
+          apply (simp add: isSendEP_def isRecvEP_def)
+         \<comment> \<open>ntfn relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cnotification_relation_ep_queue, assumption+)
            apply (simp add: isSendEP_def isRecvEP_def)
-          \<comment> \<open>ntfn relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
           apply simp
-          apply (rule cnotification_relation_ep_queue, assumption+)
-            apply (simp add: isSendEP_def isRecvEP_def)
-           apply simp
-          apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
-          apply (erule(2) map_to_ko_at_updI')
-           apply (clarsimp simp: objBitsKO_def)
-          apply (clarsimp simp: obj_at'_def projectKOs)
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         apply (clarsimp simp: comp_def)
+         apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
+         apply (erule(2) map_to_ko_at_updI')
+          apply (clarsimp simp: objBitsKO_def)
+         apply (clarsimp simp: obj_at'_def projectKOs)
         apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs)
        apply (simp add: cmachine_state_relation_def)
       apply (simp add: h_t_valid_clift_Some_iff)
@@ -5522,35 +5505,32 @@ lemma receiveIPC_enqueue_ccorres_helper:
                        typ_heap_simps')
       apply (elim conjE)
       apply (intro conjI)
-           \<comment> \<open>tcb relation\<close>
-           apply (erule ctcb_relation_null_queue_ptrs)
-           apply (clarsimp simp: comp_def)
-          \<comment> \<open>ep relation\<close>
-          apply (rule cpspace_relation_ep_update_ep', assumption+)
-           apply (clarsimp simp: cendpoint_relation_def Let_def
-                                 mask_def [where n=3] EPState_Recv_def)
-           apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask
-                           simp flip: canonical_bit_def)
-           subgoal
-             apply (rule conjI, solves\<open>simp (no_asm) add: mask_def\<close>)
-             apply (clarsimp simp: valid_pspace'_def mask_shiftl_decompose
-                             simp flip: canonical_bit_def)
-             apply (erule (1) tcb_and_not_mask_canonical, simp (no_asm) add: tcbBlockSizeBits_def)
-             done
+          \<comment> \<open>tcb relation\<close>
+          apply (erule ctcb_relation_null_ep_ptrs)
+          apply (clarsimp simp: comp_def)
+         \<comment> \<open>ep relation\<close>
+         apply (rule cpspace_relation_ep_update_ep', assumption+)
+          apply (clarsimp simp: cendpoint_relation_def Let_def
+                                mask_def [where n=3] EPState_Recv_def)
+          apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask
+                          simp flip: canonical_bit_def)
+          subgoal
+            apply (rule conjI, solves\<open>simp (no_asm) add: mask_def\<close>)
+            apply (clarsimp simp: valid_pspace'_def mask_shiftl_decompose
+                            simp flip: canonical_bit_def)
+            apply (erule (1) tcb_and_not_mask_canonical, simp (no_asm) add: tcbBlockSizeBits_def)
+            done
+         apply (simp add: isSendEP_def isRecvEP_def)
+        \<comment> \<open>ntfn relation\<close>
+        apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+        apply simp
+        apply (rule cnotification_relation_ep_queue, assumption+)
           apply (simp add: isSendEP_def isRecvEP_def)
-         \<comment> \<open>ntfn relation\<close>
-         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
          apply simp
-         apply (rule cnotification_relation_ep_queue, assumption+)
-           apply (simp add: isSendEP_def isRecvEP_def)
-          apply simp
-         apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
-         apply (erule(2) map_to_ko_at_updI')
-          apply (clarsimp simp: objBitsKO_def)
-         apply (clarsimp simp: obj_at'_def)
-        \<comment> \<open>queue relation\<close>
-        apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-        apply (clarsimp simp: comp_def)
+        apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
+        apply (erule(2) map_to_ko_at_updI')
+         apply (clarsimp simp: objBitsKO_def)
+        apply (clarsimp simp: obj_at'_def)
        apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs)
       apply (simp add: cmachine_state_relation_def)
      apply (simp add: typ_heap_simps')
@@ -5619,23 +5599,20 @@ lemma receiveIPC_dequeue_ccorres_helper:
                          typ_heap_simps')
         apply (elim conjE)
         apply (intro conjI)
-             \<comment> \<open>tcb relation\<close>
-             apply (erule ctcb_relation_null_queue_ptrs)
-             apply (clarsimp simp: comp_def)
-            \<comment> \<open>ep relation\<close>
-            apply (rule cpspace_relation_ep_update_ep, assumption+)
-             apply (simp add: cendpoint_relation_def Let_def EPState_Idle_def
-                              tcb_queue_relation'_def)
-            apply simp
-           \<comment> \<open>ntfn relation\<close>
-           apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-           apply simp
-           apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+            \<comment> \<open>tcb relation\<close>
+            apply (erule ctcb_relation_null_ep_ptrs)
+            apply (clarsimp simp: comp_def)
+           \<comment> \<open>ep relation\<close>
+           apply (rule cpspace_relation_ep_update_ep, assumption+)
+            apply (simp add: cendpoint_relation_def Let_def EPState_Idle_def
+                             tcb_queue_relation'_def)
            apply simp
+          \<comment> \<open>ntfn relation\<close>
+          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+          apply simp
+          apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+          apply simp
           apply (erule (1) map_to_ko_atI')
-          \<comment> \<open>queue relation\<close>
-          apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-          apply (clarsimp simp: comp_def)
          apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs)
         apply (simp add: cmachine_state_relation_def)
        apply (simp add: typ_heap_simps')
@@ -5659,31 +5636,28 @@ lemma receiveIPC_dequeue_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-            \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (rule cpspace_relation_ep_update_ep, assumption+)
-            apply (clarsimp simp: cendpoint_relation_def Let_def mask_shiftl_decompose
-                                  isRecvEP_def isSendEP_def
-                                  tcb_queue_relation'_def valid_ep'_def
-                       simp flip: canonical_bit_def
-                           split: endpoint.splits list.splits
-                       split del: if_split)
-            apply (subgoal_tac "tcb_at' (if x22 = [] then x21 else last x22) \<sigma>") (* FIXME AARCH64: clean up names *)
-             apply (erule (1) tcb_and_not_mask_canonical[OF invs_pspace_canonical'])
-             apply (simp (no_asm) add: objBits_simps')
-            apply (clarsimp split: if_split)
-           apply simp
-          \<comment> \<open>ntfn relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (rule cpspace_relation_ep_update_ep, assumption+)
+           apply (clarsimp simp: cendpoint_relation_def Let_def mask_shiftl_decompose
+                                 isRecvEP_def isSendEP_def
+                                 tcb_queue_relation'_def valid_ep'_def
+                      simp flip: canonical_bit_def
+                          split: endpoint.splits list.splits
+                      split del: if_split)
+           apply (subgoal_tac "tcb_at' (if x22 = [] then x21 else last x22) \<sigma>") (* FIXME AARCH64: clean up names *)
+            apply (erule (1) tcb_and_not_mask_canonical[OF invs_pspace_canonical'])
+            apply (simp (no_asm) add: objBits_simps')
+           apply (clarsimp split: if_split)
           apply simp
-          apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
-           apply simp
-          apply (erule (1) map_to_ko_atI')
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         apply (clarsimp simp: comp_def)
+         \<comment> \<open>ntfn relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+          apply simp
+         apply (erule (1) map_to_ko_atI')
         apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs)
        apply (simp add: cmachine_state_relation_def)
       apply (simp add: typ_heap_simps')
@@ -5800,7 +5774,6 @@ lemma receiveIPC_ccorres [corres]:
   notes option.case_cong_weak [cong]
   shows
   "ccorres dc xfdc (invs' and st_tcb_at' simple' thread and sch_act_not thread
-                          and (\<lambda>s. \<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))
                           and valid_cap' cap and K (isEndpointCap cap))
      (UNIV \<inter> \<lbrace>\<acute>thread = tcb_ptr_to_ctcb_ptr thread\<rbrace>
            \<inter> \<lbrace>ccap_relation cap \<acute>cap\<rbrace>
@@ -5876,7 +5849,6 @@ lemma receiveIPC_ccorres [corres]:
           apply ceqv
          apply (rule_tac A="invs' and st_tcb_at' simple' thread
                                   and sch_act_not thread
-                              and (\<lambda>s. \<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))
                                   and ko_at' ep (capEPPtr cap)"
                      in ccorres_guard_imp2 [where A'=UNIV])
            apply wpc
@@ -6016,27 +5988,25 @@ lemma receiveIPC_ccorres [corres]:
                  apply ccorres_rewrite
                  apply ctac
                    apply (ctac add: possibleSwitchTo_ccorres)
-                  apply (wpsimp wp: sts_st_tcb' sts_valid_queues)
+                  apply (wpsimp wp: sts_st_tcb' sts_valid_objs')
                  apply (vcg exspec=setThreadState_modifies)
                 apply (fastforce simp: guard_is_UNIV_def ThreadState_defs mask_def
                                        cap_get_tag_isCap ccap_relation_ep_helpers)
                apply (clarsimp simp: valid_tcb_state'_def)
-               apply (rule_tac Q="\<lambda>_. valid_pspace' and valid_queues
+               apply (rule_tac Q="\<lambda>_. valid_pspace'
                                        and st_tcb_at' ((=) sendState) sender and tcb_at' thread
                                        and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)
-                                       and (\<lambda>s. (\<forall>a b. sender \<notin> set (ksReadyQueues s (a, b))))
                                        and sch_act_not sender and K (thread \<noteq> sender)
                                        and (\<lambda>s. ksCurDomain s \<le> maxDomain)" in hoare_post_imp)
-                apply (clarsimp simp: valid_pspace_valid_objs' pred_tcb_at'_def sch_act_wf_weak
-                                      obj_at'_def)
+                apply (fastforce simp: valid_pspace_valid_objs' pred_tcb_at'_def sch_act_wf_weak
+                                       obj_at'_def)
                apply (wpsimp simp: guard_is_UNIV_def option_to_ptr_def option_to_0_def conj_ac)+
-           apply (rule_tac Q="\<lambda>rv. valid_queues and valid_pspace'
+           apply (rule_tac Q="\<lambda>rv. valid_pspace'
                                and cur_tcb' and tcb_at' sender and tcb_at' thread
                                and sch_act_not sender and K (thread \<noteq> sender)
                                and ep_at' (capEPPtr cap)
                                and (\<lambda>s. ksCurDomain s \<le> maxDomain)
-                               and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s \<and>
-                                        (\<forall>d p. sender \<notin> set (ksReadyQueues s (d, p))))"
+                               and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)"
                             in hoare_post_imp)
             subgoal by (auto, auto simp: st_tcb_at'_def obj_at'_def)
            apply (wp hoare_vcg_all_lift set_ep_valid_objs')
@@ -6072,14 +6042,11 @@ lemma receiveIPC_ccorres [corres]:
                                  split: if_split_asm bool.splits) (*very long *)
            apply (clarsimp simp: obj_at'_def state_refs_of'_def projectKOs)
           apply (frule(1) sym_refs_ko_atD' [OF _ invs_sym'])
-          apply (frule invs_queues)
           apply clarsimp
           apply (rename_tac list x xa)
           apply (rule_tac P="x\<in>set list" in case_split)
            apply (clarsimp simp:st_tcb_at_refs_of_rev')
            apply (erule_tac x=x and P="\<lambda>x. st_tcb_at' P x s" for P in ballE)
-            apply (drule_tac t=x in valid_queues_not_runnable'_not_ksQ)
-             apply (clarsimp simp: st_tcb_at'_def obj_at'_def)
             apply (subgoal_tac "sch_act_not x s")
              prefer 2
              apply (frule invs_sch_act_wf')
@@ -6157,23 +6124,20 @@ lemma sendSignal_dequeue_ccorres_helper:
                          typ_heap_simps')
         apply (elim conjE)
         apply (intro conjI)
-             \<comment> \<open>tcb relation\<close>
-             apply (erule ctcb_relation_null_queue_ptrs)
-             apply (clarsimp simp: comp_def)
-            \<comment> \<open>ep relation\<close>
-            apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-            apply simp
-            apply (rule cendpoint_relation_ntfn_queue [OF invs_sym'], assumption+)
-             apply simp+
-            apply (erule (1) map_to_ko_atI')
-           \<comment> \<open>ntfn relation\<close>
-           apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
-            apply (simp add: cnotification_relation_def Let_def NtfnState_Idle_def
-                             tcb_queue_relation'_def make_canonical_def canonical_bit_def)
+            \<comment> \<open>tcb relation\<close>
+            apply (erule ctcb_relation_null_ep_ptrs)
+            apply (clarsimp simp: comp_def)
+           \<comment> \<open>ep relation\<close>
+           apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
            apply simp
-          \<comment> \<open>queue relation\<close>
-          apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-          apply (clarsimp simp: comp_def)
+           apply (rule cendpoint_relation_ntfn_queue [OF invs_sym'], assumption+)
+            apply simp+
+           apply (erule (1) map_to_ko_atI')
+          \<comment> \<open>ntfn relation\<close>
+          apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
+           apply (simp add: cnotification_relation_def Let_def NtfnState_Idle_def
+                            tcb_queue_relation'_def make_canonical_def canonical_bit_def)
+          apply simp
          apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs)
         apply (simp add: cmachine_state_relation_def)
        apply (simp add: h_t_valid_clift_Some_iff)
@@ -6199,33 +6163,30 @@ lemma sendSignal_dequeue_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-            \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-           apply simp
-           apply (rule cendpoint_relation_ntfn_queue [OF invs_sym'], assumption+)
-            apply simp+
-           apply (erule (1) map_to_ko_atI')
-          \<comment> \<open>ntfn relation\<close>
-          apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
-           apply (clarsimp simp: cnotification_relation_def Let_def mask_shiftl_decompose
-                                 isWaitingNtfn_def
-                                 tcb_queue_relation'_def valid_ntfn'_def
-                          split: Structures_H.notification.splits list.splits
-                      split del: if_split)
-           apply (subgoal_tac "tcb_at' (if x22 = [] then x21 else last x22) \<sigma>") (* FIXME AARCH64: names *)
-            apply (rule conjI)
-             subgoal by (erule (1) tcb_ptr_canonical[OF invs_pspace_canonical'])
-            apply (rule context_conjI)
-             subgoal by (erule (1) tcb_ptr_canonical[OF invs_pspace_canonical'])
-            apply clarsimp
-           apply (clarsimp split: if_split)
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
           apply simp
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         apply (clarsimp simp: comp_def)
+          apply (rule cendpoint_relation_ntfn_queue [OF invs_sym'], assumption+)
+           apply simp+
+          apply (erule (1) map_to_ko_atI')
+         \<comment> \<open>ntfn relation\<close>
+         apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
+          apply (clarsimp simp: cnotification_relation_def Let_def mask_shiftl_decompose
+                                isWaitingNtfn_def
+                                tcb_queue_relation'_def valid_ntfn'_def
+                         split: Structures_H.notification.splits list.splits
+                     split del: if_split)
+          apply (subgoal_tac "tcb_at' (if x22 = [] then x21 else last x22) \<sigma>") (* FIXME AARCH64: names *)
+           apply (rule conjI)
+            subgoal by (erule (1) tcb_ptr_canonical[OF invs_pspace_canonical'])
+           apply (rule context_conjI)
+            subgoal by (erule (1) tcb_ptr_canonical[OF invs_pspace_canonical'])
+           apply clarsimp
+          apply (clarsimp split: if_split)
+         apply simp
         apply (clarsimp simp: carch_state_relation_def)
        apply (simp add: cmachine_state_relation_def)
       apply (simp add: h_t_valid_clift_Some_iff)
@@ -6332,7 +6293,7 @@ lemma sendSignal_ccorres [corres]:
          apply (ctac(no_vcg) add: setThreadState_ccorres)
           apply (ctac(no_vcg) add: setRegister_ccorres)
            apply (ctac add: possibleSwitchTo_ccorres)
-          apply (wp sts_running_valid_queues sts_st_tcb_at'_cases
+          apply (wp sts_valid_objs' sts_st_tcb_at'_cases
                  | simp add: option_to_ctcb_ptr_def split del: if_split)+
         apply (rule_tac Q="\<lambda>_. tcb_at' (the (ntfnBoundTCB ntfn)) and invs'"
                  in hoare_post_imp)
@@ -6398,10 +6359,8 @@ lemma sendSignal_ccorres [corres]:
        apply (ctac (no_vcg))
         apply (ctac add: possibleSwitchTo_ccorres)
        apply (simp)
-       apply (wp weak_sch_act_wf_lift_linear
-         setThreadState_oa_queued
-         sts_valid_queues tcb_in_cur_domain'_lift)[1]
-      apply (wp sts_valid_queues sts_runnable)
+       apply (wp weak_sch_act_wf_lift_linear tcb_in_cur_domain'_lift)[1]
+      apply (wp sts_valid_objs' sts_runnable)
      apply (wp setThreadState_st_tcb set_ntfn_valid_objs' | clarsimp)+
     apply (clarsimp simp: guard_is_UNIV_def ThreadState_defs mask_def
                           badgeRegister_def C_register_defs
@@ -6425,10 +6384,9 @@ lemma sendSignal_ccorres [corres]:
   done
 
 lemma receiveSignal_block_ccorres_helper:
-  "ccorres dc xfdc (tcb_at' thread and valid_queues and sch_act_not thread and
-                    valid_objs' and ntfn_at' ntfnptr and pspace_canonical' and
-                    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s \<and>
-                        (\<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))) and
+  "ccorres dc xfdc (tcb_at' thread and sch_act_not thread and valid_objs' and ntfn_at' ntfnptr and
+                    pspace_canonical' and pspace_aligned' and pspace_distinct' and
+                    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and
                     K (ntfnptr = ntfnptr && ~~ mask 4))
                    UNIV hs
            (setThreadState (Structures_H.thread_state.BlockedOnNotification
@@ -6465,7 +6423,7 @@ lemma receiveSignal_block_ccorres_helper:
        apply ceqv
       apply clarsimp
       apply ctac
-     apply (wp threadSet_valid_queues hoare_vcg_all_lift threadSet_valid_objs'
+     apply (wp hoare_vcg_all_lift threadSet_valid_objs'
                threadSet_weak_sch_act_wf_runnable')
     apply (clarsimp simp: guard_is_UNIV_def)
    apply (auto simp: weak_sch_act_wf_def valid_tcb'_def tcb_cte_cases_def
@@ -6584,37 +6542,34 @@ lemma receiveSignal_enqueue_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-            \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+          apply simp
+          apply (rule cendpoint_relation_ntfn_queue, assumption+)
+            apply (simp add: isWaitingNtfn_def)
            apply simp
-           apply (rule cendpoint_relation_ntfn_queue, assumption+)
-             apply (simp add: isWaitingNtfn_def)
-            apply simp
-           apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
-           apply (erule(2) map_to_ko_at_updI')
-            apply (clarsimp simp: objBitsKO_def)
-           apply (clarsimp simp: obj_at'_def)
-          \<comment> \<open>ntfn relation\<close>
-          apply (rule cpspace_relation_ntfn_update_ntfn', assumption+)
-            apply (case_tac "ntfn", simp_all)[1]
-           apply (clarsimp simp: cnotification_relation_def Let_def
-                                 mask_def [where n=3] NtfnState_Waiting_def)
-           subgoal
-             apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask valid_ntfn'_def
-                             dest: tcb_queue_relation_next_not_NULL)
-             apply (rule conjI, fastforce simp: mask_def)
-             apply (rule context_conjI)
-              subgoal by (fastforce simp: valid_pspace'_def objBits_simps'
-                              intro!: tcb_ptr_canonical
-                               dest!: st_tcb_strg'[rule_format])
-             by clarsimp
-          apply (simp add: isWaitingNtfn_def)
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         subgoal by (clarsimp simp: comp_def)
+          apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
+          apply (erule(2) map_to_ko_at_updI')
+           apply (clarsimp simp: objBitsKO_def)
+          apply (clarsimp simp: obj_at'_def)
+         \<comment> \<open>ntfn relation\<close>
+         apply (rule cpspace_relation_ntfn_update_ntfn', assumption+)
+           apply (case_tac "ntfn", simp_all)[1]
+          apply (clarsimp simp: cnotification_relation_def Let_def
+                                mask_def [where n=3] NtfnState_Waiting_def)
+          subgoal
+            apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask valid_ntfn'_def
+                            dest: tcb_queue_relation_next_not_NULL)
+            apply (rule conjI, fastforce simp: mask_def)
+            apply (rule context_conjI)
+             subgoal by (fastforce simp: valid_pspace'_def objBits_simps'
+                             intro!: tcb_ptr_canonical
+                              dest!: st_tcb_strg'[rule_format])
+            by clarsimp
+         apply (simp add: isWaitingNtfn_def)
         apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs)
        apply (simp add: cmachine_state_relation_def)
       apply (simp add: h_t_valid_clift_Some_iff)
@@ -6631,47 +6586,44 @@ lemma receiveSignal_enqueue_ccorres_helper:
                        typ_heap_simps')
       apply (elim conjE)
       apply (intro conjI)
-           \<comment> \<open>tcb relation\<close>
-           apply (erule ctcb_relation_null_queue_ptrs)
-           apply (clarsimp simp: comp_def)
-          \<comment> \<open>ep relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+          \<comment> \<open>tcb relation\<close>
+          apply (erule ctcb_relation_null_ep_ptrs)
+          apply (clarsimp simp: comp_def)
+         \<comment> \<open>ep relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cendpoint_relation_ntfn_queue, assumption+)
+           apply (simp add: isWaitingNtfn_def)
           apply simp
-          apply (rule cendpoint_relation_ntfn_queue, assumption+)
-            apply (simp add: isWaitingNtfn_def)
-           apply simp
-          apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
-          apply (erule(2) map_to_ko_at_updI')
-           apply (clarsimp simp: objBitsKO_def)
-          apply (clarsimp simp: obj_at'_def)
-         \<comment> \<open>ntfn relation\<close>
-         apply (rule cpspace_relation_ntfn_update_ntfn', assumption+)
-           apply (case_tac "ntfn", simp_all)[1]
-          apply (clarsimp simp: cnotification_relation_def Let_def
-                                mask_def [where n=3] NtfnState_Waiting_def
-                         split: if_split)
-          subgoal for _ _ ko'
-            apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask
-                            dest: tcb_queue_relation_next_not_NULL)
-            apply (rule conjI, clarsimp)
-             apply (rule conjI, fastforce simp: mask_def)
-             apply (rule context_conjI)
-              subgoal by (fastforce intro!: tcb_ptr_canonical
-                                     dest!: st_tcb_strg'[rule_format])
-             apply clarsimp
-            apply clarsimp
+         apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
+         apply (erule(2) map_to_ko_at_updI')
+          apply (clarsimp simp: objBitsKO_def)
+         apply (clarsimp simp: obj_at'_def)
+        \<comment> \<open>ntfn relation\<close>
+        apply (rule cpspace_relation_ntfn_update_ntfn', assumption+)
+          apply (case_tac "ntfn", simp_all)[1]
+         apply (clarsimp simp: cnotification_relation_def Let_def
+                               mask_def [where n=3] NtfnState_Waiting_def
+                        split: if_split)
+         subgoal for _ _ ko'
+           apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask
+                           dest: tcb_queue_relation_next_not_NULL)
+           apply (rule conjI, clarsimp)
             apply (rule conjI, fastforce simp: mask_def)
-            apply (rule conjI)
+            apply (rule context_conjI)
              subgoal by (fastforce intro!: tcb_ptr_canonical
                                     dest!: st_tcb_strg'[rule_format])
-            apply (subgoal_tac "canonical_address (ntfnQueue_head_CL (notification_lift ko'))")
-             apply (clarsimp simp: canonical_make_canonical_idem)
-            apply (clarsimp simp: notification_lift_def canonical_address_mask_eq canonical_bit_def)
-            done
-         apply (simp add: isWaitingNtfn_def)
-        \<comment> \<open>queue relation\<close>
-        apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-        apply (clarsimp simp: comp_def)
+            apply clarsimp
+           apply clarsimp
+           apply (rule conjI, fastforce simp: mask_def)
+           apply (rule conjI)
+            subgoal by (fastforce intro!: tcb_ptr_canonical
+                                   dest!: st_tcb_strg'[rule_format])
+           apply (subgoal_tac "canonical_address (ntfnQueue_head_CL (notification_lift ko'))")
+            apply (clarsimp simp: canonical_make_canonical_idem)
+           apply (clarsimp simp: notification_lift_def canonical_address_mask_eq canonical_bit_def)
+           done
+        apply (simp add: isWaitingNtfn_def)
        apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs)
       apply (simp add: cmachine_state_relation_def)
      apply (simp add: h_t_valid_clift_Some_iff)
@@ -6683,7 +6635,6 @@ lemma receiveSignal_enqueue_ccorres_helper:
 lemma receiveSignal_ccorres [corres]:
   "ccorres dc xfdc (invs' and valid_cap' cap and st_tcb_at' simple' thread
                     and sch_act_not thread
-                    and (\<lambda>s. \<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))
                     and K (isNotificationCap cap))
      (UNIV \<inter> \<lbrace>\<acute>thread = tcb_ptr_to_ctcb_ptr thread\<rbrace>
            \<inter> \<lbrace>ccap_relation cap \<acute>cap\<rbrace>
diff --git a/proof/crefine/AARCH64/IsolatedThreadAction.thy b/proof/crefine/AARCH64/IsolatedThreadAction.thy
index 528b57802e..9bcadc156e 100644
--- a/proof/crefine/AARCH64/IsolatedThreadAction.thy
+++ b/proof/crefine/AARCH64/IsolatedThreadAction.thy
@@ -68,12 +68,11 @@ lemma put_tcb_state_regs_twice[simp]:
   "put_tcb_state_regs tsr (put_tcb_state_regs tsr' tcb)
     = put_tcb_state_regs tsr tcb"
   apply (simp add: put_tcb_state_regs_def put_tcb_state_regs_tcb_def
-                   atcbContextSet_def
-                   makeObject_tcb newArchTCB_def newContext_def initContext_def
+                   makeObject_tcb newArchTCB_def
             split: tcb_state_regs.split option.split
                    Structures_H.kernel_object.split)
-  apply (intro all_tcbI impI allI)
-  apply (case_tac q, simp)
+  using atcbContextSet_def atcbContext_set_set
+  apply (intro all_tcbI impI allI conjI; simp)
   done
 
 lemma partial_overwrite_twice[simp]:
@@ -1269,9 +1268,12 @@ lemma oblivious_switchToThread_schact:
                    threadSet_def tcbSchedEnqueue_def unless_when asUser_def
                    getQueue_def setQueue_def storeWordUser_def setRegister_def
                    pointerInUserData_def isRunnable_def isStopped_def
-                   getThreadState_def tcbSchedDequeue_def bitmap_fun_defs)
+                   getThreadState_def tcbSchedDequeue_def bitmap_fun_defs
+                   getThreadState_def tcbSchedDequeue_def tcbQueueRemove_def bitmap_fun_defs
+                   ksReadyQueues_asrt_def)
   by (safe intro!: oblivious_bind
-              | simp_all add: oblivious_setVMRoot_schact oblivious_vcpuSwitch_schact)+
+              | simp_all add: ready_qs_runnable_def idleThreadNotQueued_def
+                              oblivious_setVMRoot_schact oblivious_vcpuSwitch_schact)+
 
 (* FIXME move *)
 lemma empty_fail_getCurThread[intro!, wp, simp]:
@@ -1311,9 +1313,7 @@ lemma tcbSchedEnqueue_tcbPriority[wp]:
   done
 
 crunch obj_at_prio[wp]: cteDeleteOne "obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t"
-  (wp: crunch_wps setEndpoint_obj_at'_tcb
-       setThreadState_obj_at_unchanged setNotification_tcb setBoundNotification_obj_at_unchanged
-        simp: crunch_simps unless_def)
+  (wp: crunch_wps setEndpoint_obj_at'_tcb setNotification_tcb simp: crunch_simps unless_def)
 
 lemma setThreadState_no_sch_change:
   "\<lbrace>\<lambda>s. P (ksSchedulerAction s) \<and> (runnable' st \<or> t \<noteq> ksCurThread s)\<rbrace>
@@ -1432,8 +1432,6 @@ lemma setCTE_assert_modify:
        apply (rule word_and_le2)
       apply (simp add: objBits_simps mask_def field_simps)
      apply (simp add: simpler_modify_def cong: option.case_cong if_cong)
-     apply (rule kernel_state.fold_congs[OF refl refl])
-     apply (clarsimp simp: projectKO_opt_tcb cong: if_cong)
     apply (clarsimp simp: lookupAround2_char1 word_and_le2)
     apply (rule ccontr, clarsimp)
     apply (erule(2) ps_clearD)
@@ -1450,7 +1448,7 @@ lemma setCTE_assert_modify:
    apply (erule disjE)
     apply clarsimp
     apply (frule(1) tcb_cte_cases_aligned_helpers)
-    apply (clarsimp simp: domI[where m = cte_cte_cases] field_simps)
+    apply (clarsimp simp: domI field_simps)
     apply (clarsimp simp: lookupAround2_char1 obj_at'_def projectKOs
                           objBits_simps)
    apply (clarsimp simp: obj_at'_def lookupAround2_char1
@@ -1572,11 +1570,14 @@ lemma thread_actions_isolatableD:
 lemma tcbSchedDequeue_rewrite:
   "monadic_rewrite True True (obj_at' (Not \<circ> tcbQueued) t) (tcbSchedDequeue t) (return ())"
   apply (simp add: tcbSchedDequeue_def)
-   apply (wp_pre, monadic_rewrite_symb_exec_l_known False, simp)
-    apply (rule monadic_rewrite_refl)
-   apply (wpsimp wp: threadGet_const)+
+  apply wp_pre
+  apply monadic_rewrite_symb_exec_l
+    apply (monadic_rewrite_symb_exec_l_known False, simp)
+     apply (rule monadic_rewrite_refl)
+    apply (wpsimp wp: threadGet_const)+
   done
 
+(* FIXME: improve automation here *)
 lemma switchToThread_rewrite:
   "monadic_rewrite True True
        (ct_in_state' (Not \<circ> runnable') and cur_tcb' and obj_at' (Not \<circ> tcbQueued) t)
@@ -1584,7 +1585,9 @@ lemma switchToThread_rewrite:
        (do Arch.switchToThread t; setCurThread t od)"
   apply (simp add: switchToThread_def Thread_H.switchToThread_def)
   apply (monadic_rewrite_l tcbSchedDequeue_rewrite, simp)
-   apply (rule monadic_rewrite_refl)
+   (* strip LHS of getters and asserts until LHS and RHS are the same *)
+   apply (repeat_unless \<open>rule monadic_rewrite_refl\<close> monadic_rewrite_symb_exec_l)
+      apply wpsimp+
   apply (clarsimp simp: comp_def)
   done
 
@@ -1626,9 +1629,33 @@ lemma switchToThread_isolatable:
                      split: tcb_state_regs.split)+
   done
 
+lemma tcbQueued_put_tcb_state_regs_tcb:
+  "tcbQueued (put_tcb_state_regs_tcb tsr tcb) = tcbQueued tcb"
+  apply (clarsimp simp: put_tcb_state_regs_tcb_def)
+  by (cases tsr; clarsimp)
+
+lemma idleThreadNotQueued_isolatable:
+  "thread_actions_isolatable idx (stateAssert idleThreadNotQueued [])"
+  apply (simp add: stateAssert_def2 stateAssert_def)
+  apply (intro thread_actions_isolatable_bind[OF _ _ hoare_pre(1)]
+               gets_isolatable
+               thread_actions_isolatable_if
+               thread_actions_isolatable_returns
+               thread_actions_isolatable_fail)
+    unfolding idleThreadNotQueued_def
+    apply (clarsimp simp: obj_at_partial_overwrite_If)
+    apply (clarsimp simp: obj_at'_def tcbQueued_put_tcb_state_regs_tcb)
+   apply wpsimp+
+  done
+
 lemma setCurThread_isolatable:
   "thread_actions_isolatable idx (setCurThread t)"
-  by (simp add: setCurThread_def modify_isolatable)
+  unfolding setCurThread_def
+  apply (rule thread_actions_isolatable_bind)
+    apply (rule idleThreadNotQueued_isolatable)
+   apply (fastforce intro: modify_isolatable)
+  apply wpsimp
+  done
 
 lemma isolate_thread_actions_tcbs_at:
   assumes f: "\<And>x. \<lbrace>tcb_at' (idx x)\<rbrace> f \<lbrace>\<lambda>rv. tcb_at' (idx x)\<rbrace>" shows
diff --git a/proof/crefine/AARCH64/Recycle_C.thy b/proof/crefine/AARCH64/Recycle_C.thy
index 777bfd491b..ce0e81ca3d 100644
--- a/proof/crefine/AARCH64/Recycle_C.thy
+++ b/proof/crefine/AARCH64/Recycle_C.thy
@@ -754,16 +754,6 @@ lemma cnotification_relation_q_cong:
   apply (auto intro: iffD1[OF tcb_queue_relation'_cong[OF refl refl refl]])
   done
 
-lemma tcbSchedEnqueue_ep_at:
-  "\<lbrace>obj_at' (P :: endpoint \<Rightarrow> bool) ep\<rbrace>
-      tcbSchedEnqueue t
-   \<lbrace>\<lambda>rv. obj_at' P ep\<rbrace>"
-  including no_pre
-  apply (simp add: tcbSchedEnqueue_def unless_def null_def)
-  apply (wp threadGet_wp, clarsimp, wp+)
-  apply (clarsimp split: if_split, wp)
-  done
-
 lemma ccorres_duplicate_guard:
   "ccorres r xf (P and P) Q hs f f' \<Longrightarrow> ccorres r xf P Q hs f f'"
   by (erule ccorres_guard_imp, auto)
@@ -786,10 +776,11 @@ lemma cancelBadgedSends_ccorres:
               (UNIV \<inter> {s. epptr_' s = Ptr ptr} \<inter> {s. badge_' s = bdg}) []
        (cancelBadgedSends ptr bdg) (Call cancelBadgedSends_'proc)"
   apply (cinit lift: epptr_' badge_' simp: whileAnno_def)
+   apply (rule ccorres_stateAssert)
    apply (simp add: list_case_return
               cong: list.case_cong Structures_H.endpoint.case_cong call_ignore_cong
                del: Collect_const)
-   apply (rule ccorres_pre_getEndpoint)
+   apply (rule ccorres_pre_getEndpoint, rename_tac ep)
    apply (rule_tac R="ko_at' ep ptr" and xf'="ret__unsigned_longlong_'"
                and val="case ep of RecvEP q \<Rightarrow> scast EPState_Recv | IdleEP \<Rightarrow> scast EPState_Idle
                                 | SendEP q \<Rightarrow> scast EPState_Send"
@@ -838,9 +829,9 @@ lemma cancelBadgedSends_ccorres:
                    st_tcb_at' (\<lambda>st. isBlockedOnSend st \<and> blockingObject st = ptr) x s)
                               \<and> distinct (xs @ list) \<and> ko_at' IdleEP ptr s
                               \<and> (\<forall>p. \<forall>x \<in> set (xs @ list). \<forall>rf. (x, rf) \<notin> {r \<in> state_refs_of' s p. snd r \<noteq> NTFNBound})
-                              \<and> valid_queues s \<and> pspace_aligned' s \<and> pspace_distinct' s
+                              \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_canonical' s
                               \<and> sch_act_wf (ksSchedulerAction s) s \<and> valid_objs' s
-                              \<and> pspace_canonical' s"
+                              \<and> ksReadyQueues_head_end s \<and> ksReadyQueues_head_end_tcb_at' s"
                      and P'="\<lambda>xs. {s. ep_queue_relation' (cslift s) (xs @ list)
                                          (head_C (queue_' s)) (end_C (queue_' s))}
                                 \<inter> {s. thread_' s = (case list of [] \<Rightarrow> tcb_Ptr 0
@@ -941,8 +932,9 @@ lemma cancelBadgedSends_ccorres:
                    apply (rule_tac rrel=dc and xf=xfdc
                                and P="\<lambda>s. (\<forall>t \<in> set (x @ a # lista). tcb_at' t s)
                                           \<and> (\<forall>p. \<forall>t \<in> set (x @ a # lista). \<forall>rf. (t, rf) \<notin> {r \<in> state_refs_of' s p. snd r \<noteq> NTFNBound})
-                                          \<and> valid_queues s \<and> distinct (x @ a # lista)
-                                          \<and> pspace_aligned' s \<and> pspace_distinct' s"
+                                          \<and> distinct (x @ a # lista)
+                                          \<and> pspace_aligned' s \<and> pspace_distinct' s
+                                          \<and> ksReadyQueues_head_end s \<and> ksReadyQueues_head_end_tcb_at' s"
                               and P'="{s. ep_queue_relation' (cslift s) (x @ a # lista)
                                            (head_C (queue_' s)) (end_C (queue_' s))}"
                                in ccorres_from_vcg)
@@ -958,8 +950,7 @@ lemma cancelBadgedSends_ccorres:
                    apply (clarsimp simp: return_def rf_sr_def cstate_relation_def Let_def)
                    apply (rule conjI)
                     apply (clarsimp simp: cpspace_relation_def)
-                    apply (rule conjI, erule ctcb_relation_null_queue_ptrs)
-                     apply (rule null_ep_queue)
+                    apply (rule conjI, erule ctcb_relation_null_ep_ptrs)
                      subgoal by (simp add: o_def)
                     apply (rule conjI)
                      apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
@@ -982,9 +973,6 @@ lemma cancelBadgedSends_ccorres:
                     apply (clarsimp simp: image_iff)
                     apply (drule_tac x=p in spec)
                     subgoal by fastforce
-                   apply (rule conjI)
-                    apply (erule cready_queues_relation_not_queue_ptrs,
-                           auto dest: null_ep_schedD[unfolded o_def] simp: o_def)[1]
                    apply (clarsimp simp: carch_state_relation_def cmachine_state_relation_def)
                   apply (rule ccorres_symb_exec_r2)
                     apply (erule spec)
@@ -993,12 +981,11 @@ lemma cancelBadgedSends_ccorres:
                  apply wp
                 apply simp
                 apply vcg
-               apply (wp hoare_vcg_const_Ball_lift tcbSchedEnqueue_ep_at
-                         sch_act_wf_lift)
+               apply (wp hoare_vcg_const_Ball_lift sch_act_wf_lift)
               apply simp
               apply (vcg exspec=tcbSchedEnqueue_cslift_spec)
              apply (wp hoare_vcg_const_Ball_lift sts_st_tcb_at'_cases
-                       sts_sch_act sts_valid_queues setThreadState_oa_queued)
+                       sts_sch_act sts_valid_objs')
             apply (vcg exspec=setThreadState_cslift_spec)
            apply (simp add: ccorres_cond_iffs)
            apply (rule ccorres_symb_exec_r2)
@@ -1021,14 +1008,11 @@ lemma cancelBadgedSends_ccorres:
            apply (clarsimp simp: cscheduler_action_relation_def st_tcb_at'_def
                           split: scheduler_action.split_asm)
            apply (rename_tac word)
-           apply (frule_tac x=word in tcbSchedEnqueue_cslift_precond_discharge)
-              apply simp
-             subgoal by clarsimp
-            subgoal by clarsimp
+           apply (frule_tac x=word in tcbSchedEnqueue_cslift_precond_discharge; simp?)
            subgoal by clarsimp
           apply clarsimp
           apply (rule conjI)
-           apply (frule(3) tcbSchedEnqueue_cslift_precond_discharge)
+           apply (frule tcbSchedEnqueue_cslift_precond_discharge; simp?)
            subgoal by clarsimp
           apply clarsimp
           apply (rule context_conjI)
@@ -1068,9 +1052,19 @@ lemma cancelBadgedSends_ccorres:
    apply (clarsimp split: if_split)
    apply (drule sym_refsD, clarsimp)
    apply (drule(1) bspec)+
-   by (auto simp: obj_at'_def projectKOs state_refs_of'_def pred_tcb_at'_def tcb_bound_refs'_def
-              dest!: symreftype_inverse')
-
+   apply (frule ksReadyQueues_asrt_ksReadyQueues_head_end)
+   apply (frule invs_pspace_aligned')
+   apply (frule invs_pspace_distinct')
+   apply (frule (2) ksReadyQueues_asrt_ksReadyQueues_head_end_tcb_at')
+   apply (fastforce simp: obj_at'_def projectKOs state_refs_of'_def pred_tcb_at'_def
+                          tcb_bound_refs'_def
+                   dest!: symreftype_inverse')
+  apply (frule ksReadyQueues_asrt_ksReadyQueues_head_end)
+  apply (frule invs_pspace_aligned')
+  apply (frule invs_pspace_distinct')
+  apply (frule (2) ksReadyQueues_asrt_ksReadyQueues_head_end_tcb_at')
+  apply fastforce
+  done
 
 lemma tcb_ptr_to_ctcb_ptr_force_fold:
   "x + 2 ^ ctcb_size_bits = ptr_val (tcb_ptr_to_ctcb_ptr x)"
diff --git a/proof/crefine/AARCH64/Refine_C.thy b/proof/crefine/AARCH64/Refine_C.thy
index 5650fe6b15..22686e0565 100644
--- a/proof/crefine/AARCH64/Refine_C.thy
+++ b/proof/crefine/AARCH64/Refine_C.thy
@@ -90,7 +90,7 @@ proof -
          apply (rule allI, rule conseqPre, vcg)
          apply (clarsimp simp: return_def)
         apply (wp schedule_sch_act_wf schedule_invs'
-             | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+             | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
       apply simp
      apply vcg
     apply vcg
@@ -104,14 +104,12 @@ proof -
        apply (rule allI, rule conseqPre, vcg)
        apply (clarsimp simp: return_def)
       apply (wp schedule_sch_act_wf schedule_invs'
-             | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+             | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
    apply simp
    apply (rule_tac Q="\<lambda>rv s. invs' s \<and> (\<forall>x. rv = Some x \<longrightarrow> x \<le> AARCH64.maxIRQ) \<and> rv \<noteq> Some 0x3FF \<and>
-                             sch_act_not (ksCurThread s) s \<and>
-                             (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))" in hoare_post_imp)
+                             sch_act_not (ksCurThread s) s" in hoare_post_imp)
     apply (clarsimp simp: Kernel_C.maxIRQ_def AARCH64.maxIRQ_def)
    apply (wp getActiveIRQ_le_maxIRQ getActiveIRQ_neq_Some0xFF | simp)+
-  apply (clarsimp simp: ct_not_ksQ)
   apply (clarsimp simp: invs'_def valid_state'_def)
   done
 qed
@@ -137,14 +135,12 @@ lemma handleUnknownSyscall_ccorres:
          apply (rule allI, rule conseqPre, vcg)
         apply (clarsimp simp: return_def)
        apply (wp schedule_sch_act_wf schedule_invs'
-              | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+              | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
     apply (clarsimp, vcg)
    apply (clarsimp, rule conseqPre, vcg, clarsimp)
   apply clarsimp
   apply (intro impI conjI allI)
-      apply fastforce
-     apply (clarsimp simp: ct_not_ksQ)
-    apply (clarsimp simp add: sch_act_simple_def split: scheduler_action.split)
+    apply fastforce
    apply (rule active_ex_cap')
     apply (erule active_from_running')
    apply (erule invs_iflive')
@@ -195,13 +191,13 @@ lemma handleVMFaultEvent_ccorres:
        apply (rule allI, rule conseqPre, vcg)
        apply (clarsimp simp: return_def)
       apply (wp schedule_sch_act_wf schedule_invs'
-             | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+             | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
      apply (case_tac x, clarsimp, wp)
      apply (clarsimp, wp, simp)
     apply wp
    apply (simp add: guard_is_UNIV_def)
   apply (clarsimp simp: simple_sane_strg[unfolded sch_act_sane_not])
-  apply (auto simp: ct_in_state'_def cfault_rel_def is_cap_fault_def ct_not_ksQ
+  apply (auto simp: ct_in_state'_def cfault_rel_def is_cap_fault_def
               elim: pred_tcb'_weakenE st_tcb_ex_cap''
               dest: st_tcb_at_idle_thread' rf_sr_ksCurThread)
   done
@@ -227,16 +223,14 @@ lemma handleUserLevelFault_ccorres:
         apply (rule allI, rule conseqPre, vcg)
         apply (clarsimp simp: return_def)
        apply (wp schedule_sch_act_wf schedule_invs'
-              | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+              | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
     apply (clarsimp, vcg)
    apply (clarsimp, rule conseqPre, vcg, clarsimp)
   apply clarsimp
   apply (intro impI conjI allI)
-      apply (simp add: ct_in_state'_def)
-      apply (erule pred_tcb'_weakenE)
-      apply simp
-     apply (clarsimp simp: ct_not_ksQ)
-    apply (clarsimp simp add: sch_act_simple_def split: scheduler_action.split)
+    apply (simp add: ct_in_state'_def)
+    apply (erule pred_tcb'_weakenE)
+    apply simp
    apply (rule active_ex_cap')
     apply (erule active_from_running')
    apply (erule invs_iflive')
@@ -403,11 +397,10 @@ lemma handleSyscall_ccorres:
           apply wp[1]
          apply clarsimp
          apply wp
-         apply (rule_tac Q="\<lambda>rv s. ct_in_state' simple' s \<and> sch_act_sane s \<and>
-                            (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))"
+         apply (rule_tac Q="\<lambda>rv s. ct_in_state' simple' s \<and> sch_act_sane s"
                               in hoare_post_imp)
           apply (simp add: ct_in_state'_def)
-         apply (wp handleReply_sane handleReply_ct_not_ksQ)
+         apply (wp handleReply_sane)
         \<comment> \<open>SysYield\<close>
         apply (clarsimp simp: syscall_from_H_def syscall_defs)
         apply (rule ccorres_cond_empty |rule ccorres_cond_univ)+
@@ -433,14 +426,14 @@ lemma handleSyscall_ccorres:
        apply (rule_tac P=\<top> and P'=UNIV in ccorres_from_vcg_throws)
        apply (rule allI, rule conseqPre, vcg)
        apply (clarsimp simp: return_def)
-      apply (wp schedule_invs' schedule_sch_act_wf | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+      apply (wp schedule_invs' schedule_sch_act_wf
+             | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
      apply (wpsimp wp: hoare_vcg_if_lift3)
       apply (strengthen non_kernel_IRQs_strg[where Q=True, simplified])
       apply (wpsimp wp: hoare_drop_imps)
      apply (simp
           | wpc
           | wp hoare_drop_imp handleReply_sane handleReply_nonz_cap_to_ct schedule_invs'
-               handleReply_ct_not_ksQ[simplified]
           | strengthen ct_active_not_idle'_strengthen invs_valid_objs_strengthen)+
       apply (rule_tac  Q="\<lambda>rv. invs' and ct_active'" in hoare_post_imp, simp)
       apply (wp hy_invs')
@@ -458,7 +451,7 @@ lemma handleSyscall_ccorres:
   apply (frule active_ex_cap')
    apply (clarsimp simp: invs'_def valid_state'_def)
   apply (clarsimp simp: simple_sane_strg ct_in_state'_def st_tcb_at'_def obj_at'_def
-                        isReply_def ct_not_ksQ irqInvalid_def irqInvalid_def)
+                        isReply_def irqInvalid_def)
   apply (auto simp: syscall_from_H_def Kernel_C.SysSend_def mask_def
               split: option.split_asm)
   done
@@ -552,23 +545,20 @@ lemma handleUserLevelFault_ccorres':
         apply (rule allI, rule conseqPre, vcg)
         apply (clarsimp simp: return_def)
        apply (wp schedule_sch_act_wf schedule_invs'
-              | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+              | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
     apply (clarsimp, vcg)
    apply (clarsimp, rule conseqPre, vcg, clarsimp)
   apply clarsimp
   apply (intro impI conjI allI)
-      apply (simp add: ct_in_state'_def)
-      apply (erule pred_tcb'_weakenE)
-      apply simp
-     apply (clarsimp simp: ct_not_ksQ)
-    apply (clarsimp simp add: sch_act_simple_def split: scheduler_action.split)
+    apply (simp add: ct_in_state'_def)
+    apply (erule pred_tcb'_weakenE)
+    apply simp
    apply (rule active_ex_cap')
     apply (erule active_from_running')
    apply (erule invs_iflive')
   apply (clarsimp simp: ct_in_state'_def)
   apply (frule st_tcb_idle'[rotated])
    apply (erule invs_valid_idle')
-   apply simp
   apply (clarsimp simp: cfault_rel_def seL4_Fault_UserException_lift)
   apply (simp add: is_cap_fault_def)
   done
@@ -770,12 +760,13 @@ lemma handleVCPUFault_ccorres:
           apply (ctac (no_vcg) add: activateThread_ccorres)
          apply (clarsimp, assumption)
         apply assumption
-       apply (wp schedule_sch_act_wf schedule_invs'|strengthen invs_queues invs_valid_objs')+
+       apply (wp schedule_sch_act_wf schedule_invs'
+              | strengthen invs_valid_objs' invs_pspace_aligned' invs_pspace_distinct')+
      apply vcg
     apply (clarsimp, rule conseqPre, vcg)
     apply clarsimp
    apply wpsimp
-  apply (clarsimp simp: ct_not_ksQ ct_running_imp_simple' ucast_and_mask_drop)
+  apply (clarsimp simp: ct_running_imp_simple' ucast_and_mask_drop)
   apply (clarsimp simp: cfault_rel_def seL4_Fault_VCPUFault_lift is_cap_fault_def)
   apply (subst (asm) up_ucast_inj_eq[symmetric, where 'b=machine_word_len]; simp)
   apply (rule active_ex_cap', erule active_from_running', fastforce)
@@ -903,6 +894,7 @@ lemma callKernel_withFastpath_corres_C:
   apply (clarsimp simp: typ_heap_simps' ct_in_state'_def
                         "StrictC'_register_defs" word_sle_def word_sless_def
                         st_tcb_at'_opeq_simp)
+  apply (frule ready_qs_runnable_cross, (fastforce simp: valid_sched_def)+)
   apply (rule conjI, fastforce simp: st_tcb_at'_def)
   apply (auto elim!: pred_tcb'_weakenE cnode_caps_gsCNodes_from_sr[rotated])
   done
@@ -927,7 +919,7 @@ lemma threadSet_all_invs_triv':
     apply (wp thread_set_invs_trivial thread_set_ct_running thread_set_not_state_valid_sched
               threadSet_invs_trivial threadSet_ct_running' hoare_weak_lift_imp
               thread_set_ct_in_state
-           | simp add: tcb_cap_cases_def tcb_arch_ref_def
+           | simp add: tcb_cap_cases_def tcb_arch_ref_def exst_same_def
            | rule threadSet_ct_in_state'
            | wp (once) hoare_vcg_disj_lift)+
   apply clarsimp
@@ -1145,17 +1137,22 @@ lemma dmo_domain_user_mem'[wp]:
   done
 
 lemma do_user_op_corres_C:
-  "corres_underlying rf_sr False False (=) (invs' and ex_abs einvs) \<top>
-                     (doUserOp f tc) (doUserOp_C f tc)"
+  "corres_underlying rf_sr False False (=)
+     (invs' and ksReadyQueues_asrt and ex_abs einvs) \<top>
+     (doUserOp f tc) (doUserOp_C f tc)"
   apply (simp only: doUserOp_C_def doUserOp_def split_def)
   apply (rule corres_guard_imp)
     apply (rule_tac P=\<top> and P'=\<top> and r'="(=)" in corres_split)
        apply (clarsimp simp: simpler_gets_def getCurThread_def
                 corres_underlying_def rf_sr_def cstate_relation_def Let_def)
-      apply (rule_tac P=valid_state' and P'=\<top> and r'="(=)" in corres_split)
+      apply (rule_tac P="valid_state' and ksReadyQueues_asrt"
+                  and P'=\<top> and r'="(=)"
+                   in corres_split)
          apply (clarsimp simp: cstate_to_A_def absKState_def
                                rf_sr_def cstate_to_H_correct ptable_lift_def)
-        apply (rule_tac P=valid_state' and P'=\<top> and r'="(=)" in corres_split)
+        apply (rule_tac P="valid_state' and ksReadyQueues_asrt"
+                    and P'=\<top> and r'="(=)"
+                     in corres_split)
            apply (clarsimp simp: cstate_to_A_def absKState_def
                                  rf_sr_def cstate_to_H_correct ptable_rights_def)
           apply (rule_tac P=pspace_distinct' and P'=\<top> and r'="(=)"
@@ -1253,6 +1250,9 @@ lemma refinement2_both:
     apply (subst cstate_to_H_correct)
      apply (fastforce simp: full_invs'_def invs'_def)
     apply (clarsimp simp: rf_sr_def)
+    apply (clarsimp simp: lift_state_relation_def full_invs_def)
+    apply (rule ksReadyQueues_asrt_cross)
+    apply (erule state_relation_ready_queues_relation)
    apply (simp add:absKState_def observable_memory_def absExst_def)
    apply (rule MachineTypes.machine_state.equality,simp_all)[1]
    apply (rule ext)
@@ -1279,13 +1279,35 @@ lemma refinement2_both:
    apply (clarsimp simp add: do_user_op_C_def do_user_op_H_def monad_to_transition_def)
    apply (rule rev_mp, rule_tac f="uop" and tc=af in do_user_op_corres_C)
    apply (clarsimp simp: corres_underlying_def invs_def ex_abs_def)
-   apply (fastforce simp: full_invs'_def ex_abs_def)
+   apply (drule bspec)
+    apply fastforce
+   apply clarsimp
+   apply (elim impE)
+    apply (clarsimp simp: full_invs'_def ex_abs_def)
+    apply (intro conjI)
+     apply (rule ksReadyQueues_asrt_cross)
+     apply (erule state_relation_ready_queues_relation)
+    apply (clarsimp simp: lift_state_relation_def full_invs_def)
+    apply (frule state_relation_ready_queues_relation)
+    apply (fastforce simp: ready_queues_relation_def Let_def tcbQueueEmpty_def)
+   apply fastforce
 
   apply (erule_tac P="a \<and> b \<and> c \<and> (\<exists>x. e x)" for a b c d e in disjE)
    apply (clarsimp simp add: do_user_op_C_def do_user_op_H_def monad_to_transition_def)
    apply (rule rev_mp, rule_tac f="uop" and tc=af in do_user_op_corres_C)
    apply (clarsimp simp: corres_underlying_def invs_def ex_abs_def)
-   apply (fastforce simp: full_invs'_def ex_abs_def)
+   apply (drule bspec)
+    apply fastforce
+   apply clarsimp
+   apply (elim impE)
+    apply (clarsimp simp: full_invs'_def ex_abs_def)
+    apply (intro conjI)
+     apply (rule ksReadyQueues_asrt_cross)
+     apply (erule state_relation_ready_queues_relation)
+    apply (clarsimp simp: lift_state_relation_def full_invs_def)
+    apply (frule state_relation_ready_queues_relation)
+    apply (fastforce simp: ready_queues_relation_def Let_def tcbQueueEmpty_def)
+   apply fastforce
 
   apply (clarsimp simp: check_active_irq_C_def check_active_irq_H_def)
   apply (rule rev_mp, rule check_active_irq_corres_C)
diff --git a/proof/crefine/AARCH64/Retype_C.thy b/proof/crefine/AARCH64/Retype_C.thy
index 113b78b271..c87b58ccef 100644
--- a/proof/crefine/AARCH64/Retype_C.thy
+++ b/proof/crefine/AARCH64/Retype_C.thy
@@ -3116,7 +3116,6 @@ lemma cnc_tcb_helper:
   assumes rfsr: "(\<sigma>\<lparr>ksPSpace := ks\<rparr>, x) \<in> rf_sr"
   assumes al: "is_aligned (ctcb_ptr_to_tcb_ptr p) (objBitsKO kotcb)"
   assumes ptr0: "ctcb_ptr_to_tcb_ptr p \<noteq> 0"
-  assumes vq: "valid_queues \<sigma>"
   assumes pal: "pspace_aligned' (\<sigma>\<lparr>ksPSpace := ks\<rparr>)"
   assumes pno: "pspace_no_overlap' (ctcb_ptr_to_tcb_ptr p) (objBitsKO kotcb) (\<sigma>\<lparr>ksPSpace := ks\<rparr>)"
   assumes pds: "pspace_distinct' (\<sigma>\<lparr>ksPSpace := ks\<rparr>)"
@@ -3486,21 +3485,21 @@ proof -
     unfolding ctcb_relation_def makeObject_tcb heap_updates_defs initContext_registers_def
     apply (simp add: fbtcb minBound_word)
     apply (intro conjI)
-        apply (simp add: cthread_state_relation_def thread_state_lift_def
-                         eval_nat_numeral ThreadState_defs)
-       apply (clarsimp simp: ccontext_relation_def newContext_def2 carch_tcb_relation_def
-                             newArchTCB_def fpu_relation_def cregs_relation_def atcbContextGet_def
-                             index_foldr_update)
-       apply (case_tac r; simp add: C_register_defs index_foldr_update
-                                    atcbContext_def newArchTCB_def newContext_def
-                                    initContext_def)
-       apply clarsimp
-      apply (simp add: thread_state_lift_def index_foldr_update atcbContextGet_def)
-     apply (simp add: Kernel_Config.timeSlice_def)
-    apply (simp add: cfault_rel_def seL4_Fault_lift_def seL4_Fault_get_tag_def Let_def
-                     lookup_fault_lift_def lookup_fault_get_tag_def lookup_fault_invalid_root_def
-                     index_foldr_update seL4_Fault_NullFault_def option_to_ptr_def option_to_0_def
-              split: if_split)+
+         apply (simp add: cthread_state_relation_def thread_state_lift_def
+                          eval_nat_numeral ThreadState_defs)
+        apply (clarsimp simp: ccontext_relation_def newContext_def2 carch_tcb_relation_def
+                              newArchTCB_def fpu_relation_def cregs_relation_def atcbContextGet_def
+                              index_foldr_update)
+        apply (case_tac r; simp add: C_register_defs index_foldr_update
+                                     atcbContext_def newArchTCB_def newContext_def
+                                     initContext_def)
+       apply (simp add: thread_state_lift_def index_foldr_update atcbContextGet_def)
+      apply (simp add: Kernel_Config.timeSlice_def)
+     apply (simp add: cfault_rel_def seL4_Fault_lift_def seL4_Fault_get_tag_def Let_def
+                      lookup_fault_lift_def lookup_fault_get_tag_def lookup_fault_invalid_root_def
+                      index_foldr_update seL4_Fault_NullFault_def option_to_ptr_def option_to_0_def
+               split: if_split)+
+    apply (simp add: option_to_ctcb_ptr_def)
     done
 
   have pks: "ks (ctcb_ptr_to_tcb_ptr p) = None"
@@ -3551,15 +3550,6 @@ proof -
     apply (fastforce simp: dom_def)
     done
 
-  hence kstcb: "\<And>qdom prio. ctcb_ptr_to_tcb_ptr p \<notin> set (ksReadyQueues \<sigma> (qdom, prio))" using vq
-    apply (clarsimp simp add: valid_queues_def valid_queues_no_bitmap_def)
-    apply (drule_tac x = qdom in spec)
-    apply (drule_tac x = prio in spec)
-    apply clarsimp
-    apply (drule (1) bspec)
-    apply (simp add: obj_at'_def)
-    done
-
   have ball_subsetE:
     "\<And>P S R. \<lbrakk> \<forall>x \<in> S. P x; R \<subseteq> S \<rbrakk> \<Longrightarrow> \<forall>x \<in> R. P x"
     by blast
@@ -3701,7 +3691,7 @@ proof -
     apply (simp add: cl_cte [simplified] cl_tcb [simplified] cl_rest [simplified] tag_disj_via_td_name)
     apply (clarsimp simp: cready_queues_relation_def Let_def
                           htd_safe[simplified] kernel_data_refs_domain_eq_rotate)
-    apply (simp add: heap_updates_def kstcb tcb_queue_update_other' hrs_htd_update
+    apply (simp add: heap_updates_def tcb_queue_update_other' hrs_htd_update
                      ptr_retyp_to_array[simplified] irq[simplified])
     done
 qed
@@ -4696,7 +4686,8 @@ lemma Arch_initContext_spec':
 
 lemma ccorres_placeNewObject_tcb:
   "ccorresG rf_sr \<Gamma> dc xfdc
-   (pspace_aligned' and pspace_distinct' and pspace_no_overlap' regionBase tcbBlockSizeBits and valid_queues and (\<lambda>s. sym_refs (state_refs_of' s))
+   (pspace_aligned' and pspace_distinct' and pspace_no_overlap' regionBase tcbBlockSizeBits
+      and (\<lambda>s. sym_refs (state_refs_of' s))
       and (\<lambda>s. 2 ^ tcbBlockSizeBits \<le> gsMaxObjectSize s)
       and ret_zero regionBase (2 ^ tcbBlockSizeBits)
       and K (regionBase \<noteq> 0 \<and> range_cover regionBase tcbBlockSizeBits tcbBlockSizeBits 1
@@ -5014,7 +5005,7 @@ qed
 lemma placeNewObject_user_data:
   "ccorresG rf_sr \<Gamma> dc xfdc
   (pspace_aligned' and pspace_distinct' and pspace_no_overlap' regionBase (pageBits+us)
-  and valid_queues and valid_machine_state'
+  and valid_machine_state'
   and ret_zero regionBase (2 ^ (pageBits+us))
   and (\<lambda>s. sym_refs (state_refs_of' s))
   and (\<lambda>s. 2^(pageBits +  us) \<le> gsMaxObjectSize s)
@@ -5153,7 +5144,7 @@ lemma placeNewObject_user_data_device:
   "ccorresG rf_sr \<Gamma> dc xfdc
   (pspace_aligned' and pspace_distinct'
     and ret_zero regionBase (2 ^ (pageBits + us))
-    and pspace_no_overlap' regionBase (pageBits+us) and valid_queues
+    and pspace_no_overlap' regionBase (pageBits+us)
     and (\<lambda>s. sym_refs (state_refs_of' s))
     and (\<lambda>s. 2^(pageBits +  us) \<le> gsMaxObjectSize s)
     and K (regionBase \<noteq> 0 \<and> range_cover regionBase (pageBits + us) (pageBits+us) (Suc 0)
@@ -5922,7 +5913,7 @@ subgoal
     apply clarify
     apply (intro conjI)
      apply (clarsimp simp: invs_pspace_aligned' invs_pspace_distinct' invs_valid_global'
-                           APIType_capBits_def invs_queues invs_valid_objs'
+                           APIType_capBits_def invs_valid_objs'
                            invs_urz)
     apply clarsimp
     apply (clarsimp simp: ccap_relation_def APIType_capBits_def
@@ -6018,7 +6009,7 @@ subgoal
     apply clarify
     apply (intro conjI)
      apply (clarsimp simp: invs_pspace_aligned' invs_pspace_distinct' invs_valid_global'
-                           APIType_capBits_def invs_queues invs_valid_objs'
+                           APIType_capBits_def invs_valid_objs'
                            invs_urz bit_simps)
     apply clarsimp
     apply (clarsimp simp: bit_simps ccap_relation_def APIType_capBits_def
@@ -6111,15 +6102,11 @@ lemma threadSet_domain_ccorres [corres]:
   apply (simp add: map_to_ctes_upd_tcb_no_ctes map_to_tcbs_upd tcb_cte_cases_def cteSizeBits_def)
   apply (simp add: cep_relations_drop_fun_upd
                    cvariable_relation_upd_const ko_at_projectKO_opt)
-  apply (rule conjI)
-   apply (drule ko_at_projectKO_opt)
-   apply (erule (2) cmap_relation_upd_relI)
-     subgoal by (simp add: ctcb_relation_def)
-    apply assumption
-   apply simp
-  apply (erule cready_queues_relation_not_queue_ptrs)
-   apply (rule ext, simp split: if_split)
-  apply (rule ext, simp split: if_split)
+  apply (drule ko_at_projectKO_opt)
+  apply (erule (2) cmap_relation_upd_relI)
+    subgoal by (simp add: ctcb_relation_def)
+   apply assumption
+  apply simp
   done
 
 lemma createObject_ccorres:
@@ -6247,7 +6234,6 @@ proof -
                                createObject_c_preconds_def)
          apply (frule invs_pspace_aligned')
          apply (frule invs_pspace_distinct')
-         apply (frule invs_queues)
          apply (frule invs_sym')
          apply (simp add: getObjectSize_def objBits_simps word_bits_conv
                           apiGetObjectSize_def
@@ -6292,7 +6278,6 @@ proof -
         apply (clarsimp simp: createObject_hs_preconds_def isFrameType_def)
         apply (frule invs_pspace_aligned')
         apply (frule invs_pspace_distinct')
-        apply (frule invs_queues)
         apply (frule invs_sym')
         apply (auto simp: getObjectSize_def objBits_simps apiGetObjectSize_def
                           epSizeBits_def word_bits_conv
@@ -6330,7 +6315,6 @@ proof -
        apply (clarsimp simp: createObject_hs_preconds_def isFrameType_def)
        apply (frule invs_pspace_aligned')
        apply (frule invs_pspace_distinct')
-       apply (frule invs_queues)
        apply (frule invs_sym')
        apply (auto simp: getObjectSize_def objBits_simps
                    apiGetObjectSize_def
@@ -6371,7 +6355,6 @@ proof -
        apply (clarsimp simp: createObject_hs_preconds_def isFrameType_def)
        apply (frule invs_pspace_aligned')
        apply (frule invs_pspace_distinct')
-       apply (frule invs_queues)
        apply (frule invs_sym')
        apply (frule(1) ghost_assertion_size_logic_no_unat)
        apply (clarsimp simp: getObjectSize_def objBits_simps
diff --git a/proof/crefine/AARCH64/SR_lemmas_C.thy b/proof/crefine/AARCH64/SR_lemmas_C.thy
index 98ce847f26..6dabdabd1a 100644
--- a/proof/crefine/AARCH64/SR_lemmas_C.thy
+++ b/proof/crefine/AARCH64/SR_lemmas_C.thy
@@ -411,11 +411,15 @@ lemma cmdbnode_relation_mdb_node_to_H [simp]:
   unfolding cmdbnode_relation_def mdb_node_to_H_def mdb_node_lift_def cte_lift_def
   by (fastforce split: option.splits)
 
-definition
-  tcb_no_ctes_proj :: "tcb \<Rightarrow> Structures_H.thread_state \<times> machine_word \<times> machine_word \<times> arch_tcb \<times> bool \<times> word8 \<times> word8 \<times> word8 \<times> nat \<times> fault option \<times> machine_word option"
+definition tcb_no_ctes_proj ::
+  "tcb \<Rightarrow> Structures_H.thread_state \<times> machine_word \<times> machine_word \<times> arch_tcb \<times> bool \<times> word8
+          \<times> word8 \<times> word8 \<times> nat \<times> fault option \<times> machine_word option
+          \<times> machine_word option \<times> machine_word option"
   where
-  "tcb_no_ctes_proj t \<equiv> (tcbState t, tcbFaultHandler t, tcbIPCBuffer t, tcbArch t, tcbQueued t,
-                            tcbMCP t, tcbPriority t, tcbDomain t, tcbTimeSlice t, tcbFault t, tcbBoundNotification t)"
+  "tcb_no_ctes_proj t \<equiv>
+     (tcbState t, tcbFaultHandler t, tcbIPCBuffer t, tcbArch t, tcbQueued t,
+      tcbMCP t, tcbPriority t, tcbDomain t, tcbTimeSlice t, tcbFault t, tcbBoundNotification t,
+      tcbSchedNext t, tcbSchedPrev t)"
 
 lemma tcb_cte_cases_proj_eq [simp]:
   "tcb_cte_cases p = Some (getF, setF) \<Longrightarrow>
@@ -1551,9 +1555,9 @@ lemma cmap_relation_cong:
    apply (erule imageI)
    done
 
-lemma ctcb_relation_null_queue_ptrs:
+lemma ctcb_relation_null_ep_ptrs:
   assumes rel: "cmap_relation mp mp' tcb_ptr_to_ctcb_ptr ctcb_relation"
-  and same: "map_option tcb_null_queue_ptrs \<circ> mp'' = map_option tcb_null_queue_ptrs \<circ> mp'"
+  and same: "map_option tcb_null_ep_ptrs \<circ> mp'' = map_option tcb_null_ep_ptrs \<circ> mp'"
   shows "cmap_relation mp mp'' tcb_ptr_to_ctcb_ptr ctcb_relation"
   using rel
   apply (rule iffD1 [OF cmap_relation_cong, OF _ map_option_eq_dom_eq, rotated -1])
@@ -1561,7 +1565,7 @@ lemma ctcb_relation_null_queue_ptrs:
    apply (rule same [symmetric])
   apply (drule compD [OF same])
   apply (case_tac b, case_tac b')
-  apply (simp add: ctcb_relation_def tcb_null_queue_ptrs_def)
+  apply (simp add: ctcb_relation_def tcb_null_ep_ptrs_def)
   done
 
 lemma map_to_ctes_upd_tcb_no_ctes:
@@ -2409,6 +2413,14 @@ lemma capTCBPtr_eq:
   apply clarsimp
   done
 
+lemma rf_sr_ctcb_queue_relation:
+  "\<lbrakk> (s, s') \<in> rf_sr; d \<le> maxDomain; p \<le> maxPriority \<rbrakk>
+  \<Longrightarrow> ctcb_queue_relation (ksReadyQueues s (d, p))
+                          (index (ksReadyQueues_' (globals s')) (cready_queues_index_to_C d p))"
+  unfolding rf_sr_def cstate_relation_def cready_queues_relation_def
+  apply (clarsimp simp: Let_def seL4_MinPrio_def minDom_def maxDom_to_H maxPrio_to_H)
+  done
+
 lemma rf_sr_sched_action_relation:
   "(s, s') \<in> rf_sr
    \<Longrightarrow> cscheduler_action_relation (ksSchedulerAction s) (ksSchedulerAction_' (globals s'))"
@@ -2526,5 +2538,11 @@ lemma physBase_spec:
   apply (simp add: Kernel_Config.physBase_def)
   done
 
+lemma rf_sr_obj_update_helper:
+  "(s, s'\<lparr> globals := globals s' \<lparr> t_hrs_' := t_hrs_' (globals (undefined
+              \<lparr> globals := (undefined \<lparr> t_hrs_' := f (globals s') (t_hrs_' (globals s')) \<rparr>)\<rparr>))\<rparr>\<rparr>) \<in> rf_sr
+          \<Longrightarrow> (s, globals_update (\<lambda>v. t_hrs_'_update (f v) v) s') \<in> rf_sr"
+  by (simp cong: StateSpace.state.fold_congs globals.fold_congs)
+
 end
 end
diff --git a/proof/crefine/AARCH64/Schedule_C.thy b/proof/crefine/AARCH64/Schedule_C.thy
index cad3f5a57b..4f4e7cb8e2 100644
--- a/proof/crefine/AARCH64/Schedule_C.thy
+++ b/proof/crefine/AARCH64/Schedule_C.thy
@@ -7,7 +7,7 @@
  *)
 
 theory Schedule_C
-imports Tcb_C
+imports Tcb_C Detype_C
 begin
 
 instance tcb              :: no_vcpu by intro_classes auto
@@ -56,15 +56,17 @@ lemma switchToIdleThread_ccorres:
   "ccorres dc xfdc invs_no_cicd' UNIV hs
            switchToIdleThread (Call switchToIdleThread_'proc)"
   apply (cinit)
+   apply (rule ccorres_stateAssert)
    apply (rule ccorres_symb_exec_l)
       apply (ctac (no_vcg) add: Arch_switchToIdleThread_ccorres)
        apply (simp add: setCurThread_def)
+       apply (rule ccorres_stateAssert)
        apply (rule_tac P="\<lambda>s. thread = ksIdleThread s" and P'=UNIV in ccorres_from_vcg)
        apply (rule allI, rule conseqPre, vcg)
        apply (clarsimp simp: simpler_modify_def)
        apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
                              carch_state_relation_def cmachine_state_relation_def)
-      apply (wpsimp simp: AARCH64_H.switchToIdleThread_def)+
+      apply (wpsimp simp: AARCH64_H.switchToIdleThread_def wp: hoare_drop_imps)+
   done
 
 crunches vcpuSwitch
@@ -100,6 +102,26 @@ lemma Arch_switchToThread_ccorres:
   apply (clarsimp simp: typ_heap_simps ctcb_relation_def carch_tcb_relation_def)
   done
 
+lemma invs_no_cicd'_pspace_aligned':
+  "all_invs_but_ct_idle_or_in_cur_domain' s \<Longrightarrow> pspace_aligned' s"
+  by (simp add: all_invs_but_ct_idle_or_in_cur_domain'_def valid_pspace'_def)
+
+lemma invs_no_cicd'_pspace_distinct':
+  "all_invs_but_ct_idle_or_in_cur_domain' s \<Longrightarrow> pspace_distinct' s"
+  by (simp add: all_invs_but_ct_idle_or_in_cur_domain'_def valid_pspace'_def)
+
+lemma threadGet_exs_valid[wp]:
+  "tcb_at' t s \<Longrightarrow> \<lbrace>(=) s\<rbrace> threadGet f t \<exists>\<lbrace>\<lambda>r. (=) s\<rbrace>"
+  unfolding threadGet_def liftM_def
+  apply (wpsimp wp: exs_getObject)
+    apply (fastforce simp: obj_at'_def objBits_simps')+
+  done
+
+lemma isRunnable_exs_valid[wp]:
+  "tcb_at' t s \<Longrightarrow> \<lbrace>(=) s\<rbrace> isRunnable t \<exists>\<lbrace>\<lambda>r. (=) s\<rbrace>"
+  unfolding isRunnable_def getThreadState_def
+  by (wpsimp wp: exs_getObject)
+
 (* FIXME: move *)
 lemma switchToThread_ccorres:
   "ccorres dc xfdc
@@ -108,23 +130,28 @@ lemma switchToThread_ccorres:
            hs
            (switchToThread t)
            (Call switchToThread_'proc)"
-  apply (cinit lift: thread_')
+  apply (clarsimp simp: switchToThread_def)
+  apply (rule ccorres_symb_exec_l'[OF _ _ isRunnable_sp]; (solves wpsimp)?)
+  apply (rule ccorres_symb_exec_l'[OF _ _ assert_sp]; (solves wpsimp)?)
+  apply (rule ccorres_stateAssert_fwd)+
+  apply (cinit' lift: thread_')
    apply (ctac (no_vcg) add: Arch_switchToThread_ccorres)
     apply (ctac (no_vcg) add: tcbSchedDequeue_ccorres)
+     apply (simp add: setCurThread_def)
+     apply (rule ccorres_stateAssert)
      apply (rule_tac P=\<top> and P'=UNIV in ccorres_from_vcg)
      apply clarsimp
      apply (rule conseqPre, vcg)
-     apply (clarsimp simp: setCurThread_def simpler_modify_def)
-     apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
-                           carch_state_relation_def cmachine_state_relation_def)
-    apply wp+
-  apply (clarsimp simp: all_invs_but_ct_idle_or_in_cur_domain'_def valid_state'_def)
+     apply (clarsimp simp: setCurThread_def simpler_modify_def rf_sr_def cstate_relation_def
+                           Let_def carch_state_relation_def cmachine_state_relation_def)
+    apply (wpsimp wp: Arch_switchToThread_invs_no_cicd' hoare_drop_imps
+           | strengthen invs_no_cicd'_pspace_aligned' invs_no_cicd'_pspace_distinct')+
   done
 
 lemma activateThread_ccorres:
   "ccorres dc xfdc
            (ct_in_state' activatable' and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)
-                   and valid_queues and valid_objs')
+            and valid_objs' and pspace_aligned' and pspace_distinct')
            UNIV []
            activateThread
            (Call activateThread_'proc)"
@@ -216,13 +243,42 @@ lemma switchToThread_ccorres':
 
 lemmas word_log2_max_word_word_size = word_log2_max[where 'a=machine_word_len, simplified word_size, simplified]
 
+lemma ccorres_pre_getQueue:
+  assumes cc: "\<And>queue. ccorres r xf (P queue) (P' queue) hs (f queue) c"
+  shows   "ccorres r xf (\<lambda>s. P (ksReadyQueues s (d, p)) s \<and> d \<le> maxDomain \<and> p \<le> maxPriority)
+                        {s'. \<forall>queue. (let cqueue = index (ksReadyQueues_' (globals s'))
+                                                         (cready_queues_index_to_C d p) in
+                                      ctcb_queue_relation queue cqueue) \<longrightarrow> s' \<in> P' queue}
+           hs (getQueue d p >>= (\<lambda>queue. f queue)) c"
+  apply (rule ccorres_guard_imp2)
+  apply (rule ccorres_symb_exec_l2)
+     defer
+     defer
+     apply (rule gq_sp)
+    defer
+    apply (rule ccorres_guard_imp)
+    apply (rule cc)
+     apply clarsimp
+     apply assumption
+    apply assumption
+   apply (clarsimp simp: getQueue_def gets_exs_valid)
+  apply clarsimp
+  apply (drule spec, erule mp)
+  apply (erule rf_sr_ctcb_queue_relation)
+   apply (simp add: maxDom_to_H maxPrio_to_H)+
+  done
+
 lemma chooseThread_ccorres:
-  "ccorres dc xfdc all_invs_but_ct_idle_or_in_cur_domain' UNIV [] chooseThread (Call chooseThread_'proc)"
+  "ccorres dc xfdc all_invs_but_ct_idle_or_in_cur_domain' UNIV []
+     chooseThread (Call chooseThread_'proc)"
 proof -
 
   note prio_and_dom_limit_helpers [simp]
   note ksReadyQueuesL2Bitmap_nonzeroI [simp]
   note Collect_const_mem [simp]
+
+  note prio_and_dom_limit_helpers[simp] word_sle_def[simp] maxDom_to_H[simp] maxPrio_to_H[simp]
+  note invert_prioToL1Index_c_simp[simp]
   (* when numDomains = 1, array bounds checks would become _ = 0 rather than _ < 1, changing the
      shape of the proof compared to when numDomains > 1 *)
   include no_less_1_simps
@@ -231,9 +287,22 @@ proof -
     "\<And>s. invs_no_cicd' s \<Longrightarrow> ksCurDomain s \<le> maxDomain"
     by (simp add: invs_no_cicd'_def)
 
+  have invs_no_cicd'_valid_bitmaps:
+    "\<And>s. invs_no_cicd' s \<Longrightarrow> valid_bitmaps s"
+    by (simp add: invs_no_cicd'_def)
+
+  have invs_no_cicd'_pspace_aligned':
+    "\<And>s. invs_no_cicd' s \<Longrightarrow> pspace_aligned' s"
+    by (simp add: invs_no_cicd'_def valid_pspace'_def)
+
+  have invs_no_cicd'_pspace_distinct':
+    "\<And>s. invs_no_cicd' s \<Longrightarrow> pspace_distinct' s"
+    by (simp add: invs_no_cicd'_def valid_pspace'_def)
+
   show ?thesis
     supply if_split[split del]
     apply (cinit)
+     apply (rule ccorres_stateAssert)+
      apply (simp add: numDomains_sge_1_simp)
      apply (rule_tac xf'=dom_' and r'="\<lambda>rv rv'. rv' = ucast rv" in ccorres_split_nothrow_novcg)
          apply (rule ccorres_from_vcg[where P=\<top> and P'=UNIV])
@@ -266,7 +335,7 @@ proof -
          apply (rule_tac P="curdom \<le> maxDomain" in ccorres_cross_over_guard_no_st)
          apply (rule_tac P="prio \<le> maxPriority" in ccorres_cross_over_guard_no_st)
          apply (rule ccorres_pre_getQueue)
-         apply (rule_tac P="queue \<noteq> []" in ccorres_cross_over_guard_no_st)
+         apply (rule_tac P="\<not> tcbQueueEmpty queue" in ccorres_cross_over_guard_no_st)
          apply (rule ccorres_symb_exec_l)
             apply (rule ccorres_assert)
             apply (rule ccorres_symb_exec_r)
@@ -281,37 +350,40 @@ proof -
              apply (rule conseqPre, vcg)
              apply (rule Collect_mono)
              apply clarsimp
-             apply (strengthen queue_in_range)
              apply assumption
             apply clarsimp
             apply (rule conseqPre, vcg)
             apply clarsimp
            apply (wp isRunnable_wp)+
        apply (clarsimp simp: Let_def guard_is_UNIV_def)
-       apply (drule invs_no_cicd'_queues)
-       apply (case_tac queue, simp)
-       apply (clarsimp simp: tcb_queue_relation'_def cready_queues_index_to_C_def numPriorities_def)
-       apply (clarsimp simp add: maxDom_to_H maxPrio_to_H
-                                 queue_in_range[where qdom=0, simplified, simplified maxPrio_to_H])
-       apply (clarsimp simp: le_maxDomain_eq_less_numDomains unat_trans_ucast_helper )
+       apply (rule conjI)
+        apply (clarsimp simp: le_maxDomain_eq_less_numDomains unat_trans_ucast_helper)
+       apply (intro conjI impI)
+        apply (clarsimp simp: cready_queues_index_to_C_def numPriorities_def ctcb_queue_relation_def
+                              tcbQueueEmpty_def option_to_ctcb_ptr_def)
+       apply (frule_tac qdom=curdom and prio=rv in cready_queues_index_to_C_in_range)
+        apply fastforce
+       apply (clarsimp simp: num_tcb_queues_def word_less_nat_alt cready_queues_index_to_C_def2)
       apply wpsimp
      apply (clarsimp simp: guard_is_UNIV_def le_maxDomain_eq_less_numDomains word_less_nat_alt
                            numDomains_less_numeric_explicit)
-    apply (frule invs_no_cicd'_queues)
+    apply clarsimp
     apply (frule invs_no_cicd'_max_CurDomain)
-    apply (frule invs_no_cicd'_queues)
-    apply (clarsimp simp: valid_queues_def lookupBitmapPriority_le_maxPriority)
+    apply (frule invs_no_cicd'_pspace_aligned')
+    apply (frule invs_no_cicd'_pspace_distinct')
+    apply (frule invs_no_cicd'_valid_bitmaps)
+    apply (frule valid_bitmaps_bitmapQ_no_L1_orphans)
+    apply (frule valid_bitmaps_valid_bitmapQ)
+    apply (clarsimp simp: ready_queue_relation_def ksReadyQueues_asrt_def cong: conj_cong)
     apply (intro conjI impI)
-       apply (fastforce dest: bitmapQ_from_bitmap_lookup simp: valid_bitmapQ_bitmapQ_simp)
-      apply (fastforce dest: lookupBitmapPriority_obj_at'
-                       simp: pred_conj_def obj_at'_def st_tcb_at'_def)
-     apply (fastforce dest: bitmapQ_from_bitmap_lookup simp: valid_bitmapQ_bitmapQ_simp)
-    apply (clarsimp simp: pred_conj_def obj_at'_def st_tcb_at'_def)
-    apply (clarsimp simp: not_less le_maxDomain_eq_less_numDomains)
-    apply (prop_tac "ksCurDomain s = 0")
-     using unsigned_eq_0_iff apply force
-    apply (cut_tac s=s in lookupBitmapPriority_obj_at'; simp?)
-    apply (clarsimp simp: pred_conj_def obj_at'_def st_tcb_at'_def)
+         apply (fastforce intro: lookupBitmapPriority_le_maxPriority)
+        apply (fastforce dest!: bitmapQ_from_bitmap_lookup valid_bitmapQ_bitmapQ_simp)
+       apply (fastforce dest!: lookupBitmapPriority_obj_at'
+                         simp: ready_queue_relation_def ksReadyQueues_asrt_def st_tcb_at'_def obj_at'_def)
+      apply (fastforce dest: lookupBitmapPriority_le_maxPriority)
+     apply (fastforce dest!: bitmapQ_from_bitmap_lookup valid_bitmapQ_bitmapQ_simp)
+    apply (fastforce dest!: lookupBitmapPriority_obj_at'
+                      simp: ready_queue_relation_def ksReadyQueues_asrt_def st_tcb_at'_def obj_at'_def)
     done
 qed
 
@@ -635,7 +707,7 @@ lemma schedule_ccorres:
           apply (wp (once) hoare_drop_imps)
            apply wp
           apply (strengthen strenghten_False_imp[where P="a = ResumeCurrentThread" for a])
-          apply (clarsimp simp: conj_ac invs_queues invs_valid_objs' cong: conj_cong)
+          apply (clarsimp simp: conj_ac invs_valid_objs' cong: conj_cong)
           apply wp
          apply (clarsimp, vcg exspec=tcbSchedEnqueue_modifies)
         apply (clarsimp, vcg exspec=tcbSchedEnqueue_modifies)
@@ -655,9 +727,11 @@ lemma schedule_ccorres:
     apply wp
    apply vcg
 
-  apply (clarsimp simp: tcb_at_invs' rf_sr_ksCurThread if_apply_def2 invs_queues invs_valid_objs')
+  apply (clarsimp simp: tcb_at_invs' rf_sr_ksCurThread if_apply_def2 invs_valid_objs')
   apply (frule invs_sch_act_wf')
   apply (frule tcb_at_invs')
+  apply (frule invs_pspace_aligned')
+  apply (frule invs_pspace_distinct')
   apply (rule conjI)
    apply (clarsimp dest!: rf_sr_cscheduler_relation simp: cscheduler_action_relation_def)
   apply (rule conjI; clarsimp)
@@ -707,11 +781,7 @@ lemma threadSet_timeSlice_ccorres [corres]:
 
   apply (simp add: cep_relations_drop_fun_upd cvariable_relation_upd_const
                    ko_at_projectKO_opt)
-  apply (rule conjI)
    defer
-   apply (erule cready_queues_relation_not_queue_ptrs)
-    apply (rule ext, simp split: if_split)
-   apply (rule ext, simp split: if_split)
   apply (drule ko_at_projectKO_opt)
   apply (erule (2) cmap_relation_upd_relI)
     apply (simp add: ctcb_relation_def)
@@ -755,7 +825,7 @@ lemma timerTick_ccorres:
                apply simp
                apply (ctac (no_vcg) add: tcbSchedAppend_ccorres)
                 apply (ctac add: rescheduleRequired_ccorres)
-               apply (wp weak_sch_act_wf_lift_linear threadSet_valid_queues
+               apply (wp weak_sch_act_wf_lift_linear
                          threadSet_pred_tcb_at_state tcbSchedAppend_valid_objs' threadSet_valid_objs' threadSet_tcbDomain_triv
                     | clarsimp simp: st_tcb_at'_def o_def split: if_splits)+
              apply (vcg exspec=tcbSchedDequeue_modifies)
@@ -806,8 +876,8 @@ lemma timerTick_ccorres:
    apply (rule conjI, clarsimp simp: invs'_def valid_state'_def valid_tcb'_def)+
     apply (auto simp: obj_at'_def inQ_def weak_sch_act_wf_def st_tcb_at'_def
                       valid_pspace'_def ct_idle_or_in_cur_domain'_def valid_tcb'_def valid_idle'_def projectKOs)[1]
-   apply (auto simp: invs'_def valid_state'_def valid_tcb'_def tcb_cte_cases_def
-                     cteSizeBits_def)[1]
+   apply (auto simp: invs'_def valid_state'_def valid_tcb'_def tcb_cte_cases_def cur_tcb'_def
+                     obj_at'_def cteSizeBits_def)[1]
 
   apply (frule invs_cur')
   apply (clarsimp simp: cur_tcb'_def)
diff --git a/proof/crefine/AARCH64/StateRelation_C.thy b/proof/crefine/AARCH64/StateRelation_C.thy
index 8dfbaef0fd..a92b71fda0 100644
--- a/proof/crefine/AARCH64/StateRelation_C.thy
+++ b/proof/crefine/AARCH64/StateRelation_C.thy
@@ -18,8 +18,7 @@ definition
 definition
   "array_relation r n a c \<equiv> \<forall>i \<le> n. r (a i) (index c (unat i))"
 
-(* used for bound ntfn/tcb *)
-definition
+definition option_to_ctcb_ptr :: "machine_word option \<Rightarrow> tcb_C ptr" where
   "option_to_ctcb_ptr x \<equiv> case x of None \<Rightarrow> NULL | Some t \<Rightarrow> tcb_ptr_to_ctcb_ptr t"
 
 
@@ -391,7 +390,9 @@ where
      \<and> tcbTimeSlice atcb    = unat (tcbTimeSlice_C ctcb)
      \<and> cfault_rel (tcbFault atcb) (seL4_Fault_lift (tcbFault_C ctcb))
                   (lookup_fault_lift (tcbLookupFailure_C ctcb))
-     \<and> option_to_ptr (tcbBoundNotification atcb) = tcbBoundNotification_C ctcb"
+     \<and> option_to_ptr (tcbBoundNotification atcb) = tcbBoundNotification_C ctcb
+     \<and> option_to_ctcb_ptr (tcbSchedPrev atcb) = tcbSchedPrev_C ctcb
+     \<and> option_to_ctcb_ptr (tcbSchedNext atcb) = tcbSchedNext_C ctcb"
 
 abbreviation
   "ep_queue_relation' \<equiv> tcb_queue_relation' tcbEPNext_C tcbEPPrev_C"
@@ -610,17 +611,17 @@ definition
 where
   "cready_queues_index_to_C qdom prio \<equiv> (unat qdom) * numPriorities + (unat prio)"
 
-definition cready_queues_relation ::
-  "tcb_C typ_heap \<Rightarrow> (tcb_queue_C[num_tcb_queues]) \<Rightarrow> (domain \<times> priority \<Rightarrow> ready_queue) \<Rightarrow> bool"
-where
-  "cready_queues_relation h_tcb queues aqueues \<equiv>
-     \<forall>qdom prio. ((qdom \<ge> ucast minDom \<and> qdom \<le> ucast maxDom \<and>
-                  prio \<ge> ucast minPrio \<and> prio \<le> ucast maxPrio) \<longrightarrow>
-       (let cqueue = index queues (cready_queues_index_to_C qdom prio) in
-            sched_queue_relation' h_tcb (aqueues (qdom, prio)) (head_C cqueue) (end_C cqueue)))
-        \<and> (\<not> (qdom \<ge> ucast minDom \<and> qdom \<le> ucast maxDom \<and>
-                  prio \<ge> ucast minPrio \<and> prio \<le> ucast maxPrio) \<longrightarrow> aqueues (qdom, prio) = [])"
+definition ctcb_queue_relation :: "tcb_queue \<Rightarrow> tcb_queue_C \<Rightarrow> bool" where
+   "ctcb_queue_relation aqueue cqueue \<equiv>
+      head_C cqueue = option_to_ctcb_ptr (tcbQueueHead aqueue)
+      \<and> end_C cqueue = option_to_ctcb_ptr (tcbQueueEnd aqueue)"
 
+definition cready_queues_relation ::
+  "(domain \<times> priority \<Rightarrow> ready_queue) \<Rightarrow> (tcb_queue_C[num_tcb_queues]) \<Rightarrow>  bool"
+  where
+  "cready_queues_relation aqueues cqueues \<equiv>
+     \<forall>d p. d \<le> maxDomain \<and> p \<le> maxPriority
+           \<longrightarrow> ctcb_queue_relation (aqueues (d, p)) (index cqueues (cready_queues_index_to_C d p))"
 
 abbreviation
   "cte_array_relation astate cstate
@@ -759,9 +760,7 @@ where
   "cstate_relation astate cstate \<equiv>
      let cheap = t_hrs_' cstate in
        cpspace_relation (ksPSpace astate) (underlying_memory (ksMachineState astate)) cheap \<and>
-       cready_queues_relation (clift cheap)
-                             (ksReadyQueues_' cstate)
-                             (ksReadyQueues astate) \<and>
+       cready_queues_relation (ksReadyQueues astate) (ksReadyQueues_' cstate) \<and>
        zero_ranges_are_zero (gsUntypedZeroRanges astate) cheap \<and>
        cbitmap_L1_relation (ksReadyQueuesL1Bitmap_' cstate) (ksReadyQueuesL1Bitmap astate) \<and>
        cbitmap_L2_relation (ksReadyQueuesL2Bitmap_' cstate) (ksReadyQueuesL2Bitmap astate) \<and>
diff --git a/proof/crefine/AARCH64/SyscallArgs_C.thy b/proof/crefine/AARCH64/SyscallArgs_C.thy
index 7a38327aa9..54b5b56b9d 100644
--- a/proof/crefine/AARCH64/SyscallArgs_C.thy
+++ b/proof/crefine/AARCH64/SyscallArgs_C.thy
@@ -49,9 +49,7 @@ lemma replyOnRestart_invs'[wp]:
   including no_pre
   apply (simp add: replyOnRestart_def)
   apply (wp setThreadState_nonqueued_state_update rfk_invs' hoare_weak_lift_imp)
-  apply (rule hoare_vcg_all_lift)
-  apply (wp setThreadState_nonqueued_state_update rfk_invs' hoare_vcg_all_lift rfk_ksQ)
-   apply (rule hoare_strengthen_post, rule gts_sp')
+  apply (rule hoare_strengthen_post, rule gts_sp')
   apply (clarsimp simp: pred_tcb_at')
   apply (auto elim!: pred_tcb'_weakenE st_tcb_ex_cap''
                dest: st_tcb_at_idle_thread')
diff --git a/proof/crefine/AARCH64/Syscall_C.thy b/proof/crefine/AARCH64/Syscall_C.thy
index 6e561786b8..f37a889251 100644
--- a/proof/crefine/AARCH64/Syscall_C.thy
+++ b/proof/crefine/AARCH64/Syscall_C.thy
@@ -50,8 +50,7 @@ lemma cap_cases_one_on_true_sum:
 lemma performInvocation_Endpoint_ccorres:
   "ccorres (K (K \<bottom>) \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
        (invs' and st_tcb_at' simple' thread and ep_at' epptr
-              and sch_act_sane and (\<lambda>s. thread = ksCurThread s
-              \<and> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))))
+              and sch_act_sane and (\<lambda>s. thread = ksCurThread s))
        (UNIV \<inter> {s. block_' s = from_bool blocking}
              \<inter> {s. call_' s = from_bool do_call}
              \<inter> {s. badge_' s = badge}
@@ -123,7 +122,6 @@ lemma decodeInvocation_ccorres:
               and (\<lambda>s. \<forall>v \<in> set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s)
               and (\<lambda>s. \<forall>v \<in> set extraCaps. s \<turnstile>' fst v \<and> cte_at' (snd v) s)
               and (\<lambda>s. \<forall>v \<in> set extraCaps. \<forall>y \<in> zobj_refs' (fst v). ex_nonz_cap_to' y s)
-              and (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))
               and sysargs_rel args buffer)
        (UNIV \<inter> {s. current_extra_caps_' (globals s) = extraCaps'}
              \<inter> {s. call_' s = from_bool isCall}
@@ -200,7 +198,7 @@ lemma decodeInvocation_ccorres:
       apply simp
       apply (rule hoare_use_eq[where f=ksCurThread])
        apply (wp sts_invs_minor' sts_st_tcb_at'_cases
-                 setThreadState_ct' hoare_vcg_all_lift sts_ksQ')+
+                 setThreadState_ct' hoare_vcg_all_lift)+
      apply simp
      apply (vcg exspec=setThreadState_modifies)
     apply vcg
@@ -507,7 +505,7 @@ lemma wordFromMessageInfo_spec:
 
 lemma handleDoubleFault_ccorres:
   "ccorres dc xfdc (invs' and  tcb_at' tptr and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and
-        sch_act_not tptr and (\<lambda>s. \<forall>p. tptr \<notin> set (ksReadyQueues s p)))
+        sch_act_not tptr)
       (UNIV \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr tptr})
       [] (handleDoubleFault tptr ex1 ex2)
          (Call handleDoubleFault_'proc)"
@@ -572,8 +570,7 @@ lemma hrs_mem_update_use_hrs_mem:
 
 lemma sendFaultIPC_ccorres:
   "ccorres  (cfault_rel2 \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
-      (invs' and st_tcb_at' simple' tptr and sch_act_not tptr and
-       (\<lambda>s. \<forall>p. tptr \<notin> set (ksReadyQueues s p)))
+      (invs' and st_tcb_at' simple' tptr and sch_act_not tptr)
       (UNIV \<inter> {s. (cfault_rel (Some fault) (seL4_Fault_lift(current_fault_' (globals s)))
                        (lookup_fault_lift(current_lookup_fault_' (globals s))))}
             \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr tptr})
@@ -651,8 +648,8 @@ lemma sendFaultIPC_ccorres:
               apply (ctac (no_vcg) add: sendIPC_ccorres)
                apply (ctac (no_vcg) add: ccorres_return_CE [unfolded returnOk_def comp_def])
               apply wp
-             apply (wp threadSet_pred_tcb_no_state threadSet_invs_trivial threadSet_typ_at_lifts
-                    | simp)+
+             apply (wpsimp wp: threadSet_invs_trivial)
+             apply (wpsimp wp: threadSet_pred_tcb_no_state threadSet_typ_at_lifts)
 
             apply (clarsimp simp: guard_is_UNIV_def)
             apply (subgoal_tac "capEPBadge epcap && mask 64 = capEPBadge epcap")
@@ -685,8 +682,7 @@ lemma sendFaultIPC_ccorres:
          apply vcg
         apply (clarsimp simp: inQ_def)
         apply (rule_tac Q="\<lambda>a b. invs' b \<and> st_tcb_at' simple' tptr b
-                                 \<and> sch_act_not tptr b \<and> valid_cap' a b
-                                 \<and> (\<forall>p. tptr \<notin> set (ksReadyQueues b p))"
+                                 \<and> sch_act_not tptr b \<and> valid_cap' a b"
                  and E="\<lambda> _. \<top>"
                  in hoare_post_impErr)
           apply (wp)
@@ -701,8 +697,7 @@ lemma sendFaultIPC_ccorres:
   done
 
 lemma handleFault_ccorres:
-  "ccorres dc xfdc (invs' and st_tcb_at' simple' t and
-        sch_act_not t and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p)))
+  "ccorres dc xfdc (invs' and st_tcb_at' simple' t and sch_act_not t)
       (UNIV \<inter> {s. (cfault_rel (Some flt) (seL4_Fault_lift(current_fault_' (globals s)))
                        (lookup_fault_lift(current_lookup_fault_' (globals s))) )}
             \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr t})
@@ -766,9 +761,7 @@ lemma getMRs_length:
 
 lemma handleInvocation_ccorres:
   "ccorres (K dc \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
-       (invs' and
-        ct_active' and sch_act_simple and
-        (\<lambda>s. \<forall>x. ksCurThread s \<notin> set (ksReadyQueues s x)))
+       (invs' and ct_active' and sch_act_simple)
        (UNIV \<inter> {s. isCall_' s = from_bool isCall}
              \<inter> {s. isBlocking_' s = from_bool isBlocking}) []
        (handleInvocation isCall isBlocking) (Call handleInvocation_'proc)"
@@ -896,7 +889,7 @@ lemma handleInvocation_ccorres:
                      apply (wp hoare_split_bind_case_sumE hoare_drop_imps
                                setThreadState_nonqueued_state_update
                                ct_in_state'_set setThreadState_st_tcb
-                               hoare_vcg_all_lift sts_ksQ'
+                               hoare_vcg_all_lift
                                  | wpc | wps)+
                     apply auto[1]
                    apply clarsimp
@@ -1155,9 +1148,6 @@ lemma ccorres_trim_redundant_throw_break:
 lemma invs_valid_objs_strengthen:
   "invs' s \<longrightarrow> valid_objs' s" by fastforce
 
-lemma ct_not_ksQ_strengthen:
-  "thread = ksCurThread s \<and> ksCurThread s \<notin> set (ksReadyQueues s p) \<longrightarrow> thread \<notin> set (ksReadyQueues s p)" by fastforce
-
 lemma option_to_ctcb_ptr_valid_ntfn:
   "valid_ntfn' ntfn s ==> (option_to_ctcb_ptr (ntfnBoundTCB ntfn) = NULL) = (ntfnBoundTCB ntfn = None)"
   apply (cases "ntfnBoundTCB ntfn", simp_all add: option_to_ctcb_ptr_def)
@@ -1191,8 +1181,7 @@ lemma handleRecv_ccorres:
   notes rf_sr_upd_safe[simp del]
   shows
   "ccorres dc xfdc
-       (\<lambda>s. invs' s \<and> st_tcb_at' simple' (ksCurThread s) s
-               \<and> sch_act_sane s \<and> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)))
+       (\<lambda>s. invs' s \<and> st_tcb_at' simple' (ksCurThread s) s \<and> sch_act_sane s)
        {s. isBlocking_' s = from_bool isBlocking}
        []
        (handleRecv isBlocking)
@@ -1256,7 +1245,7 @@ lemma handleRecv_ccorres:
             apply (rule_tac P="\<lambda>s. ksCurThread s = thread" in ccorres_cross_over_guard)
             apply (ctac add: receiveIPC_ccorres)
 
-           apply (wp deleteCallerCap_ksQ_ct' hoare_vcg_all_lift)
+           apply (wp hoare_vcg_all_lift)
           apply (rule conseqPost[where Q'=UNIV and A'="{}"], vcg exspec=deleteCallerCap_modifies)
            apply (clarsimp dest!: rf_sr_ksCurThread)
           apply simp
@@ -1379,13 +1368,11 @@ lemma handleRecv_ccorres:
       apply clarsimp
       apply (rename_tac thread epCPtr)
         apply (rule_tac Q'="(\<lambda>rv s. invs' s \<and> st_tcb_at' simple' thread s
-               \<and> sch_act_sane s \<and> (\<forall>p. thread \<notin> set (ksReadyQueues s p)) \<and> thread = ksCurThread s
+               \<and> sch_act_sane s \<and> thread = ksCurThread s
                \<and> valid_cap' rv s)" in hoare_post_imp_R[rotated])
-         apply (clarsimp simp: sch_act_sane_def)
-         apply (auto dest!: obj_at_valid_objs'[OF _ invs_valid_objs']
-                      simp: projectKOs valid_obj'_def,
-                auto simp: pred_tcb_at'_def obj_at'_def objBits_simps projectKOs ct_in_state'_def)[1]
-         apply wp
+       apply (intro conjI impI allI; clarsimp simp: sch_act_sane_def)
+       apply (fastforce dest: obj_at_valid_objs'[OF _ invs_valid_objs'] ko_at_valid_ntfn')
+      apply wp
      apply clarsimp
      apply (vcg exspec=isStopped_modifies exspec=lookupCap_modifies)
 
@@ -1434,7 +1421,7 @@ lemma handleYield_ccorres:
        apply (ctac add: rescheduleRequired_ccorres)
       apply (wp weak_sch_act_wf_lift_linear tcbSchedAppend_valid_objs')
      apply (vcg exspec= tcbSchedAppend_modifies)
-    apply (wp weak_sch_act_wf_lift_linear tcbSchedDequeue_valid_queues)
+    apply (wp weak_sch_act_wf_lift_linear)
    apply (vcg exspec= tcbSchedDequeue_modifies)
   apply (clarsimp simp: tcb_at_invs' invs_valid_objs'
                         valid_objs'_maxPriority valid_objs'_maxDomain)
@@ -1699,8 +1686,7 @@ lemma ccorres_vgicMaintenance:
   notes virq_virq_pending_set_virqEOIIRQEN_spec = virq_virq_pending_set_virqEOIIRQEN_spec'
   shows
   "ccorres dc xfdc
-     (\<lambda>s. invs' s \<and> sch_act_not (ksCurThread s) s
-          \<and> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)))
+     (\<lambda>s. invs' s \<and> sch_act_not (ksCurThread s) s)
      UNIV hs
      vgicMaintenance (Call VGICMaintenance_'proc)"
   (is "ccorres _ _ ?PRE _ _ _ _")
@@ -2123,9 +2109,7 @@ lemma ccorres_VPPIEvent:
   notes Collect_const[simp del]
   shows
   "ccorres dc xfdc
-     (\<lambda>s. invs' s \<and> sch_act_not (ksCurThread s) s
-          \<and> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))
-          \<and> irqVPPIEventIndex irq \<noteq> None)
+     (\<lambda>s. invs' s \<and> sch_act_not (ksCurThread s) s \<and> irqVPPIEventIndex irq \<noteq> None)
      \<lbrace>\<acute>irq = ucast irq\<rbrace> hs
      (vppiEvent irq) (Call VPPIEvent_'proc)"
   (is "ccorres _ _ ?PRE _ _ _ _")
@@ -2206,8 +2190,7 @@ qed
 
 lemma ccorres_handleReservedIRQ:
   "ccorres dc xfdc
-    (invs' and (\<lambda>s. irq \<in> non_kernel_IRQs \<longrightarrow> sch_act_not (ksCurThread s) s \<and>
-                     (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))))
+    (invs' and (\<lambda>s. irq \<in> non_kernel_IRQs \<longrightarrow> sch_act_not (ksCurThread s) s))
     (UNIV \<inter> {s. irq_' s = ucast irq}) hs
     (handleReservedIRQ irq) (Call handleReservedIRQ_'proc)"
   supply Collect_const[simp del]
@@ -2245,8 +2228,7 @@ lemma ccorres_handleReservedIRQ:
 
 lemma handleInterrupt_ccorres:
   "ccorres dc xfdc
-     (invs' and (\<lambda>s. irq \<in> non_kernel_IRQs \<longrightarrow> sch_act_not (ksCurThread s) s \<and>
-                     (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))))
+     (invs' and (\<lambda>s. irq \<in> non_kernel_IRQs \<longrightarrow> sch_act_not (ksCurThread s) s))
      (UNIV \<inter> \<lbrace>\<acute>irq = ucast irq\<rbrace>)
      hs
      (handleInterrupt irq)
diff --git a/proof/crefine/AARCH64/TcbQueue_C.thy b/proof/crefine/AARCH64/TcbQueue_C.thy
index 46f1e3b25c..660712b7d7 100644
--- a/proof/crefine/AARCH64/TcbQueue_C.thy
+++ b/proof/crefine/AARCH64/TcbQueue_C.thy
@@ -947,48 +947,6 @@ lemma tcb_queue_relation'_prev_canonical:
    \<Longrightarrow> make_canonical (ptr_val (getPrev tcb)) = ptr_val (getPrev tcb)"
   by (rule tcb_queue_relation_prev_canonical [OF tcb_queue_relation'_queue_rel])
 
-lemma cready_queues_relation_null_queue_ptrs:
-  assumes rel: "cready_queues_relation mp cq aq"
-  and same: "option_map tcb_null_ep_ptrs \<circ> mp' = option_map tcb_null_ep_ptrs \<circ> mp"
-  shows "cready_queues_relation mp' cq aq"
-  using rel
-  apply (clarsimp simp: cready_queues_relation_def Let_def all_conj_distrib)
-  apply (drule spec, drule spec, drule mp, (erule conjI)+, assumption)
-  apply (clarsimp simp: tcb_queue_relation'_def)
-  apply (erule iffD2 [OF tcb_queue_relation_only_next_prev, rotated -1])
-   apply (rule ext)
-   apply (case_tac "mp' x")
-    apply (frule compD [OF same])
-    apply simp
-   apply (frule compD [OF same])
-   apply (clarsimp simp: tcb_null_ep_ptrs_def)
-   apply (case_tac z, case_tac a)
-   apply simp
-  \<comment> \<open>clag\<close>
-  apply (rule ext)
-  apply (case_tac "mp' x")
-   apply (frule compD [OF same])
-   apply simp
-  apply (frule compD [OF same])
-  apply (clarsimp simp: tcb_null_ep_ptrs_def)
-  apply (case_tac z, case_tac a)
-  apply simp
-  done
-
-lemma cready_queues_relation_not_queue_ptrs:
-  assumes rel: "cready_queues_relation mp cq aq"
-  and same: "option_map tcbSchedNext_C \<circ> mp' = option_map tcbSchedNext_C \<circ> mp"
-  "option_map tcbSchedPrev_C \<circ> mp' = option_map tcbSchedPrev_C \<circ> mp"
-  shows "cready_queues_relation mp' cq aq"
-  using rel
-  apply (clarsimp simp: cready_queues_relation_def tcb_queue_relation'_def Let_def all_conj_distrib)
-  apply (drule spec, drule spec, drule mp, (erule conjI)+, assumption)
-  apply clarsimp
-  apply (erule iffD2 [OF tcb_queue_relation_only_next_prev, rotated -1])
-   apply (rule same)
-  apply (rule same)
-  done
-
 lemma ntfn_ep_disjoint:
   assumes  srs: "sym_refs (state_refs_of' s)"
   and     epat: "ko_at' ep epptr s"
@@ -1355,8 +1313,6 @@ lemma rf_sr_tcb_update_no_queue:
                                           (t_hrs_' (globals s'));
      tcbEPNext_C ctcb = tcbEPNext_C (the (cslift s' (tcb_ptr_to_ctcb_ptr thread)));
      tcbEPPrev_C ctcb = tcbEPPrev_C (the (cslift s' (tcb_ptr_to_ctcb_ptr thread)));
-     tcbSchedNext_C ctcb = tcbSchedNext_C (the (cslift s' (tcb_ptr_to_ctcb_ptr thread)));
-     tcbSchedPrev_C ctcb = tcbSchedPrev_C (the (cslift s' (tcb_ptr_to_ctcb_ptr thread)));
      (\<forall>x\<in>ran tcb_cte_cases. (\<lambda>(getF, setF). getF tcb' = getF tcb) x);
      ctcb_relation tcb' ctcb
    \<rbrakk>
@@ -1371,31 +1327,22 @@ lemma rf_sr_tcb_update_no_queue:
   apply (clarsimp simp: map_comp_update projectKO_opt_tcb cvariable_relation_upd_const
                         typ_heap_simps')
   apply (intro conjI)
-       subgoal by (clarsimp simp: cmap_relation_def map_comp_update projectKO_opts_defs inj_eq)
-      apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-      apply simp
-      apply (rule cendpoint_relation_upd_tcb_no_queues, assumption+)
-       subgoal by fastforce
-      subgoal by fastforce
+      subgoal by (clarsimp simp: cmap_relation_def map_comp_update projectKO_opts_defs inj_eq)
      apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
      apply simp
-     apply (rule cnotification_relation_upd_tcb_no_queues, assumption+)
+     apply (rule cendpoint_relation_upd_tcb_no_queues, assumption+)
       subgoal by fastforce
      subgoal by fastforce
-    apply (erule cready_queues_relation_not_queue_ptrs)
+    apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+    apply simp
+    apply (rule cnotification_relation_upd_tcb_no_queues, assumption+)
      subgoal by fastforce
     subgoal by fastforce
    subgoal by (clarsimp simp: carch_state_relation_def typ_heap_simps')
   by (simp add: cmachine_state_relation_def)
 
-lemma rf_sr_tcb_update_no_queue_helper:
-  "(s, s'\<lparr> globals := globals s' \<lparr> t_hrs_' := t_hrs_' (globals (undefined
-              \<lparr> globals := (undefined \<lparr> t_hrs_' := f (globals s') (t_hrs_' (globals s')) \<rparr>)\<rparr>))\<rparr>\<rparr>) \<in> rf_sr
-          \<Longrightarrow> (s, globals_update (\<lambda>v. t_hrs_'_update (f v) v) s') \<in> rf_sr"
-  by (simp cong: StateSpace.state.fold_congs globals.fold_congs)
-
-lemmas rf_sr_tcb_update_no_queue2
-    = rf_sr_tcb_update_no_queue_helper [OF rf_sr_tcb_update_no_queue, simplified]
+lemmas rf_sr_tcb_update_no_queue2 =
+  rf_sr_obj_update_helper[OF rf_sr_tcb_update_no_queue, simplified]
 
 lemma tcb_queue_relation_not_in_q:
   "ctcb_ptr_to_tcb_ptr x \<notin> set xs \<Longrightarrow>
@@ -1443,13 +1390,7 @@ lemma rf_sr_tcb_update_not_in_queue:
     apply (drule(1) map_to_ko_atI')
     apply (drule sym_refs_ko_atD', clarsimp+)
     subgoal by blast
-   apply (simp add: cready_queues_relation_def, erule allEI)
    apply (clarsimp simp: Let_def)
-    apply (subst tcb_queue_relation_not_in_q)
-   apply clarsimp
-    apply (drule valid_queues_obj_at'D, clarsimp)
-    apply (clarsimp simp: obj_at'_def inQ_def)
-   subgoal by simp
   apply (simp add: carch_state_relation_def)
   by (simp add: cmachine_state_relation_def)
 
diff --git a/proof/crefine/AARCH64/Tcb_C.thy b/proof/crefine/AARCH64/Tcb_C.thy
index f1406c13ad..7ed0ce328f 100644
--- a/proof/crefine/AARCH64/Tcb_C.thy
+++ b/proof/crefine/AARCH64/Tcb_C.thy
@@ -395,9 +395,10 @@ lemma hrs_mem_update_cong:
 
 lemma setPriority_ccorres:
   "ccorres dc xfdc
-      (\<lambda>s. tcb_at' t s \<and> Invariants_H.valid_queues s \<and>  ksCurDomain s \<le> maxDomain \<and>
-           valid_queues' s \<and> valid_objs' s \<and> weak_sch_act_wf (ksSchedulerAction s) s \<and> (priority \<le> maxPriority))
-      (UNIV \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr t} \<inter> {s. prio_' s = ucast priority})
+      (\<lambda>s. tcb_at' t s \<and> ksCurDomain s \<le> maxDomain \<and>
+           valid_objs' s \<and> weak_sch_act_wf (ksSchedulerAction s) s \<and> (priority \<le> maxPriority) \<and>
+           pspace_aligned' s \<and> pspace_distinct' s)
+      ({s. tptr_' s = tcb_ptr_to_ctcb_ptr t} \<inter> {s. prio_' s = ucast priority})
       [] (setPriority t priority) (Call setPriority_'proc)"
   apply (cinit lift: tptr_' prio_')
    apply (ctac(no_vcg) add: tcbSchedDequeue_ccorres)
@@ -420,7 +421,7 @@ lemma setPriority_ccorres:
         apply (ctac add: possibleSwitchTo_ccorres)
        apply (rule ccorres_return_Skip')
       apply (wp isRunnable_wp)
-     apply (wpsimp wp: hoare_drop_imps threadSet_valid_queues threadSet_valid_objs'
+     apply (wpsimp wp: hoare_drop_imps threadSet_valid_objs'
                        weak_sch_act_wf_lift_linear threadSet_pred_tcb_at_state
                        threadSet_tcbDomain_triv
                  simp: st_tcb_at'_def o_def split: if_splits)
@@ -429,18 +430,13 @@ lemma setPriority_ccorres:
                  where Q="\<lambda>rv s.
                           obj_at' (\<lambda>_. True) t s \<and>
                           priority \<le> maxPriority \<and>
-                          Invariants_H.valid_queues s \<and>
                           ksCurDomain s \<le> maxDomain \<and>
                           valid_objs' s \<and>
-                          valid_queues' s \<and>
                           weak_sch_act_wf (ksSchedulerAction s) s \<and>
-                          (\<forall>d p. \<not> t \<in> set (ksReadyQueues s (d, p)))"])
-    apply (wp weak_sch_act_wf_lift_linear tcbSchedDequeue_valid_queues tcbSchedDequeue_nonq)
+                          pspace_aligned' s \<and> pspace_distinct' s"])
+    apply (wp weak_sch_act_wf_lift_linear valid_tcb'_def)
    apply (clarsimp simp: valid_tcb'_tcbPriority_update)
   apply clarsimp
-  apply (frule (1) valid_objs'_maxDomain[where t=t])
-  apply (frule (1) valid_objs'_maxPriority[where t=t])
-  apply simp
   done
 
 lemma setMCPriority_ccorres:
@@ -679,12 +675,12 @@ lemma invokeTCB_ThreadControl_ccorres:
                         apply (clarsimp simp : guard_is_UNIV_def Collect_const_mem)
                        apply (rule hoare_strengthen_post[
                                     where Q= "\<lambda>rv s.
-                                              Invariants_H.valid_queues s \<and>
                                               valid_objs' s \<and>
                                               weak_sch_act_wf (ksSchedulerAction s) s \<and>
                                               ((\<exists>a b. priority = Some (a, b)) \<longrightarrow>
                                                    tcb_at' target s \<and> ksCurDomain s \<le> maxDomain \<and>
-                                                   valid_queues' s \<and>  fst (the priority) \<le> maxPriority)"])
+                                                   fst (the priority) \<le> maxPriority) \<and>
+                                              pspace_aligned' s \<and> pspace_distinct' s"])
                         apply (strengthen sch_act_wf_weak)
                         apply (wp hoare_weak_lift_imp)
                        apply (clarsimp split: if_splits)
@@ -774,12 +770,12 @@ lemma invokeTCB_ThreadControl_ccorres:
                apply (clarsimp simp : guard_is_UNIV_def Collect_const_mem)
               apply (simp cong: conj_cong)
               apply (rule hoare_strengthen_post[
-                            where Q="\<lambda>a b. (Invariants_H.valid_queues b \<and>
-                                       valid_objs' b \<and>
+                            where Q="\<lambda>a b. (valid_objs' b \<and>
                                        sch_act_wf (ksSchedulerAction b) b \<and>
+                                       pspace_aligned' b \<and> pspace_distinct' b \<and>
                                        ((\<exists>a b. priority = Some (a, b)) \<longrightarrow>
                                           tcb_at'  target b \<and>
-                                          ksCurDomain b \<le> maxDomain \<and> valid_queues' b \<and>
+                                          ksCurDomain b \<le> maxDomain \<and>
                                           fst (the priority) \<le> maxPriority)) \<and>
                                        ((case snd (the buf)
                                            of None \<Rightarrow> 0
@@ -801,15 +797,15 @@ lemma invokeTCB_ThreadControl_ccorres:
                prefer 2
                apply fastforce
               apply (strengthen cte_is_derived_capMasterCap_strg
-                                invs_queues invs_weak_sch_act_wf invs_sch_act_wf'
+                                invs_weak_sch_act_wf invs_sch_act_wf'
                                 invs_valid_objs' invs_mdb' invs_pspace_aligned',
                             simp add: o_def)
               apply (rule_tac P="is_aligned (fst (the buf)) msg_align_bits"
                        in hoare_gen_asm)
               apply (wp threadSet_ipcbuffer_trivial hoare_weak_lift_imp
                      | simp
-                     | strengthen invs_sch_act_wf' invs_valid_objs' invs_weak_sch_act_wf invs_queues
-                                  invs_valid_queues' | wp hoare_drop_imps)+
+                     | strengthen invs_sch_act_wf' invs_valid_objs' invs_weak_sch_act_wf
+                     | wp hoare_drop_imps)+
              apply (clarsimp simp: guard_is_UNIV_def Collect_const_mem
                                    option_to_0_def
                             split: option.split_asm)
@@ -818,7 +814,7 @@ lemma invokeTCB_ThreadControl_ccorres:
              apply (rule ccorres_return_C_errorE, simp+)[1]
             apply vcg
            apply (simp add: conj_comms cong: conj_cong)
-           apply (strengthen invs_ksCurDomain_maxDomain')
+           apply (strengthen invs_ksCurDomain_maxDomain' invs_pspace_distinct')
            apply (wp hoare_vcg_const_imp_lift_R cteDelete_invs')
           apply simp
           apply (rule ccorres_split_nothrow_novcg_dc)
@@ -835,8 +831,7 @@ lemma invokeTCB_ThreadControl_ccorres:
          apply (rule conjI)
           apply (clarsimp simp: objBits_simps' word_bits_conv case_option_If2 if_n_0_0 valid_cap'_def
                                 capAligned_def obj_at'_def projectKOs)
-         apply (clarsimp simp: invs_valid_objs' invs_valid_queues'
-                               Invariants_H.invs_queues invs_ksCurDomain_maxDomain')
+         apply (fastforce simp: invs_valid_objs' invs_ksCurDomain_maxDomain')
         apply (rule ccorres_Cond_rhs_Seq)
          apply (rule ccorres_rhs_assoc)+
          apply csymbr
@@ -1071,7 +1066,7 @@ lemma restart_ccorres:
         apply (ctac(no_vcg) add: tcbSchedEnqueue_ccorres)
          apply (ctac add: possibleSwitchTo_ccorres)
         apply (wp weak_sch_act_wf_lift)[1]
-       apply (wp sts_valid_queues setThreadState_st_tcb)[1]
+       apply (wp sts_valid_objs' setThreadState_st_tcb)[1]
       apply (simp add: valid_tcb_state'_def)
       apply wp
       apply (wp (once) sch_act_wf_lift, (wp tcb_in_cur_domain'_lift)+)
@@ -1688,7 +1683,7 @@ lemma invokeTCB_WriteRegisters_ccorres[where S=UNIV]:
   apply (clarsimp simp: frame_gp_registers_convs word_less_nat_alt
                         sysargs_rel_def n_frameRegisters_def n_msgRegisters_def
                   split: if_split_asm)
-  apply (simp add: invs_weak_sch_act_wf invs_valid_objs' invs_queues)
+  apply (simp add: invs_weak_sch_act_wf invs_valid_objs')
   apply (fastforce dest!: global'_no_ex_cap simp: invs'_def valid_state'_def)
   done
 
@@ -3166,7 +3161,8 @@ lemma decodeTCBConfigure_ccorres:
    apply (rule conjI, fastforce)
    apply (drule interpret_excaps_eq)
    apply (clarsimp simp: cte_wp_at_ctes_of valid_tcb_state'_def numeral_eqs le_ucast_ucast_le
-                         tcb_at_invs' invs_valid_objs' invs_queues invs_sch_act_wf'
+                         tcb_at_invs' invs_valid_objs' invs_sch_act_wf'
+                         invs_pspace_aligned' invs_pspace_distinct'
                          ct_in_state'_def pred_tcb_at'_def obj_at'_def tcb_st_refs_of'_def)
    apply (erule disjE; simp add: objBits_defs mask_def)
   apply (clarsimp simp: idButNot_def interpret_excaps_test_null
@@ -4453,9 +4449,9 @@ lemma invokeTCB_SetTLSBase_ccorres:
        apply (rule ccorres_return_CE, simp+)[1]
       apply (wpsimp wp: hoare_drop_imp simp: guard_is_UNIV_def)+
    apply vcg
-  apply (clarsimp simp: tlsBaseRegister_def AARCH64.tlsBaseRegister_def
-                        invs_weak_sch_act_wf invs_queues C_register_defs
-                 split: if_split)
+  apply (fastforce simp: tlsBaseRegister_def AARCH64.tlsBaseRegister_def
+                         invs_weak_sch_act_wf C_register_defs
+                  split: if_split)
   done
 
 lemma decodeSetTLSBase_ccorres:
diff --git a/proof/crefine/AARCH64/Wellformed_C.thy b/proof/crefine/AARCH64/Wellformed_C.thy
index a6d00f17ff..9bbe8b1e99 100644
--- a/proof/crefine/AARCH64/Wellformed_C.thy
+++ b/proof/crefine/AARCH64/Wellformed_C.thy
@@ -215,9 +215,6 @@ where
 abbreviation
   "ep_queue_relation \<equiv> tcb_queue_relation tcbEPNext_C tcbEPPrev_C"
 
-abbreviation
-  "sched_queue_relation \<equiv> tcb_queue_relation tcbSchedNext_C tcbSchedPrev_C"
-
 definition
 capUntypedPtr_C :: "cap_CL \<Rightarrow> word64" where
   "capUntypedPtr_C cap \<equiv> case cap of
diff --git a/proof/crefine/ARM/ADT_C.thy b/proof/crefine/ARM/ADT_C.thy
index 284ef17f60..890865b53b 100644
--- a/proof/crefine/ARM/ADT_C.thy
+++ b/proof/crefine/ARM/ADT_C.thy
@@ -75,8 +75,8 @@ lemma Basic_sem_eq:
 
 lemma setTCBContext_C_corres:
   "\<lbrakk> ccontext_relation tc tc'; t' = tcb_ptr_to_ctcb_ptr t \<rbrakk> \<Longrightarrow>
-  corres_underlying rf_sr nf nf' dc (pspace_domain_valid and tcb_at' t) \<top>
-    (threadSet (\<lambda>tcb. tcb \<lparr> tcbArch := atcbContextSet tc (tcbArch tcb)\<rparr>) t) (setTCBContext_C tc' t')"
+   corres_underlying rf_sr nf nf' dc (pspace_domain_valid and tcb_at' t) \<top>
+     (threadSet (\<lambda>tcb. tcb \<lparr> tcbArch := atcbContextSet tc (tcbArch tcb)\<rparr>) t) (setTCBContext_C tc' t')"
   apply (simp add: setTCBContext_C_def exec_C_def Basic_sem_eq corres_underlying_def)
   apply clarsimp
   apply (simp add: threadSet_def bind_assoc split_def exec_gets)
@@ -105,8 +105,6 @@ lemma setTCBContext_C_corres:
   apply (simp add: map_to_ctes_upd_tcb_no_ctes map_to_tcbs_upd tcb_cte_cases_def
                    cvariable_relation_upd_const ko_at_projectKO_opt cteSizeBits_def)
   apply (simp add: cep_relations_drop_fun_upd)
-  apply (apply_conjunct \<open>match conclusion in \<open>cready_queues_relation _ _ _\<close> \<Rightarrow>
-         \<open>erule cready_queues_relation_not_queue_ptrs; rule ext; simp split: if_split\<close>\<close>)
   apply (drule ko_at_projectKO_opt)
   apply (erule (2) cmap_relation_upd_relI)
     apply (simp add: ctcb_relation_def carch_tcb_relation_def)
@@ -639,25 +637,50 @@ lemma tcb_queue_rel'_unique:
   apply (erule(2) tcb_queue_rel_unique)
   done
 
-definition
-  cready_queues_to_H
-  :: "(tcb_C ptr \<rightharpoonup> tcb_C) \<Rightarrow> (tcb_queue_C[num_tcb_queues]) \<Rightarrow> word8 \<times> word8 \<Rightarrow> word32 list"
+definition tcb_queue_C_to_tcb_queue :: "tcb_queue_C \<Rightarrow> tcb_queue" where
+  "tcb_queue_C_to_tcb_queue q \<equiv>
+     TcbQueue (if head_C q = NULL then None else Some (ctcb_ptr_to_tcb_ptr (head_C q)))
+              (if end_C q = NULL then None else Some (ctcb_ptr_to_tcb_ptr (end_C q)))"
+
+definition cready_queues_to_H ::
+  "tcb_queue_C[num_tcb_queues] \<Rightarrow> (domain \<times> priority \<Rightarrow> ready_queue)"
   where
-  "cready_queues_to_H h_tcb cs \<equiv> \<lambda>(qdom, prio). if ucast minDom \<le> qdom \<and> qdom \<le> ucast maxDom
-              \<and> ucast seL4_MinPrio \<le> prio \<and> prio \<le> ucast seL4_MaxPrio
-   then THE aq. let cqueue = index cs (cready_queues_index_to_C qdom prio)
-    in sched_queue_relation' h_tcb aq (head_C cqueue) (StateRelation_C.end_C cqueue)
-   else []"
+  "cready_queues_to_H cs \<equiv>
+     \<lambda>(qdom, prio).
+       if qdom \<le> maxDomain \<and> prio \<le> maxPriority
+       then let cqueue = index cs (cready_queues_index_to_C qdom prio)
+             in tcb_queue_C_to_tcb_queue cqueue
+       else TcbQueue None None"
 
 lemma cready_queues_to_H_correct:
-  "cready_queues_relation (clift s) cs as \<Longrightarrow>
-   cready_queues_to_H (clift s) cs = as"
-  apply (clarsimp simp: cready_queues_to_H_def cready_queues_relation_def
-                   fun_eq_iff)
-  apply (rule the_equality)
-   apply simp
-  apply (clarsimp simp: Let_def)
-  apply (rule_tac hp="clift s" in tcb_queue_rel'_unique, simp_all add: lift_t_NULL)
+  "\<lbrakk>cready_queues_relation (ksReadyQueues s) (ksReadyQueues_' ch);
+    no_0_obj' s; ksReadyQueues_asrt s; pspace_aligned' s; pspace_distinct' s\<rbrakk>
+   \<Longrightarrow> cready_queues_to_H (ksReadyQueues_' ch) = ksReadyQueues s"
+  apply (clarsimp simp: cready_queues_to_H_def cready_queues_relation_def Let_def)
+  apply (clarsimp simp: fun_eq_iff)
+  apply (rename_tac d p)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply (clarsimp simp: ready_queue_relation_def ksReadyQueues_asrt_def)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply clarsimp
+  apply (frule (3) obj_at'_tcbQueueHead_ksReadyQueues)
+  apply (frule (3) obj_at'_tcbQueueEnd_ksReadyQueues)
+  apply (frule tcbQueueHead_iff_tcbQueueEnd)
+  apply (rule conjI)
+   apply (clarsimp simp: tcb_queue_C_to_tcb_queue_def ctcb_queue_relation_def option_to_ctcb_ptr_def)
+   apply (case_tac "tcbQueueHead (ksReadyQueues s (d, p)) = None")
+    apply (clarsimp simp: tcb_queue.expand)
+   apply clarsimp
+   apply (rename_tac queue_head queue_end)
+   apply (prop_tac "tcb_at' queue_head s", fastforce simp: tcbQueueEmpty_def obj_at'_def)
+   apply (prop_tac "tcb_at' queue_end s", fastforce simp: tcbQueueEmpty_def obj_at'_def)
+   apply (drule kernel.tcb_at_not_NULL)+
+   apply (fastforce simp: tcb_queue.expand kernel.ctcb_ptr_to_ctcb_ptr)
+  apply (clarsimp simp: tcbQueueEmpty_def ctcb_queue_relation_def option_to_ctcb_ptr_def
+                 split: option.splits;
+         metis tcb_queue.exhaust_sel word_not_le)
   done
 
 (* showing that cpspace_relation is actually unique >>>*)
@@ -769,42 +792,90 @@ lemma cthread_state_rel_imp_eq:
   apply (cases y, simp_all add: ThreadState_defs)+
   done
 
-lemma ksPSpace_valid_objs_tcbBoundNotification_nonzero:
-  "\<exists>s. ksPSpace s = ah \<and> no_0_obj' s \<and> valid_objs' s
-     \<Longrightarrow> map_to_tcbs ah p = Some tcb \<Longrightarrow> tcbBoundNotification tcb \<noteq> Some 0"
+lemma map_to_tcbs_Some_refs_nonzero:
+  "\<lbrakk>map_to_tcbs (ksPSpace s) p = Some tcb; no_0_obj' s; valid_objs' s\<rbrakk>
+   \<Longrightarrow> tcbBoundNotification tcb \<noteq> Some 0
+       \<and> tcbSchedPrev tcb \<noteq> Some 0
+       \<and> tcbSchedNext tcb \<noteq> Some 0"
+  supply word_neq_0_conv[simp del]
   apply (clarsimp simp: map_comp_def split: option.splits)
-  apply (erule(1) valid_objsE')
-  apply (clarsimp simp: projectKOs valid_obj'_def valid_tcb'_def)
+  apply (erule (1) valid_objsE')
+  apply (fastforce simp: projectKOs valid_obj'_def valid_tcb'_def)
   done
 
+lemma ccontext_relation_imp_eq2:
+  "\<lbrakk>ccontext_relation (atcbContextGet t) x; ccontext_relation (atcbContextGet t') x\<rbrakk> \<Longrightarrow> t = t'"
+  by (fastforce simp: atcbContextGet_def arch_tcb.expand ccontext_relation_imp_eq)
+
+lemma tcb_ptr_to_ctcb_ptr_inj:
+  "tcb_ptr_to_ctcb_ptr x = tcb_ptr_to_ctcb_ptr y \<Longrightarrow> x = y"
+  by (auto simp: tcb_ptr_to_ctcb_ptr_def ctcb_offset_def)
+
+lemma
+  assumes "pspace_aligned' as" "pspace_distinct' as" "valid_tcb' atcb as"
+  shows tcb_at'_tcbBoundNotification:
+    "bound (tcbBoundNotification atcb) \<longrightarrow> ntfn_at' (the (tcbBoundNotification atcb)) as"
+  and tcb_at'_tcbSchedPrev:
+    "tcbSchedPrev atcb \<noteq> None \<longrightarrow> tcb_at' (the (tcbSchedPrev atcb)) as"
+  and tcb_at'_tcbSchedNext:
+    "tcbSchedNext atcb \<noteq> None \<longrightarrow> tcb_at' (the (tcbSchedNext atcb)) as"
+  using assms
+  by (clarsimp simp: valid_tcb'_def obj_at'_def)+
+
 lemma cpspace_tcb_relation_unique:
-  assumes tcbs: "cpspace_tcb_relation ah ch" "cpspace_tcb_relation ah' ch"
-      and   vs: "\<exists>s. ksPSpace s = ah \<and> no_0_obj' s \<and> valid_objs' s"
-      and   vs': "\<exists>s. ksPSpace s = ah' \<and> no_0_obj' s \<and> valid_objs' s"
-  assumes ctes: " \<forall>tcb tcb'. (\<exists>p. map_to_tcbs ah p = Some tcb \<and>
-                                  map_to_tcbs ah' p = Some tcb') \<longrightarrow>
-                  (\<forall>x\<in>ran tcb_cte_cases. fst x tcb' = fst x tcb)"
-  shows "map_to_tcbs ah' = map_to_tcbs ah"
+  assumes tcbs: "cpspace_tcb_relation (ksPSpace as) ch" "cpspace_tcb_relation (ksPSpace as') ch"
+  assumes   vs: "no_0_obj' as" "valid_objs' as"
+  assumes  vs': "no_0_obj' as'" "valid_objs' as'"
+  assumes   ad: "pspace_aligned' as" "pspace_distinct' as"
+  assumes  ad': "pspace_aligned' as'" "pspace_distinct' as'"
+  assumes ctes: "\<forall>tcb tcb'. (\<exists>p. map_to_tcbs (ksPSpace as) p = Some tcb \<and>
+                                 map_to_tcbs (ksPSpace as') p = Some tcb') \<longrightarrow>
+                 (\<forall>x\<in>ran tcb_cte_cases. fst x tcb' = fst x tcb)"
+  shows "map_to_tcbs (ksPSpace as') = map_to_tcbs (ksPSpace as)"
   using tcbs(2) tcbs(1)
   apply (clarsimp simp add: cmap_relation_def)
   apply (drule inj_image_inv[OF inj_tcb_ptr_to_ctcb_ptr])+
   apply (simp add: tcb_ptr_to_ctcb_ptr_def[abs_def] ctcb_offset_def)
   apply (rule ext)
-  apply (case_tac "x:dom (map_to_tcbs ah)")
+  apply (case_tac "x \<in> dom (map_to_tcbs (ksPSpace as))")
    apply (drule bspec, assumption)+
    apply (simp add: dom_def Collect_eq, drule_tac x=x in spec)
    apply clarsimp
    apply (rename_tac p x y)
    apply (cut_tac ctes)
    apply (drule_tac x=x in spec, drule_tac x=y in spec, erule impE, fastforce)
-   apply (frule ksPSpace_valid_objs_tcbBoundNotification_nonzero[OF vs])
-   apply (frule ksPSpace_valid_objs_tcbBoundNotification_nonzero[OF vs'])
+   apply (frule map_to_tcbs_Some_refs_nonzero[OF _ vs])
+   apply (frule map_to_tcbs_Some_refs_nonzero[OF _ vs'])
+   apply (rename_tac atcb atcb')
+   apply (prop_tac "valid_tcb' atcb as")
+    apply (fastforce intro: vs ad map_to_ko_atI tcb_ko_at_valid_objs_valid_tcb')
+   apply (prop_tac "valid_tcb' atcb' as'")
+    apply (fastforce intro: vs' ad' map_to_ko_atI tcb_ko_at_valid_objs_valid_tcb')
+   apply (frule tcb_at'_tcbSchedPrev[OF ad])
+   apply (frule tcb_at'_tcbSchedPrev[OF ad'])
+   apply (frule tcb_at'_tcbSchedNext[OF ad])
+   apply (frule tcb_at'_tcbSchedNext[OF ad'])
    apply (thin_tac "map_to_tcbs x y = Some z" for x y z)+
-   apply (case_tac x, case_tac y, case_tac "the (clift ch (tcb_Ptr (p+0x100)))")
+   apply (case_tac "the (clift ch (tcb_Ptr (p + 2 ^ ctcb_size_bits)))")
    apply (clarsimp simp: ctcb_relation_def ran_tcb_cte_cases)
-   apply (clarsimp simp: option_to_ptr_def option_to_0_def split: option.splits)
-   apply (auto simp: cfault_rel_imp_eq cthread_state_rel_imp_eq carch_tcb_relation_imp_eq
-                     ccontext_relation_imp_eq up_ucast_inj_eq ctcb_size_bits_def)
+   apply (clarsimp simp: option_to_ctcb_ptr_def option_to_ptr_def option_to_0_def)
+   apply (rule tcb.expand)
+   apply clarsimp
+   apply (intro conjI)
+        apply (simp add: cthread_state_rel_imp_eq)
+       apply (simp add: cfault_rel_imp_eq)
+      apply (case_tac "tcbBoundNotification atcb'", case_tac "tcbBoundNotification atcb"; clarsimp)
+      apply (clarsimp split: option.splits)
+     apply (case_tac "tcbSchedPrev atcb'"; case_tac "tcbSchedPrev atcb"; clarsimp)
+       apply (force dest!: kernel.tcb_at_not_NULL)
+      apply (force dest!: kernel.tcb_at_not_NULL)
+     apply (force simp: tcb_ptr_to_ctcb_ptr_inj)
+    apply (case_tac "tcbSchedNext atcb'"; case_tac "tcbSchedNext atcb"; clarsimp)
+      apply (force dest!: kernel.tcb_at_not_NULL)
+     apply (force dest!: kernel.tcb_at_not_NULL)
+    apply (force simp: tcb_ptr_to_ctcb_ptr_inj)
+   apply (force simp: carch_tcb_relation_def ccontext_relation_imp_eq2)
+  apply auto
   done
 
 lemma tcb_queue_rel_clift_unique:
@@ -835,10 +906,6 @@ lemma ksPSpace_valid_pspace_ntfnBoundTCB_nonzero:
   apply (clarsimp simp: projectKOs valid_obj'_def valid_ntfn'_def)
   done
 
-lemma tcb_ptr_to_ctcb_ptr_inj:
-  "tcb_ptr_to_ctcb_ptr x = tcb_ptr_to_ctcb_ptr y \<Longrightarrow> x = y"
-  by (auto simp: tcb_ptr_to_ctcb_ptr_def ctcb_offset_def)
-
 lemma cpspace_ntfn_relation_unique:
   assumes ntfns: "cpspace_ntfn_relation ah ch" "cpspace_ntfn_relation ah' ch"
       and   vs: "\<exists>s. ksPSpace s = ah \<and> valid_pspace' s"
@@ -1090,8 +1157,8 @@ proof -
                      OF valid_objs'_imp_wf_asid_pool'[OF valid_objs]
                         valid_objs'_imp_wf_asid_pool'[OF valid_objs']])
   apply (drule (1) cpspace_tcb_relation_unique)
-     apply (fastforce intro: no_0_objs no_0_objs' valid_objs valid_objs')
-    apply (fastforce intro: no_0_objs no_0_objs' valid_objs valid_objs')
+       apply (fastforce intro: no_0_objs no_0_objs' valid_objs valid_objs')+
+      apply (fastforce intro: aligned distinct aligned' distinct')+
    apply (intro allI impI,elim exE conjE)
    apply (rule_tac p=p in map_to_ctes_tcb_ctes, assumption)
     apply (frule (1) map_to_ko_atI[OF _ aligned distinct])
@@ -1299,7 +1366,7 @@ where
     ksDomSchedule = cDomSchedule_to_H kernel_all_global_addresses.ksDomSchedule,
     ksCurDomain = ucast (ksCurDomain_' s),
     ksDomainTime = ksDomainTime_' s,
-    ksReadyQueues = cready_queues_to_H (clift (t_hrs_' s)) (ksReadyQueues_' s),
+    ksReadyQueues = cready_queues_to_H (ksReadyQueues_' s),
     ksReadyQueuesL1Bitmap = cbitmap_L1_to_H (ksReadyQueuesL1Bitmap_' s),
     ksReadyQueuesL2Bitmap = cbitmap_L2_to_H (ksReadyQueuesL2Bitmap_' s),
     ksCurThread = ctcb_ptr_to_tcb_ptr (ksCurThread_' s),
@@ -1315,16 +1382,16 @@ where
 lemma (in kernel_m) cstate_to_H_correct:
   assumes valid: "valid_state' as"
   assumes cstate_rel: "cstate_relation as cs"
+  assumes rdyqs: "ksReadyQueues_asrt as"
   shows "cstate_to_H cs = as \<lparr>ksMachineState:=  observable_memory (ksMachineState as) (user_mem' as)\<rparr>"
   apply (subgoal_tac "cstate_to_machine_H cs = observable_memory (ksMachineState as) (user_mem' as)")
    apply (rule kernel_state.equality, simp_all add: cstate_to_H_def)
-                      apply (rule cstate_to_pspace_H_correct)
+                    apply (rule cstate_to_pspace_H_correct)
                      using valid
                      apply (simp add: valid_state'_def)
                     using cstate_rel valid
                     apply (clarsimp simp: cstate_relation_def cpspace_relation_def Let_def
-                      observable_memory_def valid_state'_def
-                      valid_pspace'_def)
+                                          observable_memory_def valid_state'_def valid_pspace'_def)
                    using cstate_rel
                    apply (clarsimp simp: cstate_relation_def cpspace_relation_def Let_def prod_eq_iff)
                   using cstate_rel
@@ -1348,8 +1415,13 @@ lemma (in kernel_m) cstate_to_H_correct:
             using cstate_rel
             apply (clarsimp simp: cstate_relation_def Let_def)
            apply (rule cready_queues_to_H_correct)
-           using cstate_rel
-           apply (clarsimp simp: cstate_relation_def Let_def)
+               using cstate_rel rdyqs
+               apply (fastforce intro!: cready_queues_to_H_correct
+                                  simp: cstate_relation_def Let_def)
+              using valid apply (fastforce simp: valid_state'_def)
+             using rdyqs apply fastforce
+            using valid apply (fastforce simp: valid_state'_def)
+           using valid apply (fastforce simp: valid_state'_def)
           using cstate_rel
           apply (clarsimp simp: cstate_relation_def Let_def)
           using cstate_rel
diff --git a/proof/crefine/ARM/ArchMove_C.thy b/proof/crefine/ARM/ArchMove_C.thy
index 938d1c8f2f..5095e3d70f 100644
--- a/proof/crefine/ARM/ArchMove_C.thy
+++ b/proof/crefine/ARM/ArchMove_C.thy
@@ -91,14 +91,9 @@ lemma empty_fail_findPDForASIDAssert[iff]:
   unfolding findPDForASIDAssert_def checkPDAt_def checkPDUniqueToASID_def checkPDASIDMapMembership_def
   by (wpsimp wp: empty_fail_getObject)
 
-crunches Arch.switchToThread
-  for valid_queues'[wp]: valid_queues'
-  (simp: crunch_simps ignore: clearExMonitor)
 crunches switchToIdleThread
   for ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
-crunches switchToIdleThread, switchToThread
-  for valid_pspace'[wp]: valid_pspace'
-  (simp: crunch_simps)
+
 crunches switchToThread
   for valid_arch_state'[wp]: valid_arch_state'
 
diff --git a/proof/crefine/ARM/Arch_C.thy b/proof/crefine/ARM/Arch_C.thy
index 0833cdfec0..98e91e832e 100644
--- a/proof/crefine/ARM/Arch_C.thy
+++ b/proof/crefine/ARM/Arch_C.thy
@@ -1988,7 +1988,7 @@ lemma performPageGetAddress_ccorres:
    apply clarsimp
    apply (rule conseqPre, vcg)
    apply clarsimp
-  apply (clarsimp simp: invs_no_0_obj' tcb_at_invs' invs_queues invs_valid_objs' invs_sch_act_wf'
+  apply (clarsimp simp: invs_no_0_obj' tcb_at_invs' invs_valid_objs' invs_sch_act_wf'
                         rf_sr_ksCurThread msgRegisters_unfold
                         seL4_MessageInfo_lift_def message_info_to_H_def mask_def)
   apply (cases isCall)
@@ -3134,8 +3134,8 @@ lemma decodeARMPageDirectoryInvocation_ccorres:
                 st' \<noteq> Structures_H.thread_state.Inactive \<and> st' \<noteq> Structures_H.thread_state.IdleThreadState)
                 thread and (\<lambda>s. thread \<noteq> ksIdleThread s
                    \<and> (obj_at' tcbQueued thread s \<longrightarrow> st_tcb_at' runnable' thread s))"]])
-            apply (clarsimp simp: invs_valid_objs' invs_sch_act_wf'
-              valid_tcb_state'_def invs_queues)
+            apply (clarsimp simp: invs_valid_objs' invs_sch_act_wf' valid_tcb_state'_def
+                                  invs_pspace_aligned' invs_pspace_distinct')
             apply (rule conjI)
              apply (erule flush_range_le)
               apply (simp add:linorder_not_le)
@@ -3861,9 +3861,12 @@ lemma Arch_decodeInvocation_ccorres:
     apply (clarsimp simp: ex_cte_cap_wp_to'_def cte_wp_at_ctes_of
                           invs_sch_act_wf' dest!: isCapDs(1))
     apply (intro conjI)
-            apply (simp add: Invariants_H.invs_queues)
-           apply (simp add: valid_tcb_state'_def)
-          apply (fastforce elim!: pred_tcb'_weakenE dest!:st_tcb_at_idle_thread')
+             apply (simp add: valid_tcb_state'_def)
+            apply (fastforce elim!: pred_tcb'_weakenE dest!:st_tcb_at_idle_thread')
+           apply fastforce
+          apply (clarsimp simp: st_tcb_at'_def obj_at'_def)
+          apply (rename_tac obj)
+          apply (case_tac "tcbState obj", (simp add: runnable'_def)+)[1]
          apply (clarsimp simp: st_tcb_at'_def obj_at'_def)
          apply (rename_tac obj)
          apply (case_tac "tcbState obj", (simp add: runnable'_def)+)[1]
diff --git a/proof/crefine/ARM/Detype_C.thy b/proof/crefine/ARM/Detype_C.thy
index 78acb233ef..783bcaf7e8 100644
--- a/proof/crefine/ARM/Detype_C.thy
+++ b/proof/crefine/ARM/Detype_C.thy
@@ -1568,35 +1568,11 @@ proof -
    apply (rule cmap_array; simp add: pteBits_def)
    done
   moreover
-  from invs have "valid_queues s" ..
-  hence "\<And>p. \<forall>t \<in> set (ksReadyQueues s p). tcb_at' t s \<and> ko_wp_at' live' t s"
-    apply (clarsimp simp: valid_queues_def valid_queues_no_bitmap_def)
-    apply (drule spec, drule spec)
-    apply clarsimp
-    apply (drule (1) bspec)
-    apply (rule conjI)
-    apply (erule obj_at'_weakenE)
-    apply simp
-    apply (simp add: obj_at'_real_def)
-    apply (erule ko_wp_at'_weakenE)
-    apply (clarsimp simp: projectKOs inQ_def)
-    done
-  hence tat: "\<And>p. \<forall>t \<in> set (ksReadyQueues s p). tcb_at' t s"
-    and  tlive: "\<And>p. \<forall>t \<in> set (ksReadyQueues s p). ko_wp_at' live' t s"
-    by auto
   from sr have
-    "cready_queues_relation (clift ?th_s)
-        (ksReadyQueues_' (globals s')) (ksReadyQueues s)"
+    "cready_queues_relation (ksReadyQueues s) (ksReadyQueues_' (globals s'))"
     unfolding cready_queues_relation_def rf_sr_def cstate_relation_def
               cpspace_relation_def
     apply (clarsimp simp: Let_def all_conj_distrib)
-    apply (drule spec, drule spec, drule mp)
-    apply fastforce
-    apply ((subst lift_t_typ_region_bytes, rule cm_disj_tcb, assumption+,
-      simp_all add: objBits_simps archObjSize_def pageBits_def projectKOs)[1])+
-      \<comment> \<open>waiting ...\<close>
-    apply (simp add: tcb_queue_relation_live_restrict
-                     [OF D.valid_untyped tat tlive rl])
     done
 
   moreover
diff --git a/proof/crefine/ARM/Fastpath_C.thy b/proof/crefine/ARM/Fastpath_C.thy
index cd2f746a82..6e09d6e161 100644
--- a/proof/crefine/ARM/Fastpath_C.thy
+++ b/proof/crefine/ARM/Fastpath_C.thy
@@ -39,11 +39,10 @@ lemma getEndpoint_obj_at':
 lemmas setEndpoint_obj_at_tcb' = setEndpoint_obj_at'_tcb
 
 lemma tcbSchedEnqueue_tcbContext[wp]:
-  "\<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>
-     tcbSchedEnqueue t'
-   \<lbrace>\<lambda>rv. obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
-  apply (rule tcbSchedEnqueue_obj_at_unchangedT[OF all_tcbI])
-  apply simp
+  "tcbSchedEnqueue t' \<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
+  apply (simp add: tcbSchedEnqueue_def tcbQueuePrepend_def unless_when)
+  apply (wp threadSet_obj_at' hoare_drop_imps threadGet_wp
+         | simp split: if_split)+
   done
 
 lemma setCTE_tcbContext:
@@ -55,20 +54,16 @@ lemma setCTE_tcbContext:
   done
 
 lemma setThreadState_tcbContext:
- "\<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>
-    setThreadState a b
-  \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
-  apply (rule setThreadState_obj_at_unchanged)
-  apply (clarsimp simp: atcbContext_def)+
-  done
+ "setThreadState a b \<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
+  unfolding setThreadState_def rescheduleRequired_def tcbSchedEnqueue_def
+            tcbQueuePrepend_def rescheduleRequired_def
+  by (wp threadSet_obj_at' hoare_drop_imps threadGet_wp | wpc
+         | simp split: if_split)+
 
 lemma setBoundNotification_tcbContext:
- "\<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>
-    setBoundNotification a b
-  \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
-  apply (rule setBoundNotification_obj_at_unchanged)
-  apply (clarsimp simp: atcbContext_def)+
-  done
+ "setBoundNotification a b \<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
+  unfolding setBoundNotification_def
+  by wpsimp
 
 declare comp_apply [simp del]
 crunch tcbContext[wp]: deleteCallerCap "obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t"
@@ -631,10 +626,10 @@ lemma dmo_clearExMonitor_setCurThread_swap:
             od)
     = (do _ \<leftarrow> setCurThread thread;
             doMachineOp ARM.clearExMonitor od)"
-  apply (simp add: setCurThread_def doMachineOp_def split_def)
-  apply (rule oblivious_modify_swap[symmetric])
-  apply (intro oblivious_bind,
-         simp_all add: select_f_oblivious)
+  apply (clarsimp simp: ARM.clearExMonitor_def)
+  apply (simp add: doMachineOp_modify)
+  apply (rule oblivious_modify_swap)
+  apply (fastforce intro: oblivious_bind simp: setCurThread_def idleThreadNotQueued_def)
   done
 
 lemma pd_at_asid_inj':
@@ -734,6 +729,8 @@ lemma switchToThread_fp_ccorres:
                     del: Collect_const)
         apply (simp only: dmo_clearExMonitor_setCurThread_swap)
         apply (rule ccorres_split_nothrow_novcg_dc)
+           apply (clarsimp simp: setCurThread_def)
+           apply (rule ccorres_stateAssert)
            apply (rule ccorres_from_vcg[where P=\<top> and P'=UNIV])
            apply (rule allI, rule conseqPre, vcg)
            apply (clarsimp simp del: rf_sr_upd_safe)
@@ -743,7 +740,7 @@ lemma switchToThread_fp_ccorres:
           apply (ctac add: clearExMonitor_fp_ccorres)
          apply wp
         apply (simp add: guard_is_UNIV_def)
-       apply wp
+       apply (wp hoare_drop_imps)
       apply (simp add: bind_assoc checkPDNotInASIDMap_def
                        checkPDASIDMapMembership_def)
       apply (rule ccorres_stateAssert)
@@ -1200,8 +1197,8 @@ lemma fastpath_dequeue_ccorres:
   apply (rule conjI)
    apply (clarsimp simp: cpspace_relation_def update_ep_map_tos
                          update_tcb_map_tos typ_heap_simps')
-   apply (rule conjI, erule ctcb_relation_null_queue_ptrs)
-    apply (rule ext, simp add: tcb_null_queue_ptrs_def
+   apply (rule conjI, erule ctcb_relation_null_ep_ptrs)
+    apply (rule ext, simp add: tcb_null_ep_ptrs_def
                         split: if_split)
    apply (rule conjI)
     apply (rule cpspace_relation_ep_update_ep, assumption+)
@@ -1217,8 +1214,6 @@ lemma fastpath_dequeue_ccorres:
   apply (simp add: carch_state_relation_def typ_heap_simps'
                    cmachine_state_relation_def h_t_valid_clift_Some_iff
                    update_ep_map_tos)
-  apply (erule cready_queues_relation_null_queue_ptrs)
-  apply (rule ext, simp add: tcb_null_ep_ptrs_def split: if_split)
   done
 
 lemma st_tcb_at_not_in_ep_queue:
@@ -1356,8 +1351,8 @@ lemma fastpath_enqueue_ccorres:
    apply (rule conjI)
     apply (clarsimp simp: cpspace_relation_def update_ep_map_tos
                           typ_heap_simps')
-    apply (rule conjI, erule ctcb_relation_null_queue_ptrs)
-     apply (rule ext, simp add: tcb_null_queue_ptrs_def
+    apply (rule conjI, erule ctcb_relation_null_ep_ptrs)
+     apply (rule ext, simp add: tcb_null_ep_ptrs_def
                          split: if_split)
     apply (rule conjI)
      apply (rule_tac S="tcb_ptr_to_ctcb_ptr ` set (ksCurThread \<sigma> # list)"
@@ -1396,8 +1391,6 @@ lemma fastpath_enqueue_ccorres:
            auto dest!: map_to_ko_atI)[1]
    apply (simp add: carch_state_relation_def typ_heap_simps' update_ep_map_tos
                     cmachine_state_relation_def h_t_valid_clift_Some_iff)
-   apply (erule cready_queues_relation_null_queue_ptrs)
-   apply (rule ext, simp add: tcb_null_ep_ptrs_def split: if_split)
   apply (clarsimp simp: typ_heap_simps' EPState_Recv_def mask_def
                         is_aligned_weaken[OF is_aligned_tcb_ptr_to_ctcb_ptr])
   apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def)
@@ -1405,8 +1398,8 @@ lemma fastpath_enqueue_ccorres:
   apply (rule conjI)
    apply (clarsimp simp: cpspace_relation_def update_ep_map_tos
                          typ_heap_simps' ct_in_state'_def)
-   apply (rule conjI, erule ctcb_relation_null_queue_ptrs)
-    apply (rule ext, simp add: tcb_null_queue_ptrs_def
+   apply (rule conjI, erule ctcb_relation_null_ep_ptrs)
+    apply (rule ext, simp add: tcb_null_ep_ptrs_def
                         split: if_split)
    apply (rule conjI)
     apply (rule_tac S="{tcb_ptr_to_ctcb_ptr (ksCurThread \<sigma>)}"
@@ -1426,8 +1419,6 @@ lemma fastpath_enqueue_ccorres:
           assumption+, auto dest!: map_to_ko_atI)[1]
   apply (simp add: carch_state_relation_def typ_heap_simps' update_ep_map_tos
                    cmachine_state_relation_def h_t_valid_clift_Some_iff)
-  apply (erule cready_queues_relation_null_queue_ptrs)
-  apply (rule ext, simp add: tcb_null_ep_ptrs_def split: if_split)
   done
 
 lemma setCTE_rf_sr:
@@ -2060,9 +2051,6 @@ proof -
                            apply (erule cmap_relation_updI, erule ko_at_projectKO_opt)
                             apply (simp add: ctcb_relation_def cthread_state_relation_def)
                            apply simp
-                          apply (rule conjI, erule cready_queues_relation_not_queue_ptrs)
-                            apply (rule ext, simp split: if_split add: typ_heap_simps')
-                           apply (rule ext, simp split: if_split add: typ_heap_simps')
                           apply (simp add: carch_state_relation_def cmachine_state_relation_def
                                            typ_heap_simps' map_comp_update projectKO_opt_tcb
                                            cvariable_relation_upd_const ko_at_projectKO_opt)
@@ -2187,9 +2175,6 @@ proof -
                                        apply (erule cmap_relation_updI, erule ko_at_projectKO_opt)
                                         apply (simp add: ctcb_relation_def cthread_state_relation_def)
                                        apply simp
-                                      apply (rule conjI, erule cready_queues_relation_not_queue_ptrs)
-                                        apply (rule ext, simp split: if_split)
-                                       apply (rule ext, simp split: if_split)
                                       apply (simp add: carch_state_relation_def cmachine_state_relation_def
                                                        typ_heap_simps' map_comp_update projectKO_opt_tcb
                                                        cvariable_relation_upd_const ko_at_projectKO_opt)
@@ -2381,7 +2366,7 @@ proof -
    apply (rule conjI) (* isReceive on queued tcb state *)
     apply (fastforce simp: st_tcb_at_tcbs_of isBlockedOnReceive_def isReceive_def)
    apply clarsimp
-   apply (rule conjI, fastforce dest!: invs_queues simp: valid_queues_def)
+   apply (rule conjI, fastforce dest!: simp: valid_queues_def)
    apply (frule invs_mdb', clarsimp simp: valid_mdb'_def valid_mdb_ctes_def)
    apply (case_tac xb, clarsimp, drule(1) nullcapsD')
    apply (clarsimp simp: pde_stored_asid_def to_bool_def
@@ -2870,9 +2855,6 @@ lemma fastpath_reply_recv_ccorres:
                                            ThreadState_defs)
                           apply (clarsimp simp: ccap_relation_ep_helpers)
                          apply simp
-                        apply (rule conjI, erule cready_queues_relation_not_queue_ptrs)
-                          apply (rule ext, simp split: if_split)
-                         apply (rule ext, simp split: if_split)
                         apply (simp add: carch_state_relation_def cmachine_state_relation_def
                                          typ_heap_simps' map_comp_update projectKO_opt_tcb
                                          cvariable_relation_upd_const ko_at_projectKO_opt)
@@ -2949,9 +2931,6 @@ lemma fastpath_reply_recv_ccorres:
                                      apply (erule cmap_relation_updI, erule ko_at_projectKO_opt)
                                       apply (simp add: ctcb_relation_def cthread_state_relation_def)
                                      apply simp
-                                    apply (rule conjI, erule cready_queues_relation_not_queue_ptrs)
-                                      apply (rule ext, simp split: if_split)
-                                     apply (rule ext, simp split: if_split)
                                     apply (simp add: carch_state_relation_def cmachine_state_relation_def
                                                      typ_heap_simps' map_comp_update projectKO_opt_tcb
                                                      cvariable_relation_upd_const ko_at_projectKO_opt)
@@ -3072,8 +3051,6 @@ lemma fastpath_reply_recv_ccorres:
      apply (clarsimp simp: ct_in_state'_def obj_at_tcbs_of word_sle_def)
      apply (clarsimp simp add: invs_ksCurDomain_maxDomain')
      apply (rule conjI, fastforce)
-     apply (frule invs_queues)
-     apply (simp add: valid_queues_def)
      apply (frule tcbs_of_aligned')
       apply (simp add:invs_pspace_aligned')
      apply (frule tcbs_of_cte_wp_at_caller)
@@ -3103,6 +3080,11 @@ lemma fastpath_reply_recv_ccorres:
                            invs_valid_pde_mappings' obj_at_tcbs_of
                     dest!: isValidVTableRootD)
      apply (frule invs_mdb')
+     apply (frule invs_valid_objs')
+     apply (frule invs_valid_bitmaps)
+     apply (frule valid_bitmaps_bitmapQ_no_L1_orphans)
+     apply (frule invs_pspace_aligned')
+     apply (frule invs_pspace_distinct')
 
      apply (clarsimp simp: cte_wp_at_ctes_of tcbSlots cte_level_bits_def
                            makeObject_cte isValidVTableRoot_def
@@ -3110,10 +3092,10 @@ lemma fastpath_reply_recv_ccorres:
                            pde_stored_asid_def to_bool_def
                            valid_mdb'_def valid_tcb_state'_def
                            word_le_nat_alt[symmetric] length_msgRegisters)
-     apply (frule ko_at_valid_ep', fastforce)
      apply (rule conjI)
-      subgoal (* dest thread domain \<le> maxDomain *)
-       by (drule (1) tcbs_of_valid_tcb'[OF invs_valid_objs'], solves \<open>clarsimp simp: valid_tcb'_def\<close>)
+      apply (fastforce dest: tcbs_of_valid_tcb' simp: valid_tcb'_def opt_map_def
+                      split: option.splits)
+     apply (frule ko_at_valid_ep', fastforce)
      apply clarsimp
      apply (safe del: notI disjE)[1]
        apply (simp add: isSendEP_def valid_ep'_def tcb_at_invs'
diff --git a/proof/crefine/ARM/Fastpath_Equiv.thy b/proof/crefine/ARM/Fastpath_Equiv.thy
index 036a334477..1c138569b5 100644
--- a/proof/crefine/ARM/Fastpath_Equiv.thy
+++ b/proof/crefine/ARM/Fastpath_Equiv.thy
@@ -31,13 +31,9 @@ lemma getEndpoint_obj_at':
 
 lemmas setEndpoint_obj_at_tcb' = setEndpoint_obj_at'_tcb
 
-lemma tcbSchedEnqueue_tcbContext[wp]:
-  "\<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>
-     tcbSchedEnqueue t'
-   \<lbrace>\<lambda>rv. obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
-  apply (rule tcbSchedEnqueue_obj_at_unchangedT[OF all_tcbI])
-  apply simp
-  done
+crunches tcbSchedEnqueue
+  for tcbContext[wp]: "obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t"
+  (simp: tcbQueuePrepend_def)
 
 lemma setCTE_tcbContext:
   "\<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>
@@ -50,19 +46,17 @@ lemma setCTE_tcbContext:
 context begin interpretation Arch . (*FIXME: arch_split*)
 
 lemma setThreadState_tcbContext:
- "\<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>
-    setThreadState a b
-  \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
-  apply (rule setThreadState_obj_at_unchanged)
-  apply (clarsimp simp: atcbContext_def)+
+ "setThreadState st tptr \<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
+  unfolding setThreadState_def rescheduleRequired_def
+  apply (wpsimp wp: threadSet_wp hoare_drop_imps)
+  apply (fastforce simp: obj_at'_def objBits_simps projectKOs  atcbContext_def ps_clear_upd)
   done
 
 lemma setBoundNotification_tcbContext:
- "\<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>
-    setBoundNotification a b
-  \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
-  apply (rule setBoundNotification_obj_at_unchanged)
-  apply (clarsimp simp: atcbContext_def)+
+ "setBoundNotification ntfnPtr tptr \<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
+  unfolding setBoundNotification_def
+  apply (wpsimp wp: threadSet_wp hoare_drop_imps)
+  apply (fastforce simp: obj_at'_def objBits_simps projectKOs)
   done
 
 declare comp_apply [simp del]
@@ -127,13 +121,15 @@ lemma of_bl_from_bool:
 
 lemma dmo_clearExMonitor_setCurThread_swap:
   "(do _ \<leftarrow> doMachineOp ARM.clearExMonitor;
-               setCurThread thread
-            od)
-    = (do _ \<leftarrow> setCurThread thread;
-            doMachineOp ARM.clearExMonitor od)"
-  apply (simp add: setCurThread_def doMachineOp_def split_def)
-  apply (rule oblivious_modify_swap[symmetric])
-  apply (intro oblivious_bind, simp_all)
+       setCurThread thread
+    od)
+   = (do _ \<leftarrow> setCurThread thread;
+         doMachineOp ARM.clearExMonitor
+      od)"
+  apply (clarsimp simp: ARM.clearExMonitor_def)
+  apply (simp add: doMachineOp_modify)
+  apply (rule oblivious_modify_swap)
+  apply (fastforce intro: oblivious_bind simp: setCurThread_def idleThreadNotQueued_def)
   done
 
 lemma pd_at_asid_inj':
@@ -508,11 +504,39 @@ lemma setThreadState_runnable_bitmap_inv:
 crunches curDomain
   for (no_fail) no_fail[intro!, wp, simp]
 
+lemma setThreadState_tcbDomain_tcbPriority_obj_at'[wp]:
+  "setThreadState ts t \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb) (tcbPriority tcb)) t'\<rbrace>"
+  unfolding setThreadState_def rescheduleRequired_def tcbSchedEnqueue_def tcbQueuePrepend_def
+  apply (wpsimp wp: threadSet_wp hoare_drop_imps threadGet_wp simp: setQueue_def bitmap_fun_defs)
+  apply (fastforce simp: obj_at'_def st_tcb_at'_def objBits_simps projectKOs)
+  done
+
+lemma setThreadState_tcbQueued_obj_at'[wp]:
+  "setThreadState ts t \<lbrace>obj_at' (\<lambda>tcb. P (tcbQueued tcb)) t'\<rbrace>"
+  unfolding setThreadState_def rescheduleRequired_def tcbSchedEnqueue_def tcbQueuePrepend_def
+  apply (wpsimp wp: threadSet_wp hoare_drop_imps threadGet_wp simp: setQueue_def bitmap_fun_defs)
+  apply (fastforce simp: obj_at'_def st_tcb_at'_def objBits_simps projectKOs)
+  done
+
+lemma setThreadState_tcbFault_obj_at'[wp]:
+  "setThreadState ts t \<lbrace>obj_at' (\<lambda>tcb. P (tcbFault tcb)) t'\<rbrace>"
+  unfolding setThreadState_def rescheduleRequired_def tcbSchedEnqueue_def tcbQueuePrepend_def
+  apply (wpsimp wp: threadSet_wp hoare_drop_imps threadGet_wp simp: setQueue_def bitmap_fun_defs)
+  apply (fastforce simp: obj_at'_def st_tcb_at'_def objBits_simps projectKOs)
+  done
+
+lemma setThreadState_tcbArch_obj_at'[wp]:
+  "setThreadState ts t \<lbrace>obj_at' (\<lambda>tcb. P (tcbArch tcb)) t'\<rbrace>"
+  unfolding setThreadState_def rescheduleRequired_def tcbSchedEnqueue_def tcbQueuePrepend_def
+  apply (wpsimp wp: threadSet_wp hoare_drop_imps threadGet_wp simp: setQueue_def bitmap_fun_defs)
+  apply (fastforce simp: obj_at'_def st_tcb_at'_def objBits_simps projectKOs)
+  done
+
 lemma fastpath_callKernel_SysCall_corres:
   "monadic_rewrite True False
          (invs' and ct_in_state' ((=) Running)
                 and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)
-                and (\<lambda>s. ksDomainTime s \<noteq> 0))
+                and (\<lambda>s. ksDomainTime s \<noteq> 0) and ready_qs_runnable)
      (callKernel (SyscallEvent SysCall)) (fastpaths SysCall)"
   supply if_cong[cong] option.case_cong[cong] if_split[split del]
   supply empty_fail_getMRs[wp] (* FIXME *)
@@ -669,22 +693,18 @@ lemma fastpath_callKernel_SysCall_corres:
                            apply wp[1]
                           apply (simp cong: if_cong HOL.conj_cong add: if_bool_simps)
                           apply (simp_all only:)[5]
-                          apply ((wp setThreadState_oa_queued[of _ "\<lambda>a _ _. \<not> a"]
-                                     setThreadState_obj_at_unchanged
-                                     asUser_obj_at_unchanged mapM_x_wp'
+                          apply ((wp asUser_obj_at_unchanged mapM_x_wp'
                                      sts_st_tcb_at'_cases
                                      setThreadState_no_sch_change
                                      setEndpoint_obj_at_tcb'
                                      fastpathBestSwitchCandidate_lift[where f="setThreadState f t" for f t]
-                                     setThreadState_oa_queued
                                      fastpathBestSwitchCandidate_lift[where f="asUser t f" for f t]
                                      fastpathBestSwitchCandidate_lift[where f="setEndpoint a b" for a b]
                                      lookupBitmapPriority_lift
                                      setThreadState_runnable_bitmap_inv
                                      getEndpoint_obj_at'
-                                   | simp add: setMessageInfo_def
+                                   | simp add: setMessageInfo_def obj_at'_conj
                                    | wp (once) hoare_vcg_disj_lift)+)
-
                    apply (simp add: setThreadState_runnable_simp
                                     getThreadCallerSlot_def getThreadReplySlot_def
                                     locateSlot_conv bind_assoc)
@@ -791,8 +811,6 @@ lemma fastpath_callKernel_SysCall_corres:
    prefer 2
    apply normalise_obj_at'
   apply clarsimp
-  apply (frule_tac t="blockedThread" in valid_queues_not_runnable_not_queued, assumption)
-  subgoal by (fastforce simp: st_tcb_at'_def elim: obj_at'_weakenE)
   apply (subgoal_tac "fastpathBestSwitchCandidate blockedThread s")
    prefer 2
    apply (rule_tac ttcb=tcbb and ctcb=tcb in fastpathBestSwitchCandidateI)
@@ -801,6 +819,9 @@ lemma fastpath_callKernel_SysCall_corres:
   apply (clarsimp simp: st_tcb_at'_def obj_at'_def objBits_simps projectKOs valid_mdb'_def
                         valid_mdb_ctes_def inj_case_bool
                  split: bool.split)+
+  apply (clarsimp simp: ready_qs_runnable_def)
+  apply (drule_tac x=blockedThread in spec)
+  apply (clarsimp simp: obj_at'_def projectKOs st_tcb_at'_def objBits_simps)
   done
 
 lemma capability_case_Null_ReplyCap:
@@ -957,14 +978,16 @@ crunch tcbContext[wp]: possibleSwitchTo "obj_at' (\<lambda>tcb. P ( (atcbContext
 crunch only_cnode_caps[wp]: doFaultTransfer "\<lambda>s. P (only_cnode_caps (ctes_of s))"
   (wp: crunch_wps simp: crunch_simps)
 
+(* FIXME: monadic_rewrite_l does not work with stateAssert here *)
 lemma tcbSchedDequeue_rewrite_not_queued:
   "monadic_rewrite True False (tcb_at' t and obj_at' (Not \<circ> tcbQueued) t)
      (tcbSchedDequeue t) (return ())"
-  apply (simp add: tcbSchedDequeue_def when_def)
-  apply (monadic_rewrite_l monadic_rewrite_if_l_False \<open>wp threadGet_const\<close>)
-   apply (monadic_rewrite_symb_exec_l, rule monadic_rewrite_refl)
-   apply wp+
-  apply clarsimp
+  apply (simp add: tcbSchedDequeue_def)
+  apply wp_pre
+  apply monadic_rewrite_symb_exec_l
+    apply (monadic_rewrite_symb_exec_l_known False, simp)
+     apply (rule monadic_rewrite_refl)
+    apply (wpsimp wp: threadGet_const)+
   done
 
 lemma schedule_known_rewrite:
@@ -1003,7 +1026,7 @@ lemma schedule_known_rewrite:
                             \<open>wpsimp wp: Arch_switchToThread_obj_at_pre\<close>)
    (* remove no-ops *)
    apply simp
-   apply (repeat 9 \<open>rule monadic_rewrite_symb_exec_l\<close>) (* until switchToThread *)
+   apply (repeat 13 \<open>rule monadic_rewrite_symb_exec_l\<close>) (* until switchToThread *)
                               apply (rule monadic_rewrite_refl)
                              apply (wpsimp simp: isHighestPrio_def')+
   apply (clarsimp simp: ct_in_state'_def not_pred_tcb_at'_strengthen
@@ -1265,18 +1288,12 @@ crunches setThreadState, emptySlot, asUser
   (wp: obj_at_setObject2 crunch_wps
    simp: crunch_simps updateObject_default_def in_monad)
 
-lemma st_tcb_at_is_Reply_imp_not_tcbQueued: "\<And>s t.\<lbrakk> invs' s; st_tcb_at' isReply t s\<rbrakk> \<Longrightarrow> obj_at' (\<lambda>a. \<not> tcbQueued a) t s"
-  apply (clarsimp simp: invs'_def valid_state'_def valid_queues_def st_tcb_at'_def valid_queues_no_bitmap_def)
-  apply (rule all_prio_not_inQ_not_tcbQueued)
-  apply (clarsimp simp: obj_at'_def)
-  apply (erule_tac x="d" in allE)
-  apply (erule_tac x="p" in allE)
-  apply (erule conjE)
-  apply (erule_tac x="t" in ballE)
-   apply (clarsimp simp: obj_at'_def runnable'_def isReply_def)
-   apply (case_tac "tcbState obj")
-          apply ((clarsimp simp: inQ_def)+)[8]
-  apply (clarsimp simp: valid_queues'_def obj_at'_def)
+lemma st_tcb_at_is_Reply_imp_not_tcbQueued:
+  "\<And>s t. \<lbrakk> ready_qs_runnable s; st_tcb_at' isReply t s\<rbrakk>  \<Longrightarrow> obj_at' (\<lambda>tcb. \<not> tcbQueued tcb) t s"
+  apply (clarsimp simp: ready_qs_runnable_def)
+  apply (drule_tac x=t in spec)
+  apply (clarsimp simp: st_tcb_at'_def obj_at'_def isReply_def)
+  apply (case_tac "tcbState obj"; clarsimp)
   done
 
 lemma valid_objs_ntfn_at_tcbBoundNotification:
@@ -1332,7 +1349,7 @@ lemma tcbSchedEnqueue_tcbIPCBuffer:
   "\<lbrace>obj_at' (\<lambda>tcb. P (tcbIPCBuffer tcb)) t\<rbrace>
   tcbSchedEnqueue t'
   \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P (tcbIPCBuffer tcb)) t\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_when)
+  apply (simp add: tcbSchedEnqueue_def tcbQueuePrepend_def unless_when)
   apply (wp threadSet_obj_at' hoare_drop_imps threadGet_wp
         |simp split: if_split)+
   done
@@ -1358,10 +1375,20 @@ crunch obj_at'_tcbIPCBuffer[wp]: emptySlot "obj_at' (\<lambda>tcb. P (tcbIPCBuff
 crunches getBoundNotification
   for (no_fail) no_fail[intro!, wp, simp]
 
+lemma threadSet_tcb_at'[wp]:
+  "threadSet f t' \<lbrace>\<lambda>s. P (tcb_at' addr s)\<rbrace>"
+  apply (wpsimp wp: threadSet_wp)
+  apply (erule rsubst[where P=P])
+  by (clarsimp simp: obj_at'_def projectKOs ps_clear_upd objBits_simps)
+
+crunches rescheduleRequired, tcbSchedDequeue, setThreadState, setBoundNotification
+  for tcb''[wp]: "\<lambda>s. P (tcb_at' addr s)"
+  (wp: crunch_wps)
+
 lemma fastpath_callKernel_SysReplyRecv_corres:
   "monadic_rewrite True False
      (invs' and ct_in_state' ((=) Running) and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)
-         and cnode_caps_gsCNodes')
+         and cnode_caps_gsCNodes' and ready_qs_runnable)
      (callKernel (SyscallEvent SysReplyRecv)) (fastpaths SysReplyRecv)"
   including classic_wp_pre
   supply if_cong[cong] option.case_cong[cong]
@@ -1491,8 +1518,7 @@ lemma fastpath_callKernel_SysReplyRecv_corres:
                                             and thread=thread in possibleSwitchTo_rewrite))
                            | rule cteDeleteOne_replycap_rewrite
                            | rule monadic_rewrite_bind monadic_rewrite_refl
-                           | wp assert_inv mapM_x_wp'
-                                setThreadState_obj_at_unchanged
+                           | wp assert_inv mapM_x_wp' sts_valid_objs'
                                 asUser_obj_at_unchanged
                                 hoare_strengthen_post[OF _ obj_at_conj'[simplified atomize_conjL], rotated]
                                  lookupBitmapPriority_lift
@@ -1558,8 +1584,8 @@ lemma fastpath_callKernel_SysReplyRecv_corres:
                                | wps)+)[3]
                     apply (simp cong: rev_conj_cong)
                     apply (wpsimp wp: setThreadState_tcbContext[simplified comp_apply]
-                                      setThreadState_oa_queued user_getreg_rv
-                                      setThreadState_no_sch_change setThreadState_obj_at_unchanged
+                                      user_getreg_rv
+                                      setThreadState_no_sch_change sts_valid_objs'
                                       sts_st_tcb_at'_cases sts_bound_tcb_at'
                                       fastpathBestSwitchCandidate_lift[where f="setThreadState s t" for s t]
                                       hoare_weak_lift_imp hoare_vcg_all_lift hoare_vcg_imp_lift
@@ -1567,8 +1593,7 @@ lemma fastpath_callKernel_SysReplyRecv_corres:
                                       hoare_vcg_ex_lift
                           | wps)+
                            apply (strengthen imp_consequent[where Q="tcb_at' t s" for t s])
-                           apply ((wp setThreadState_oa_queued user_getreg_rv setThreadState_no_sch_change
-                                      setThreadState_obj_at_unchanged
+                           apply ((wp user_getreg_rv setThreadState_no_sch_change
                                       sts_st_tcb_at'_cases sts_bound_tcb_at'
                                       emptySlot_obj_at'_not_queued emptySlot_obj_at_ep
                                       emptySlot_tcbContext[simplified comp_apply]
@@ -1742,7 +1767,9 @@ lemma fastpath_callKernel_SysReplyRecv_corres:
   apply (clarsimp simp: obj_at_tcbs_of tcbSlots
                         cte_level_bits_def)
   apply (frule(1) st_tcb_at_is_Reply_imp_not_tcbQueued)
-  apply (auto simp: obj_at_tcbs_of tcbSlots
+  apply (frule invs_pspace_aligned')
+  apply (frule invs_pspace_distinct')
+  apply (auto simp: obj_at_tcbs_of tcbSlots projectKOs
                         cte_level_bits_def)
   done
 
diff --git a/proof/crefine/ARM/Finalise_C.thy b/proof/crefine/ARM/Finalise_C.thy
index d37db8dded..ddcfe445e6 100644
--- a/proof/crefine/ARM/Finalise_C.thy
+++ b/proof/crefine/ARM/Finalise_C.thy
@@ -17,6 +17,108 @@ declare if_split [split del]
 definition
   "option_map2 f m = option_map f \<circ> m"
 
+definition ksReadyQueues_head_end_2 :: "(domain \<times> priority \<Rightarrow> ready_queue) \<Rightarrow> bool" where
+  "ksReadyQueues_head_end_2 qs \<equiv>
+     \<forall>d p. tcbQueueHead (qs (d, p)) \<noteq> None \<longleftrightarrow> tcbQueueEnd (qs (d, p)) \<noteq> None"
+
+abbreviation "ksReadyQueues_head_end s \<equiv> ksReadyQueues_head_end_2 (ksReadyQueues s)"
+
+lemmas ksReadyQueues_head_end_def = ksReadyQueues_head_end_2_def
+
+lemma ksReadyQueues_asrt_ksReadyQueues_head_end:
+  "ksReadyQueues_asrt s \<Longrightarrow> ksReadyQueues_head_end s"
+  by (fastforce dest: tcbQueueHead_iff_tcbQueueEnd
+                simp: ready_queue_relation_def ksReadyQueues_asrt_def ksReadyQueues_head_end_def)
+
+lemma tcbSchedEnqueue_ksReadyQueues_head_end[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>ksReadyQueues_head_end\<rbrace>"
+  unfolding tcbSchedEnqueue_def tcbQueuePrepend_def setQueue_def
+  apply (wpsimp wp: threadSet_wp threadGet_wp simp: bitmap_fun_defs)
+  apply (clarsimp simp: tcbQueueEmpty_def obj_at'_def ksReadyQueues_head_end_def split: if_splits)
+  done
+
+lemma ksReadyQueues_head_end_ksSchedulerAction_update[simp]:
+  "ksReadyQueues_head_end (s\<lparr>ksSchedulerAction := ChooseNewThread\<rparr>) = ksReadyQueues_head_end s"
+  by (simp add: ksReadyQueues_head_end_def)
+
+crunches rescheduleRequired
+  for ksReadyQueues_head_end[wp]: ksReadyQueues_head_end
+
+lemma setThreadState_ksReadyQueues_head_end[wp]:
+  "setThreadState ts tcbPtr \<lbrace>ksReadyQueues_head_end\<rbrace>"
+  unfolding setThreadState_def
+  by (wpsimp wp: threadSet_wp threadGet_wp simp: bitmap_fun_defs)
+
+definition ksReadyQueues_head_end_tcb_at'_2 ::
+  "(domain \<times> priority \<Rightarrow> ready_queue) \<Rightarrow> (obj_ref \<rightharpoonup> tcb) \<Rightarrow> bool" where
+  "ksReadyQueues_head_end_tcb_at'_2 qs tcbs \<equiv>
+     \<forall>d p. (\<forall>head. tcbQueueHead (qs (d, p)) = Some head \<longrightarrow> tcbs head \<noteq> None)
+           \<and> (\<forall>end. tcbQueueEnd (qs (d, p)) = Some end \<longrightarrow> tcbs end \<noteq> None)"
+
+abbreviation "ksReadyQueues_head_end_tcb_at' s \<equiv>
+  ksReadyQueues_head_end_tcb_at'_2 (ksReadyQueues s) (tcbs_of' s)"
+
+lemmas ksReadyQueues_head_end_tcb_at'_def = ksReadyQueues_head_end_tcb_at'_2_def
+
+lemma ksReadyQueues_asrt_ksReadyQueues_head_end_tcb_at':
+  "\<lbrakk>ksReadyQueues_asrt s; pspace_aligned' s; pspace_distinct' s\<rbrakk>
+   \<Longrightarrow> ksReadyQueues_head_end_tcb_at' s"
+  apply (clarsimp simp: ready_queue_relation_def ksReadyQueues_asrt_def
+                        ksReadyQueues_head_end_tcb_at'_def)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply (clarsimp simp: list_queue_relation_def)
+  apply (intro conjI impI allI)
+   apply (case_tac "ts = []", clarsimp)
+   apply (fastforce dest!: heap_path_head hd_in_set
+                     simp: opt_pred_def  tcbQueueEmpty_def split: option.splits)
+  apply (fastforce simp: queue_end_valid_def opt_pred_def tcbQueueEmpty_def
+                  split: option.splits)
+  done
+
+lemma tcbSchedEnqueue_ksReadyQueues_head_end_tcb_at'[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>ksReadyQueues_head_end_tcb_at'\<rbrace>"
+  unfolding tcbSchedEnqueue_def tcbQueuePrepend_def setQueue_def
+  apply (wpsimp wp: threadSet_wp threadGet_wp simp: bitmap_fun_defs)
+  apply (clarsimp simp: ksReadyQueues_head_end_tcb_at'_def split: if_splits)
+  done
+
+lemma ksReadyQueues_head_end_tcb_at'_ksSchedulerAction_update[simp]:
+  "ksReadyQueues_head_end_tcb_at' (s\<lparr>ksSchedulerAction := ChooseNewThread\<rparr>)
+   = ksReadyQueues_head_end_tcb_at' s"
+  by (simp add: ksReadyQueues_head_end_tcb_at'_def)
+
+crunches rescheduleRequired
+  for ksReadyQueues_head_end_tcb_at'[wp]: ksReadyQueues_head_end_tcb_at'
+
+lemma setThreadState_ksReadyQueues_head_end_tcb_at'[wp]:
+  "setThreadState ts tcbPtr \<lbrace>ksReadyQueues_head_end_tcb_at'\<rbrace>"
+  unfolding setThreadState_def
+  apply (wpsimp wp: threadSet_wp)
+  apply (fastforce simp: ksReadyQueues_head_end_tcb_at'_def split: if_splits)
+  done
+
+lemma head_end_ksReadyQueues_':
+  "\<lbrakk> (s, s') \<in> rf_sr; ksReadyQueues_head_end s; ksReadyQueues_head_end_tcb_at' s;
+     pspace_aligned' s; pspace_distinct' s;
+     d \<le> maxDomain; p \<le> maxPriority \<rbrakk>
+   \<Longrightarrow> head_C (index (ksReadyQueues_' (globals s')) (cready_queues_index_to_C d p)) = NULL
+       \<longleftrightarrow> end_C (index (ksReadyQueues_' (globals s')) (cready_queues_index_to_C d p)) = NULL"
+  apply (frule (2) rf_sr_ctcb_queue_relation[where d=d and p=p])
+  apply (clarsimp simp: ksReadyQueues_head_end_def)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply (clarsimp simp: ksReadyQueues_head_end_tcb_at'_def)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply (clarsimp simp: ctcb_queue_relation_def option_to_ctcb_ptr_def split: option.splits)
+  apply (rename_tac "end" head end_tcb head_tcb)
+  apply (prop_tac "tcb_at' head s \<and> tcb_at' end s")
+   apply (fastforce intro!: aligned'_distinct'_ko_wp_at'I
+                      simp: obj_at'_real_def opt_map_def split: option.splits)
+  apply (fastforce dest: tcb_at_not_NULL)
+  done
+
 lemma tcbSchedEnqueue_cslift_spec:
   "\<forall>s. \<Gamma>\<turnstile>\<^bsub>/UNIV\<^esub> \<lbrace>s. \<exists>d v. option_map2 tcbPriority_C (cslift s) \<acute>tcb = Some v
                        \<and> unat v \<le> numPriorities
@@ -28,7 +130,9 @@ lemma tcbSchedEnqueue_cslift_spec:
                                            \<noteq> None
                              \<and> option_map2 tcbDomain_C (cslift s)
                                    (head_C (index \<acute>ksReadyQueues (unat (d*0x100 + v))))
-                                           \<noteq> None)\<rbrace>
+                                           \<noteq> None)
+                       \<and> (head_C (index \<acute>ksReadyQueues (unat (d * 0x100 + v))) \<noteq> NULL
+                          \<longleftrightarrow> end_C (index \<acute>ksReadyQueues (unat (d * 0x100 + v))) \<noteq> NULL)\<rbrace>
        Call tcbSchedEnqueue_'proc
       {s'. option_map2 tcbEPNext_C (cslift s') = option_map2 tcbEPNext_C (cslift s)
            \<and> option_map2 tcbEPPrev_C (cslift s') = option_map2 tcbEPPrev_C (cslift s)
@@ -45,8 +149,8 @@ lemma tcbSchedEnqueue_cslift_spec:
   apply (rule conjI)
    apply (clarsimp simp: typ_heap_simps cong: if_cong)
    apply (simp split: if_split)
-  apply (clarsimp simp: typ_heap_simps if_Some_helper cong: if_cong)
-  by (simp split: if_split)
+  by (auto simp: typ_heap_simps' if_Some_helper numPriorities_def
+           cong: if_cong split: if_splits)
 
 lemma setThreadState_cslift_spec:
   "\<forall>s. \<Gamma>\<turnstile>\<^bsub>/UNIV\<^esub> \<lbrace>s. s \<Turnstile>\<^sub>c \<acute>tptr \<and> (\<forall>x. ksSchedulerAction_' (globals s) = tcb_Ptr x
@@ -141,8 +245,9 @@ lemma ctcb_relation_tcbPriority_maxPriority_numPriorities:
   done
 
 lemma tcbSchedEnqueue_cslift_precond_discharge:
-  "\<lbrakk> (s, s') \<in> rf_sr; obj_at' (P :: tcb \<Rightarrow> bool) x s;
-        valid_queues s; valid_objs' s \<rbrakk> \<Longrightarrow>
+  "\<lbrakk> (s, s') \<in> rf_sr; obj_at' (P :: tcb \<Rightarrow> bool) x s; valid_objs' s ;
+     ksReadyQueues_head_end s; ksReadyQueues_head_end_tcb_at' s;
+     pspace_aligned' s; pspace_distinct' s\<rbrakk> \<Longrightarrow>
    (\<exists>d v. option_map2 tcbPriority_C (cslift s') (tcb_ptr_to_ctcb_ptr x) = Some v
         \<and> unat v < numPriorities
         \<and> option_map2 tcbDomain_C (cslift s') (tcb_ptr_to_ctcb_ptr x) = Some d
@@ -153,31 +258,49 @@ lemma tcbSchedEnqueue_cslift_precond_discharge:
                                     \<noteq> None
                   \<and> option_map2 tcbDomain_C (cslift s')
                      (head_C (index (ksReadyQueues_' (globals s')) (unat (d*0x100 + v))))
-                                    \<noteq> None))"
+                                    \<noteq> None)
+        \<and> (head_C (index (ksReadyQueues_' (globals s')) (unat (d * 0x100 + v))) \<noteq> NULL
+           \<longleftrightarrow> end_C (index (ksReadyQueues_' (globals s')) (unat (d * 0x100 + v))) \<noteq> NULL))"
   apply (drule(1) obj_at_cslift_tcb)
   apply (clarsimp simp: typ_heap_simps' option_map2_def)
+  apply (rename_tac tcb tcb')
   apply (frule_tac t=x in valid_objs'_maxPriority, fastforce simp: obj_at'_def)
   apply (frule_tac t=x in valid_objs'_maxDomain, fastforce simp: obj_at'_def)
   apply (drule_tac P="\<lambda>tcb. tcbPriority tcb \<le> maxPriority" in obj_at_ko_at2', simp)
   apply (drule_tac P="\<lambda>tcb. tcbDomain tcb \<le> maxDomain" in obj_at_ko_at2', simp)
   apply (simp add: ctcb_relation_tcbDomain_maxDomain_numDomains
                    ctcb_relation_tcbPriority_maxPriority_numPriorities)
-  apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko"
-              in rf_sr_sched_queue_relation)
+  apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb" in rf_sr_ctcb_queue_relation)
     apply (simp add: maxDom_to_H maxPrio_to_H)+
+  apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb" in head_end_ksReadyQueues_', fastforce+)
   apply (simp add: cready_queues_index_to_C_def2 numPriorities_def le_maxDomain_eq_less_numDomains)
   apply (clarsimp simp: ctcb_relation_def)
-  apply (frule arg_cong[where f=unat], subst(asm) unat_ucast_8_32)
-  apply (frule tcb_queue'_head_end_NULL)
-   apply (erule conjunct1[OF valid_queues_valid_q])
-  apply (frule(1) tcb_queue_relation_qhead_valid')
-   apply (simp add: valid_queues_valid_q)
-  apply (clarsimp simp: h_t_valid_clift_Some_iff)
+  apply (frule arg_cong[where f=unat], subst(asm) unat_ucast_up_simp, simp)
+  apply (frule (3) head_end_ksReadyQueues_', fastforce+)
+  apply (clarsimp simp: ksReadyQueues_head_end_def)
+  apply (drule_tac x="tcbDomain tcb" in spec)
+  apply (drule_tac x="tcbPriority tcb" in spec)
+  apply (prop_tac "\<not> tcbQueueEmpty ((ksReadyQueues s (tcbDomain tcb, tcbPriority tcb)))")
+   apply (clarsimp simp: tcbQueueEmpty_def ctcb_queue_relation_def option_to_ctcb_ptr_def
+                  split: option.splits)
+  apply (clarsimp simp: ksReadyQueues_head_end_tcb_at'_def)
+  apply (drule_tac x="tcbDomain tcb" in spec)
+  apply (drule_tac x="tcbPriority tcb" in spec)
+  apply clarsimp
+  apply (clarsimp simp: tcbQueueEmpty_def)
+  apply (rename_tac head "end" head_tcb end_tcb)
+  apply (prop_tac "tcb_at' head s")
+   apply (fastforce intro: aligned'_distinct'_ko_wp_at'I
+                     simp: obj_at'_real_def opt_map_def split: option.splits)
+  apply (frule_tac thread=head in obj_at_cslift_tcb)
+   apply fastforce
+  apply (clarsimp dest: obj_at_cslift_tcb simp: ctcb_queue_relation_def option_to_ctcb_ptr_def)
   done
 
 lemma cancel_all_ccorres_helper:
   "ccorres dc xfdc
-      (\<lambda>s. valid_objs' s \<and> valid_queues s
+      (\<lambda>s. valid_objs' s \<and> pspace_aligned' s \<and> pspace_distinct' s
+             \<and> ksReadyQueues_head_end s \<and> ksReadyQueues_head_end_tcb_at' s
              \<and> (\<forall>t\<in>set ts. tcb_at' t s \<and> t \<noteq> 0)
              \<and> sch_act_wf (ksSchedulerAction s) s)
       {s'. \<exists>p. ep_queue_relation (cslift s') ts
@@ -232,11 +355,11 @@ next
            apply (erule cmap_relationE1 [OF cmap_relation_tcb])
             apply (erule ko_at_projectKO_opt)
            apply (fastforce intro: typ_heap_simps)
-          apply (wp sts_running_valid_queues | simp)+
+          apply (wp sts_valid_objs' | simp)+
         apply (rule ceqv_refl)
        apply (rule "Cons.hyps")
       apply (wp sts_valid_objs' sts_sch_act sch_act_wf_lift hoare_vcg_const_Ball_lift
-                sts_running_valid_queues sts_st_tcb' setThreadState_oa_queued | simp)+
+                sts_st_tcb' | simp)+
 
      apply (vcg exspec=setThreadState_cslift_spec exspec=tcbSchedEnqueue_cslift_spec)
     apply (clarsimp simp: tcb_at_not_NULL Collect_const_mem valid_tcb_state'_def
@@ -250,16 +373,13 @@ next
                            st_tcb_at'_def
                     split: scheduler_action.split_asm)
      apply (rename_tac word)
-     apply (frule_tac x=word in tcbSchedEnqueue_cslift_precond_discharge)
-        apply simp
-       apply clarsimp
-      apply clarsimp
-     apply clarsimp
+     apply (frule_tac x=word in tcbSchedEnqueue_cslift_precond_discharge; clarsimp?)
+     apply simp
     apply clarsimp
     apply (rule conjI)
      apply (frule(3) tcbSchedEnqueue_cslift_precond_discharge)
      apply clarsimp
-    apply clarsimp
+    apply clarsimp+
     apply (subst ep_queue_relation_shift, fastforce)
     apply (drule_tac x="tcb_ptr_to_ctcb_ptr thread"
                 in fun_cong)+
@@ -268,11 +388,17 @@ next
     done
 qed
 
+crunches setEndpoint, setNotification
+  for ksReadyQueues_head_end[wp]: ksReadyQueues_head_end
+  and ksReadyQueues_head_end_tcb_at'[wp]: ksReadyQueues_head_end_tcb_at'
+  (simp: updateObject_default_def)
+
 lemma cancelAllIPC_ccorres:
   "ccorres dc xfdc
-   (invs') (UNIV \<inter> {s. epptr_' s = Ptr epptr}) []
+   invs' (UNIV \<inter> {s. epptr_' s = Ptr epptr}) []
    (cancelAllIPC epptr) (Call cancelAllIPC_'proc)"
   apply (cinit lift: epptr_')
+   apply (rule ccorres_stateAssert)
    apply (rule ccorres_symb_exec_l [OF _ getEndpoint_inv _ empty_fail_getEndpoint])
     apply (rule_tac xf'=ret__unsigned_'
                 and val="case ep of IdleEP \<Rightarrow> scast EPState_Idle
@@ -287,7 +413,7 @@ lemma cancelAllIPC_ccorres:
        apply (simp add: cendpoint_relation_def Let_def
                  split: endpoint.split_asm)
       apply ceqv
-     apply (rule_tac A="invs' and ko_at' ep epptr"
+     apply (rule_tac A="invs' and ksReadyQueues_asrt and ko_at' ep epptr"
               in ccorres_guard_imp2[where A'=UNIV])
       apply wpc
         apply (rename_tac list)
@@ -327,12 +453,11 @@ lemma cancelAllIPC_ccorres:
              apply ceqv
             apply (ctac add: rescheduleRequired_ccorres)
            apply (wp weak_sch_act_wf_lift_linear
-                     cancelAllIPC_mapM_x_valid_queues
                   | simp)+
               apply (rule mapM_x_wp', wp)+
              apply (wp sts_st_tcb')
              apply (clarsimp split: if_split)
-            apply (rule mapM_x_wp', wp)+
+            apply (rule mapM_x_wp', wp sts_valid_objs')+
            apply (clarsimp simp: valid_tcb_state'_def)
           apply (simp add: guard_is_UNIV_def)
          apply (wp set_ep_valid_objs' hoare_vcg_const_Ball_lift
@@ -374,22 +499,26 @@ lemma cancelAllIPC_ccorres:
             apply (rule cancel_all_ccorres_helper)
            apply ceqv
           apply (ctac add: rescheduleRequired_ccorres)
-         apply (wp cancelAllIPC_mapM_x_valid_queues)
-         apply (wp mapM_x_wp' weak_sch_act_wf_lift_linear
+         apply (wp mapM_x_wp' weak_sch_act_wf_lift_linear sts_valid_objs'
                    sts_st_tcb' | clarsimp simp: valid_tcb_state'_def split: if_split)+
         apply (simp add: guard_is_UNIV_def)
        apply (wp set_ep_valid_objs' hoare_vcg_const_Ball_lift
                  weak_sch_act_wf_lift_linear)
       apply vcg
-     apply (clarsimp simp: valid_ep'_def invs_valid_objs' invs_queues)
+     apply (clarsimp simp: valid_ep'_def invs_valid_objs')
      apply (rule cmap_relationE1[OF cmap_relation_ep], assumption)
       apply (erule ko_at_projectKO_opt)
      apply (frule obj_at_valid_objs', clarsimp+)
-     apply (clarsimp simp: projectKOs valid_obj'_def valid_ep'_def)
-     subgoal by (auto simp: typ_heap_simps cendpoint_relation_def
-                       Let_def tcb_queue_relation'_def
-                       invs_valid_objs' valid_objs'_maxDomain valid_objs'_maxPriority
-               intro!: obj_at_conj')
+     apply (clarsimp simp: valid_obj'_def valid_ep'_def)
+     apply (frule invs_pspace_aligned')
+     apply (frule invs_pspace_distinct')
+     apply (frule ksReadyQueues_asrt_ksReadyQueues_head_end)
+     apply (frule (2) ksReadyQueues_asrt_ksReadyQueues_head_end_tcb_at')
+     subgoal
+       by (auto simp: typ_heap_simps cendpoint_relation_def
+                      Let_def tcb_queue_relation'_def projectKOs
+                      invs_valid_objs' valid_objs'_maxDomain valid_objs'_maxPriority
+              intro!: obj_at_conj')
     apply (clarsimp simp: guard_is_UNIV_def)
    apply (wp getEndpoint_wp)
   apply clarsimp
@@ -397,9 +526,10 @@ lemma cancelAllIPC_ccorres:
 
 lemma cancelAllSignals_ccorres:
   "ccorres dc xfdc
-   (invs') (UNIV \<inter> {s. ntfnPtr_' s = Ptr ntfnptr}) []
+   invs' (UNIV \<inter> {s. ntfnPtr_' s = Ptr ntfnptr}) []
    (cancelAllSignals ntfnptr) (Call cancelAllSignals_'proc)"
   apply (cinit lift: ntfnPtr_')
+   apply (rule ccorres_stateAssert)
    apply (rule ccorres_symb_exec_l [OF _ get_ntfn_inv' _ empty_fail_getNotification])
     apply (rule_tac xf'=ret__unsigned_'
                 and val="case ntfnObj ntfn of IdleNtfn \<Rightarrow> scast NtfnState_Idle
@@ -414,7 +544,7 @@ lemma cancelAllSignals_ccorres:
        apply (simp add: cnotification_relation_def Let_def
                  split: ntfn.split_asm)
       apply ceqv
-     apply (rule_tac A="invs' and ko_at' ntfn ntfnptr"
+     apply (rule_tac A="invs' and ksReadyQueues_asrt and ko_at' ntfn ntfnptr"
               in ccorres_guard_imp2[where A'=UNIV])
       apply wpc
         apply (simp add: notification_state_defs ccorres_cond_iffs)
@@ -453,8 +583,7 @@ lemma cancelAllSignals_ccorres:
             apply (rule cancel_all_ccorres_helper)
            apply ceqv
           apply (ctac add: rescheduleRequired_ccorres)
-         apply (wp cancelAllIPC_mapM_x_valid_queues)
-         apply (wp mapM_x_wp' weak_sch_act_wf_lift_linear
+         apply (wp mapM_x_wp' weak_sch_act_wf_lift_linear sts_valid_objs'
                    sts_st_tcb' | clarsimp simp: valid_tcb_state'_def split: if_split)+
         apply (simp add: guard_is_UNIV_def)
        apply (wp set_ntfn_valid_objs' hoare_vcg_const_Ball_lift
@@ -464,11 +593,16 @@ lemma cancelAllSignals_ccorres:
      apply (rule cmap_relationE1[OF cmap_relation_ntfn], assumption)
       apply (erule ko_at_projectKO_opt)
      apply (frule obj_at_valid_objs', clarsimp+)
-     apply (clarsimp simp add: valid_obj'_def valid_ntfn'_def projectKOs)
-     subgoal by (auto simp: typ_heap_simps cnotification_relation_def
-                       Let_def tcb_queue_relation'_def
-                       invs_valid_objs' valid_objs'_maxDomain valid_objs'_maxPriority
-               intro!: obj_at_conj')
+     apply (clarsimp simp add: valid_obj'_def valid_ntfn'_def)
+     apply (frule invs_pspace_aligned')
+     apply (frule invs_pspace_distinct')
+     apply (frule ksReadyQueues_asrt_ksReadyQueues_head_end)
+     apply (frule (2) ksReadyQueues_asrt_ksReadyQueues_head_end_tcb_at')
+     subgoal
+       by (auto simp: typ_heap_simps cnotification_relation_def
+                      Let_def tcb_queue_relation'_def projectKOs
+                      invs_valid_objs' valid_objs'_maxDomain valid_objs'_maxPriority
+              intro!: obj_at_conj')
     apply (clarsimp simp: guard_is_UNIV_def)
    apply (wp getNotification_wp)
   apply clarsimp
@@ -515,16 +649,16 @@ lemma tcb_queue_relation2_concat:
 
 context kernel_m begin
 
-lemma setThreadState_ccorres_valid_queues'_simple:
-  "ccorres dc xfdc (\<lambda>s. tcb_at' thread s \<and> valid_queues' s \<and> \<not> runnable' st \<and> sch_act_simple s)
+lemma setThreadState_ccorres_simple:
+  "ccorres dc xfdc (\<lambda>s. tcb_at' thread s \<and> \<not> runnable' st \<and> sch_act_simple s)
    ({s'. (\<forall>cl fl. cthread_state_relation_lifted st (cl\<lparr>tsType_CL := ts_' s' && mask 4\<rparr>, fl))}
     \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr thread}) []
          (setThreadState st thread) (Call setThreadState_'proc)"
   apply (cinit lift: tptr_' cong add: call_ignore_cong)
     apply (ctac (no_vcg) add: threadSet_tcbState_simple_corres)
    apply (ctac add: scheduleTCB_ccorres_valid_queues'_simple)
-  apply (wp threadSet_valid_queues'_and_not_runnable')
-  apply (clarsimp simp: weak_sch_act_wf_def valid_queues'_def)
+  apply (wp threadSet_tcbState_st_tcb_at')
+  apply (fastforce simp: weak_sch_act_wf_def)
   done
 
 lemma updateRestartPC_ccorres:
@@ -540,9 +674,7 @@ lemma updateRestartPC_ccorres:
   done
 
 crunches updateRestartPC
-  for valid_queues'[wp]: valid_queues'
-  and sch_act_simple[wp]: sch_act_simple
-  and valid_queues[wp]: Invariants_H.valid_queues
+  for sch_act_simple[wp]: sch_act_simple
   and valid_objs'[wp]: valid_objs'
   and tcb_at'[wp]: "tcb_at' p"
 
@@ -586,21 +718,12 @@ lemma suspend_ccorres:
           apply (ctac (no_vcg) add: updateRestartPC_ccorres)
          apply (rule ccorres_return_Skip)
         apply ceqv
-       apply (ctac(no_vcg) add: setThreadState_ccorres_valid_queues'_simple)
-        apply (ctac add: tcbSchedDequeue_ccorres')
-       apply (rule_tac Q="\<lambda>_.
-                        (\<lambda>s. \<forall>t' d p. (t' \<in> set (ksReadyQueues s (d, p)) \<longrightarrow>
-                              obj_at' (\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d
-                                                           \<and> tcbPriority tcb = p) t' s \<and>
-                (t' \<noteq> thread \<longrightarrow> st_tcb_at' runnable' t' s)) \<and>
-                distinct (ksReadyQueues s (d, p))) and valid_queues' and valid_objs' and tcb_at' thread"
-              in hoare_post_imp)
+       apply (ctac(no_vcg) add: setThreadState_ccorres_simple)
+        apply (ctac add: tcbSchedDequeue_ccorres)
+       apply (rule_tac Q="\<lambda>_. valid_objs' and tcb_at' thread and pspace_aligned' and pspace_distinct'"
+                    in hoare_post_imp)
         apply clarsimp
-        apply (drule_tac x="t" in spec)
-        apply (drule_tac x=d in spec)
-        apply (drule_tac x=p in spec)
-        apply (clarsimp elim!: obj_at'_weakenE simp: inQ_def)
-       apply (wp sts_valid_queues_partial)[1]
+       apply (wp sts_valid_objs')[1]
       apply clarsimp
       apply (wpsimp simp: valid_tcb_state'_def)
      apply clarsimp
@@ -609,15 +732,13 @@ lemma suspend_ccorres:
     apply clarsimp
     apply (rule conseqPre, vcg)
     apply (rule subset_refl)
-  apply (rule hoare_strengthen_post)
+   apply (rule hoare_strengthen_post)
     apply (rule hoare_vcg_conj_lift)
      apply (rule hoare_vcg_conj_lift)
       apply (rule cancelIPC_sch_act_simple)
      apply (rule cancelIPC_tcb_at'[where t=thread])
     apply (rule delete_one_conc_fr.cancelIPC_invs)
-   apply (fastforce simp: invs_valid_queues' invs_queues invs_valid_objs'
-                          valid_tcb_state'_def)
-  apply clarsimp
+   apply (fastforce simp: invs_valid_objs' valid_tcb_state'_def)
   apply (auto simp: ThreadState_defs)
   done
 
diff --git a/proof/crefine/ARM/Interrupt_C.thy b/proof/crefine/ARM/Interrupt_C.thy
index 71b31a6b1f..1295d8af50 100644
--- a/proof/crefine/ARM/Interrupt_C.thy
+++ b/proof/crefine/ARM/Interrupt_C.thy
@@ -249,7 +249,7 @@ lemma decodeIRQHandlerInvocation_ccorres:
     apply (simp add: syscall_error_to_H_cases)
    apply simp
   apply (clarsimp simp: Collect_const_mem tcb_at_invs')
-  apply (clarsimp simp: invs_queues invs_valid_objs'
+  apply (clarsimp simp: invs_valid_objs'
                         ct_in_state'_def
                         ccap_rights_relation_def
                         mask_def[where n=4] ThreadState_defs)
@@ -265,7 +265,7 @@ lemma decodeIRQHandlerInvocation_ccorres:
                     excaps_map_def excaps_in_mem_def word_less_nat_alt hd_conv_nth
                     slotcap_in_mem_def valid_tcb_state'_def
              dest!: interpret_excaps_eq split: bool.splits)+
-     apply (auto dest: st_tcb_at_idle_thread' ctes_of_valid')[4]
+     apply (auto dest: st_tcb_at_idle_thread' ctes_of_valid')[6]
     apply (drule ctes_of_valid')
      apply fastforce
     apply (clarsimp simp add:valid_cap_simps' ARM.maxIRQ_def)
diff --git a/proof/crefine/ARM/Invoke_C.thy b/proof/crefine/ARM/Invoke_C.thy
index 024e10c7b8..16c9d309fb 100644
--- a/proof/crefine/ARM/Invoke_C.thy
+++ b/proof/crefine/ARM/Invoke_C.thy
@@ -79,15 +79,14 @@ lemma setDomain_ccorres:
                             and (\<lambda>s. curThread = ksCurThread s)"
               in hoare_strengthen_post)
       apply (wp threadSet_all_invs_but_sch_extra)
-     apply (clarsimp simp: valid_pspace_valid_objs' st_tcb_at_def[symmetric]
-                           sch_act_simple_def st_tcb_at'_def weak_sch_act_wf_def
-                    split: if_splits)
+     apply (fastforce simp: valid_pspace_valid_objs' st_tcb_at_def[symmetric]
+                            sch_act_simple_def st_tcb_at'_def weak_sch_act_wf_def
+                     split: if_splits)
     apply (simp add: guard_is_UNIV_def)
-   apply (rule_tac Q="\<lambda>_. invs' and tcb_at' t and sch_act_simple
-                          and (\<lambda>s. curThread = ksCurThread s \<and> (\<forall>p. t \<notin> set (ksReadyQueues s p)))"
+   apply (rule_tac Q="\<lambda>_. invs' and tcb_at' t and sch_act_simple and (\<lambda>s. curThread = ksCurThread s)"
             in hoare_strengthen_post)
     apply (wp weak_sch_act_wf_lift_linear tcbSchedDequeue_not_queued
-              tcbSchedDequeue_not_in_queue hoare_vcg_imp_lift hoare_vcg_all_lift)
+              hoare_vcg_imp_lift hoare_vcg_all_lift)
    apply (clarsimp simp: invs'_def valid_pspace'_def valid_state'_def)
   apply (fastforce simp: valid_tcb'_def tcb_cte_cases_def
                          invs'_def valid_state'_def valid_pspace'_def)
@@ -195,8 +194,8 @@ lemma decodeDomainInvocation_ccorres:
    apply clarsimp
    apply (vcg exspec=getSyscallArg_modifies)
 
-  apply (clarsimp simp: valid_tcb_state'_def invs_valid_queues' invs_valid_objs'
-                        invs_queues invs_sch_act_wf' ct_in_state'_def pred_tcb_at'
+  apply (clarsimp simp: valid_tcb_state'_def invs_valid_objs'
+                        invs_sch_act_wf' ct_in_state'_def pred_tcb_at'
                         rf_sr_ksCurThread word_sle_def word_sless_def sysargs_rel_to_n
                         mask_eq_iff_w2p mask_eq_iff_w2p word_size ThreadState_defs)
   apply (rule conjI)
@@ -206,7 +205,7 @@ lemma decodeDomainInvocation_ccorres:
    apply (drule_tac x="extraCaps ! 0" and P="\<lambda>v. valid_cap' (fst v) s" in bspec)
     apply (clarsimp simp: nth_mem interpret_excaps_test_null excaps_map_def)
    apply (clarsimp simp: valid_cap_simps' pred_tcb'_weakenE active_runnable')
-   apply (rule conjI)
+   apply (intro conjI; fastforce?)
     apply (fastforce simp: tcb_st_refs_of'_def elim:pred_tcb'_weakenE)
    apply (simp add: word_le_nat_alt unat_ucast unat_numDomains_to_H le_maxDomain_eq_less_numDomains)
   apply (clarsimp simp: ccap_relation_def cap_to_H_simps cap_thread_cap_lift)
@@ -750,15 +749,15 @@ lemma decodeCNodeInvocation_ccorres:
                               apply simp
                               apply (wp injection_wp_E[OF refl])
                               apply (rule hoare_post_imp_R)
-                               apply (rule_tac Q'="\<lambda>rv. valid_pspace' and valid_queues
+                               apply (rule_tac Q'="\<lambda>rv. valid_pspace'
                                                     and valid_cap' rv and valid_objs'
                                                          and tcb_at' thread and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)"
                                            in hoare_vcg_R_conj)
                                 apply (rule deriveCap_Null_helper[OF deriveCap_derived])
                                apply wp
                               apply (clarsimp simp: cte_wp_at_ctes_of)
-                              apply (simp add: is_derived'_def badge_derived'_def
-                                               valid_tcb_state'_def)
+                              apply (fastforce simp: is_derived'_def badge_derived'_def
+                                                     valid_tcb_state'_def)
                              apply (simp add: Collect_const_mem all_ex_eq_helper)
                              apply (vcg exspec=deriveCap_modifies)
                             apply wp
@@ -826,14 +825,14 @@ lemma decodeCNodeInvocation_ccorres:
                                   apply (simp add: conj_comms valid_tcb_state'_def)
                                   apply (wp injection_wp_E[OF refl])
                                   apply (rule hoare_post_imp_R)
-                                   apply (rule_tac Q'="\<lambda>rv. valid_pspace' and valid_queues
+                                   apply (rule_tac Q'="\<lambda>rv. valid_pspace'
                                                         and valid_cap' rv and valid_objs'
                                                              and tcb_at' thread and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)"
                                                in hoare_vcg_R_conj)
                                     apply (rule deriveCap_Null_helper [OF deriveCap_derived])
                                    apply wp
                                   apply (clarsimp simp: cte_wp_at_ctes_of)
-                                  apply (simp add: is_derived'_def badge_derived'_def)
+                                  apply (fastforce simp: is_derived'_def badge_derived'_def)
                                  apply (simp add: Collect_const_mem all_ex_eq_helper)
                                  apply (vcg exspec=deriveCap_modifies)
                                 apply (simp add: Collect_const_mem)
@@ -941,12 +940,14 @@ lemma decodeCNodeInvocation_ccorres:
                      apply (rule_tac Q'="\<lambda>a b. cte_wp_at' (\<lambda>x. True) a b \<and> invs' b \<and>
                        tcb_at' thread b  \<and> sch_act_wf (ksSchedulerAction b) b \<and> valid_tcb_state' Restart b
                        \<and> Q2 b" for Q2 in  hoare_post_imp_R)
-                       prefer 2
-                       apply (clarsimp simp:cte_wp_at_ctes_of)
-                       apply (drule ctes_of_valid')
-                         apply (erule invs_valid_objs')
-                        apply (clarsimp simp:valid_updateCapDataI invs_queues invs_valid_objs' invs_valid_pspace')
-                       apply (assumption)
+                      prefer 2
+                      apply (clarsimp simp:cte_wp_at_ctes_of)
+                      apply (drule ctes_of_valid')
+                       apply (erule invs_valid_objs')
+                      apply (frule invs_pspace_aligned')
+                      apply (frule invs_pspace_distinct')
+                      apply (clarsimp simp:valid_updateCapDataI invs_valid_objs' invs_valid_pspace')
+                      apply assumption
                      apply (wp hoare_vcg_all_lift_R injection_wp_E[OF refl]
                                lsfco_cte_at' hoare_vcg_const_imp_lift_R
                            )+
@@ -1341,7 +1342,7 @@ lemma decodeCNodeInvocation_ccorres:
    apply simp
    apply (vcg exspec=getSyscallArg_modifies)
   apply (clarsimp simp: valid_tcb_state'_def invs_valid_objs' invs_valid_pspace'
-                        ct_in_state'_def pred_tcb_at' invs_queues
+                        ct_in_state'_def pred_tcb_at'
                         cur_tcb'_def word_sle_def word_sless_def
                         unat_lt2p[where 'a=32, folded word_bits_def])
   apply (rule conjI)
@@ -1372,9 +1373,6 @@ end
 
 context begin interpretation Arch . (*FIXME: arch_split*)
 
-crunch valid_queues[wp]: insertNewCap "valid_queues"
-  (wp: crunch_wps)
-
 lemma setCTE_sch_act_wf[wp]:
   "\<lbrace> \<lambda>s. sch_act_wf (ksSchedulerAction s) s \<rbrace>
    setCTE src cte
@@ -3099,8 +3097,7 @@ lemma decodeUntypedInvocation_ccorres_helper:
                             | Some n \<Rightarrow> args ! 4 + args ! 5 - 1 < 2 ^ n)
                       and sch_act_simple and ct_active'" in hoare_post_imp_R)
                    prefer 2
-                   apply (clarsimp simp: invs_valid_objs' invs_mdb'
-                                         invs_queues ct_in_state'_def pred_tcb_at')
+                   apply (clarsimp simp: invs_valid_objs' invs_mdb' ct_in_state'_def pred_tcb_at')
                    apply (subgoal_tac "ksCurThread s \<noteq> ksIdleThread sa")
                     prefer 2
                     apply clarsimp
diff --git a/proof/crefine/ARM/IpcCancel_C.thy b/proof/crefine/ARM/IpcCancel_C.thy
index 8d60f75ba6..b872f9e13a 100644
--- a/proof/crefine/ARM/IpcCancel_C.thy
+++ b/proof/crefine/ARM/IpcCancel_C.thy
@@ -15,12 +15,12 @@ begin
 declare ctcb_size_bits_ge_4[simp]
 
 lemma cready_queues_index_to_C_in_range':
-  assumes prems: "qdom \<le> ucast maxDom" "prio \<le> ucast maxPrio"
+  assumes prems: "qdom \<le> maxDomain" "prio \<le> maxPriority"
   shows "cready_queues_index_to_C qdom prio < num_tcb_queues"
 proof -
   have P: "unat prio < numPriorities"
     using prems
-    by (simp add: numPriorities_def seL4_MaxPrio_def Suc_le_lessD unat_le_helper)
+    by (simp add: numPriorities_def Suc_le_lessD unat_le_helper maxDomain_def maxPriority_def)
   have Q: "unat qdom < numDomains"
     using prems
     by (simp add: maxDom_to_H le_maxDomain_eq_less_numDomains word_le_nat_alt)
@@ -34,28 +34,18 @@ lemmas cready_queues_index_to_C_in_range =
 
 lemma cready_queues_index_to_C_inj:
   "\<lbrakk> cready_queues_index_to_C qdom prio = cready_queues_index_to_C qdom' prio';
-     prio \<le> ucast maxPrio; prio' \<le> ucast maxPrio \<rbrakk> \<Longrightarrow> prio = prio' \<and> qdom = qdom'"
+     prio \<le> maxPriority; prio' \<le> maxPriority \<rbrakk> \<Longrightarrow> prio = prio' \<and> qdom = qdom'"
   apply (rule context_conjI)
-  apply (auto simp: cready_queues_index_to_C_def numPriorities_def
+  apply (auto simp: cready_queues_index_to_C_def numPriorities_def maxPriority_def
                     seL4_MaxPrio_def word_le_nat_alt dest: arg_cong[where f="\<lambda>x. x mod 256"])
   done
 
 lemma cready_queues_index_to_C_distinct:
-  "\<lbrakk> qdom = qdom' \<longrightarrow> prio \<noteq> prio'; prio \<le> ucast maxPrio; prio' \<le> ucast maxPrio \<rbrakk>
+  "\<lbrakk> qdom = qdom' \<longrightarrow> prio \<noteq> prio'; prio \<le> maxPriority; prio' \<le> maxPriority \<rbrakk>
    \<Longrightarrow> cready_queues_index_to_C qdom prio \<noteq> cready_queues_index_to_C qdom' prio'"
   apply (auto simp: cready_queues_index_to_C_inj)
   done
 
-lemma valid_queuesD':
-  "\<lbrakk> obj_at' (inQ d p) t s; valid_queues' s \<rbrakk>
-        \<Longrightarrow> t \<in> set (ksReadyQueues s (d, p))"
-  by (simp add: valid_queues'_def)
-
-lemma invs_valid_queues'[elim!]:
-  "invs' s \<Longrightarrow> valid_queues' s"
-  by (simp add: invs'_def valid_state'_def)
-
-
 lemma ntfn_ptr_get_queue_spec:
   "\<forall>s. \<Gamma> \<turnstile> {\<sigma>. s = \<sigma> \<and> \<sigma> \<Turnstile>\<^sub>c \<^bsup>\<sigma>\<^esup>ntfnPtr} \<acute>ret__struct_tcb_queue_C :== PROC ntfn_ptr_get_queue(\<acute>ntfnPtr)
        \<lbrace>head_C \<acute>ret__struct_tcb_queue_C = Ptr (ntfnQueue_head_CL (notification_lift (the (cslift s \<^bsup>s\<^esup>ntfnPtr)))) \<and>
@@ -200,22 +190,19 @@ lemma cancelSignal_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-            \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-           apply simp
-           apply (rule cendpoint_relation_ntfn_queue [OF invs_sym'], assumption+)
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+          apply simp
+          apply (rule cendpoint_relation_ntfn_queue [OF invs_sym'], assumption+)
            apply simp
-           apply (erule (1) map_to_ko_atI')
-          \<comment> \<open>ntfn relation\<close>
-          apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
-          apply (simp add: cnotification_relation_def Let_def NtfnState_Idle_def)
-          apply (simp add: carch_state_relation_def carch_globals_def)
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         apply (clarsimp simp: comp_def)
+          apply (erule (1) map_to_ko_atI')
+         \<comment> \<open>ntfn relation\<close>
+         apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
+         apply (simp add: cnotification_relation_def Let_def NtfnState_Idle_def)
+         apply (simp add: carch_state_relation_def carch_globals_def)
         apply (simp add: carch_state_relation_def carch_globals_def
                          typ_heap_simps')
        apply (simp add: cmachine_state_relation_def)
@@ -238,30 +225,27 @@ lemma cancelSignal_ccorres_helper:
                        typ_heap_simps')
       apply (elim conjE)
       apply (intro conjI)
-           \<comment> \<open>tcb relation\<close>
-           apply (erule ctcb_relation_null_queue_ptrs)
-           apply (clarsimp simp: comp_def)
-          \<comment> \<open>ep relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-          apply simp
-          apply (rule cendpoint_relation_ntfn_queue)
-              apply fastforce
-             apply assumption+
-          apply simp
-          apply (erule (1) map_to_ko_atI')
-         \<comment> \<open>ntfn relation\<close>
-         apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
-          apply (simp add: cnotification_relation_def Let_def isWaitingNtfn_def
-                    split: ntfn.splits split del: if_split)
-          apply (erule iffD1 [OF tcb_queue_relation'_cong [OF refl _ _ refl], rotated -1])
-           apply (clarsimp simp add: Ptr_ptr_val h_t_valid_clift_Some_iff)
-           apply (simp add: tcb_queue_relation'_next_mask)
-          apply (clarsimp simp add: Ptr_ptr_val h_t_valid_clift_Some_iff)
-          apply (simp add: tcb_queue_relation'_prev_mask)
+          \<comment> \<open>tcb relation\<close>
+          apply (erule ctcb_relation_null_ep_ptrs)
+          apply (clarsimp simp: comp_def)
+         \<comment> \<open>ep relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
          apply simp
-        \<comment> \<open>queue relation\<close>
-        apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-        apply (clarsimp simp: comp_def)
+         apply (rule cendpoint_relation_ntfn_queue)
+             apply fastforce
+            apply assumption+
+         apply simp
+         apply (erule (1) map_to_ko_atI')
+        \<comment> \<open>ntfn relation\<close>
+        apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
+         apply (simp add: cnotification_relation_def Let_def isWaitingNtfn_def
+                   split: ntfn.splits split del: if_split)
+         apply (erule iffD1 [OF tcb_queue_relation'_cong [OF refl _ _ refl], rotated -1])
+          apply (clarsimp simp add: Ptr_ptr_val h_t_valid_clift_Some_iff)
+          apply (simp add: tcb_queue_relation'_next_mask)
+         apply (clarsimp simp add: Ptr_ptr_val h_t_valid_clift_Some_iff)
+         apply (simp add: tcb_queue_relation'_prev_mask)
+        apply simp
        apply (simp add: carch_state_relation_def carch_globals_def
                         typ_heap_simps')
       apply (simp add: cmachine_state_relation_def)
@@ -387,68 +371,6 @@ lemma isRunnable_ccorres [corres]:
        apply (simp add: ThreadState_defs)+
   done
 
-
-
-lemma tcb_queue_relation_update_head:
-  fixes getNext_update :: "(tcb_C ptr \<Rightarrow> tcb_C ptr) \<Rightarrow> tcb_C \<Rightarrow> tcb_C" and
-  getPrev_update :: "(tcb_C ptr \<Rightarrow> tcb_C ptr) \<Rightarrow> tcb_C \<Rightarrow> tcb_C"
-  assumes qr: "tcb_queue_relation getNext getPrev mp queue NULL qhead"
-  and     qh': "qhead' \<notin> tcb_ptr_to_ctcb_ptr ` set queue"
-  and  cs_tcb: "mp qhead' = Some tcb"
-  and valid_ep: "\<forall>t\<in>set queue. tcb_at' t s" "distinct queue"
-  and     qhN: "qhead' \<noteq> NULL"
-  and     fgN: "fg_cons getNext (getNext_update \<circ> (\<lambda>x _. x))"
-  and     fgP: "fg_cons getPrev (getPrev_update \<circ> (\<lambda>x _. x))"
-  and     npu: "\<And>f t. getNext (getPrev_update f t) = getNext t"
-  and     pnu: "\<And>f t. getPrev (getNext_update f t) = getPrev t"
-  shows   "tcb_queue_relation getNext getPrev
-                 (upd_unless_null qhead (getPrev_update (\<lambda>_. qhead') (the (mp qhead)))
-                       (mp(qhead' := Some (getPrev_update (\<lambda>_. NULL) (getNext_update (\<lambda>_. qhead)  tcb)))))
-                 (ctcb_ptr_to_tcb_ptr qhead' # queue) NULL qhead'"
-  using qr qh' cs_tcb valid_ep qhN
-  apply (subgoal_tac "qhead \<noteq> qhead'")
-  apply (clarsimp simp: pnu upd_unless_null_def fg_consD1 [OF fgN] fg_consD1 [OF fgP] pnu npu)
-  apply (cases queue)
-    apply simp
-   apply (frule (2) tcb_queue_relation_next_not_NULL)
-    apply simp
-   apply (clarsimp simp: fg_consD1 [OF fgN] fg_consD1 [OF fgP] pnu npu)
-   apply (subst tcb_queue_relation_cong [OF refl refl refl, where mp' = mp])
-    apply (clarsimp simp: inj_eq)
-    apply (intro impI conjI)
-     apply (frule_tac x = x in imageI [where f = tcb_ptr_to_ctcb_ptr])
-     apply simp
-    apply simp
-   apply simp
-  apply clarsimp
-  apply (cases queue)
-   apply simp
-  apply simp
-  done
-
-lemma tcbSchedEnqueue_update:
-  assumes sr: "sched_queue_relation' mp queue qhead qend"
-  and     qh': "qhead' \<notin> tcb_ptr_to_ctcb_ptr ` set queue"
-  and  cs_tcb: "mp qhead' = Some tcb"
-  and valid_ep: "\<forall>t\<in>set queue. tcb_at' t s" "distinct queue"
-  and     qhN: "qhead' \<noteq> NULL"
-  shows
-  "sched_queue_relation'
-                   (upd_unless_null qhead (tcbSchedPrev_C_update (\<lambda>_. qhead') (the (mp qhead)))
-                (mp(qhead' \<mapsto> tcb\<lparr>tcbSchedNext_C := qhead, tcbSchedPrev_C := NULL\<rparr>)))
-            (ctcb_ptr_to_tcb_ptr qhead' # queue) qhead' (if qend = NULL then qhead' else qend)"
-  using sr qh' cs_tcb valid_ep qhN
-  apply -
-  apply (erule tcb_queue_relationE')
-  apply (rule tcb_queue_relationI')
-   apply (erule (5) tcb_queue_relation_update_head
-        [where getNext_update = tcbSchedNext_C_update and getPrev_update = tcbSchedPrev_C_update], simp_all)[1]
-  apply simp
-  apply (intro impI)
-  apply (erule (1) tcb_queue_relation_not_NULL')
-  apply simp
-  done
-
 lemma tcb_ptr_to_ctcb_ptr_imageD:
   "x \<in> tcb_ptr_to_ctcb_ptr ` S \<Longrightarrow> ctcb_ptr_to_tcb_ptr x \<in> S"
   apply (erule imageE)
@@ -461,63 +383,8 @@ lemma ctcb_ptr_to_tcb_ptr_imageI:
   apply simp
   done
 
-lemma tcb_queue'_head_end_NULL:
-  assumes qr: "tcb_queue_relation' getNext getPrev mp queue qhead qend"
-  and   tat: "\<forall>t\<in>set queue. tcb_at' t s"
-  shows "(qend = NULL) = (qhead = NULL)"
-  using qr tat
-  apply -
-  apply (erule tcb_queue_relationE')
-  apply (simp add: tcb_queue_head_empty_iff)
-  apply (rule impI)
-  apply (rule tcb_at_not_NULL)
-  apply (erule bspec)
-  apply simp
-  done
-
-lemma tcb_queue_relation_qhead_mem:
-  "\<lbrakk> tcb_queue_relation getNext getPrev mp queue NULL qhead;
-  (\<forall>tcb\<in>set queue. tcb_at' tcb t) \<rbrakk>
-  \<Longrightarrow> qhead \<noteq> NULL \<longrightarrow> ctcb_ptr_to_tcb_ptr qhead \<in> set queue"
-  by (clarsimp simp: tcb_queue_head_empty_iff tcb_queue_relation_head_hd)
-
-lemma tcb_queue_relation_qhead_valid:
-  "\<lbrakk> tcb_queue_relation getNext getPrev (cslift s') queue NULL qhead;
-  (s, s') \<in> rf_sr; (\<forall>tcb\<in>set queue. tcb_at' tcb s) \<rbrakk>
-  \<Longrightarrow> qhead \<noteq> NULL \<longrightarrow> s' \<Turnstile>\<^sub>c qhead"
-  apply (frule (1) tcb_queue_relation_qhead_mem)
-  apply clarsimp
-  apply(drule (3) tcb_queue_memberD)
-  apply (simp add: h_t_valid_clift_Some_iff)
-  done
-
-lemmas tcb_queue_relation_qhead_mem' = tcb_queue_relation_qhead_mem [OF tcb_queue_relation'_queue_rel]
-lemmas tcb_queue_relation_qhead_valid' = tcb_queue_relation_qhead_valid [OF tcb_queue_relation'_queue_rel]
-
-
-lemma valid_queues_valid_q:
-  "valid_queues s \<Longrightarrow> (\<forall>tcb\<in>set (ksReadyQueues s (qdom, prio)). tcb_at' tcb s) \<and> distinct (ksReadyQueues s (qdom, prio))"
-  apply (clarsimp simp: valid_queues_def valid_queues_no_bitmap_def)
-  apply (drule spec [where x = qdom])
-  apply (drule spec [where x = prio])
-  apply clarsimp
-  apply (drule (1) bspec, erule obj_at'_weakenE)
-  apply simp
-  done
-
 declare unat_ucast_8_32[simp]
 
-lemma rf_sr_sched_queue_relation:
-  "\<lbrakk> (s, s') \<in> rf_sr; d \<le> ucast maxDom; p \<le> ucast maxPrio \<rbrakk>
-  \<Longrightarrow> sched_queue_relation' (cslift s') (ksReadyQueues s (d, p))
-                                        (head_C (index (ksReadyQueues_' (globals s'))
-                                                       (cready_queues_index_to_C d p)))
-                                        (end_C (index (ksReadyQueues_' (globals s'))
-                                                      (cready_queues_index_to_C d p)))"
-  unfolding rf_sr_def cstate_relation_def cready_queues_relation_def
-  apply (clarsimp simp: Let_def seL4_MinPrio_def minDom_def)
-  done
-
 lemma threadSet_queued_ccorres [corres]:
   shows "ccorres dc xfdc (tcb_at' thread)
         {s. v32_' s = from_bool v \<and> thread_state_ptr_' s = Ptr &(tcb_ptr_to_ctcb_ptr thread\<rightarrow>[''tcbState_C''])} []
@@ -537,139 +404,6 @@ lemma threadSet_queued_ccorres [corres]:
   apply (clarsimp simp: typ_heap_simps)
   done
 
-lemma ccorres_pre_getQueue:
-  assumes cc: "\<And>queue. ccorres r xf (P queue) (P' queue) hs (f queue) c"
-  shows   "ccorres r xf (\<lambda>s. P (ksReadyQueues s (d, p)) s \<and> d \<le> maxDomain \<and> p \<le> maxPriority)
-                        {s'. \<forall>queue. (let cqueue = index (ksReadyQueues_' (globals s'))
-                                                         (cready_queues_index_to_C d p) in
-                                      sched_queue_relation' (cslift s') queue (head_C cqueue) (end_C cqueue)) \<longrightarrow> s' \<in> P' queue}
-           hs (getQueue d p >>= (\<lambda>queue. f queue)) c"
-  apply (rule ccorres_guard_imp2)
-  apply (rule ccorres_symb_exec_l2)
-     defer
-     defer
-     apply (rule gq_sp)
-    defer
-    apply (rule ccorres_guard_imp)
-    apply (rule cc)
-     apply clarsimp
-     apply assumption
-    apply assumption
-   apply (clarsimp simp: getQueue_def gets_exs_valid)
-  apply clarsimp
-  apply (drule spec, erule mp)
-  apply (simp add: Let_def)
-  apply (erule rf_sr_sched_queue_relation)
-   apply (simp add: maxDom_to_H maxPrio_to_H)+
-  done
-
-lemma state_relation_queue_update_helper':
-  "\<lbrakk> (s, s') \<in> rf_sr;
-     (\<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s)
-                                       \<and> distinct (ksReadyQueues s (d, p)));
-          globals t = ksReadyQueues_'_update
-             (\<lambda>_. Arrays.update (ksReadyQueues_' (globals s')) prio' q')
-             (t_hrs_'_update f (globals s'));
-          sched_queue_relation' (cslift t) q (head_C q') (end_C q');
-          cslift t |` ( - tcb_ptr_to_ctcb_ptr ` S )
-             = cslift s' |` ( - tcb_ptr_to_ctcb_ptr ` S );
-          option_map tcb_null_sched_ptrs \<circ> cslift t
-            = option_map tcb_null_sched_ptrs \<circ> cslift s';
-          cslift_all_but_tcb_C t s';
-          zero_ranges_are_zero (gsUntypedZeroRanges s) (f (t_hrs_' (globals s')))
-              = zero_ranges_are_zero (gsUntypedZeroRanges s) (t_hrs_' (globals s'));
-          hrs_htd (t_hrs_' (globals t)) = hrs_htd (t_hrs_' (globals s'));
-          prio' = cready_queues_index_to_C qdom prio;
-          \<forall>x \<in> S. obj_at' (inQ qdom prio) x s
-                   \<or> (obj_at' (\<lambda>tcb. tcbPriority tcb = prio) x s
-                       \<and> obj_at' (\<lambda>tcb. tcbDomain tcb = qdom) x s)
-                   \<or> (tcb_at' x s \<and> (\<forall>d' p'. (d' \<noteq> qdom \<or> p' \<noteq> prio)
-                                         \<longrightarrow> x \<notin> set (ksReadyQueues s (d', p'))));
-          S \<noteq> {}; qdom \<le> ucast maxDom; prio \<le> ucast maxPrio \<rbrakk>
-      \<Longrightarrow> (s \<lparr>ksReadyQueues := (ksReadyQueues s)((qdom, prio) := q)\<rparr>, t) \<in> rf_sr"
-  apply (subst(asm) disj_imp_rhs)
-   apply (subst obj_at'_and[symmetric])
-   apply (rule disjI1, erule obj_at'_weakenE, simp add: inQ_def)
-  apply (subst(asm) disj_imp_rhs)
-   apply (subst(asm) obj_at'_and[symmetric])
-   apply (rule conjI, erule obj_at'_weakenE, simp)
-   apply (rule allI, rule allI)
-   apply (drule_tac x=d' in spec)
-   apply (drule_tac x=p' in spec)
-   apply clarsimp
-   apply (drule(1) bspec)
-   apply (clarsimp simp: inQ_def obj_at'_def)
-  apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def)
-  apply (intro conjI)
-      \<comment> \<open>cpspace_relation\<close>
-     apply (erule nonemptyE, drule(1) bspec)
-     apply (clarsimp simp: cpspace_relation_def)
-     apply (drule obj_at_ko_at', clarsimp)
-     apply (rule cmap_relationE1, assumption,
-            erule ko_at_projectKO_opt)
-     apply (frule null_sched_queue)
-     apply (frule null_sched_epD)
-     apply (intro conjI)
-       \<comment> \<open>tcb relation\<close>
-       apply (drule ctcb_relation_null_queue_ptrs,
-              simp_all)[1]
-      \<comment> \<open>endpoint relation\<close>
-      apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-      apply simp
-      apply (erule cendpoint_relation_upd_tcb_no_queues, simp+)
-     \<comment> \<open>ntfn relation\<close>
-     apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-     apply simp
-     apply (erule cnotification_relation_upd_tcb_no_queues, simp+)
-    \<comment> \<open>ready queues\<close>
-    apply (simp add: cready_queues_relation_def Let_def cready_queues_index_to_C_in_range
-                     seL4_MinPrio_def minDom_def)
-    apply clarsimp
-    apply (frule cready_queues_index_to_C_distinct, assumption+)
-    apply (clarsimp simp: cready_queues_index_to_C_in_range all_conj_distrib)
-    apply (rule iffD1 [OF tcb_queue_relation'_cong[OF refl], rotated -1],
-           drule spec, drule spec, erule mp, simp+)
-    apply clarsimp
-    apply (drule_tac x="tcb_ptr_to_ctcb_ptr x" in fun_cong)+
-    apply (clarsimp simp: restrict_map_def
-                   split: if_split_asm)
-   apply (simp_all add: carch_state_relation_def cmachine_state_relation_def
-                        h_t_valid_clift_Some_iff)
-  done
-
-lemma state_relation_queue_update_helper:
-  "\<lbrakk> (s, s') \<in> rf_sr; valid_queues s;
-          globals t = ksReadyQueues_'_update
-             (\<lambda>_. Arrays.update (ksReadyQueues_' (globals s')) prio' q')
-             (t_hrs_'_update f (globals s'));
-          sched_queue_relation' (cslift t) q (head_C q') (end_C q');
-          cslift t |` ( - tcb_ptr_to_ctcb_ptr ` S )
-             = cslift s' |` ( - tcb_ptr_to_ctcb_ptr ` S );
-          option_map tcb_null_sched_ptrs \<circ> cslift t
-            = option_map tcb_null_sched_ptrs \<circ> cslift s';
-          cslift_all_but_tcb_C t s';
-          zero_ranges_are_zero (gsUntypedZeroRanges s) (f (t_hrs_' (globals s')))
-              = zero_ranges_are_zero (gsUntypedZeroRanges s) (t_hrs_' (globals s'));
-          hrs_htd (t_hrs_' (globals t)) = hrs_htd (t_hrs_' (globals s'));
-          prio' = cready_queues_index_to_C qdom prio;
-          \<forall>x \<in> S. obj_at' (inQ qdom prio) x s
-                   \<or> (obj_at' (\<lambda>tcb. tcbPriority tcb = prio) x s
-                       \<and> obj_at' (\<lambda>tcb. tcbDomain tcb = qdom) x s)
-                   \<or> (tcb_at' x s \<and> (\<forall>d' p'. (d' \<noteq> qdom \<or> p' \<noteq> prio)
-                                         \<longrightarrow> x \<notin> set (ksReadyQueues s (d', p'))));
-          S \<noteq> {}; qdom \<le> ucast maxDom; prio \<le> ucast maxPrio \<rbrakk>
-      \<Longrightarrow> (s \<lparr>ksReadyQueues := (ksReadyQueues s)((qdom, prio) := q)\<rparr>, t) \<in> rf_sr"
-  apply (subgoal_tac "\<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s)
-                           \<and> distinct(ksReadyQueues s (d, p))")
-   apply (erule(5) state_relation_queue_update_helper', simp_all)
-  apply (clarsimp simp: valid_queues_def valid_queues_no_bitmap_def)
-  apply (drule_tac x=d in spec)
-  apply (drule_tac x=p in spec)
-  apply (clarsimp)
-  apply (drule(1) bspec)
-  apply (erule obj_at'_weakenE, clarsimp)
-  done
-
 declare fun_upd_restrict_conv[simp del]
 
 lemmas queue_in_range = of_nat_mono_maybe[OF _ cready_queues_index_to_C_in_range,
@@ -693,8 +427,8 @@ lemma cready_queues_index_to_C_def2:
 lemma ready_queues_index_spec:
   "\<forall>s. \<Gamma> \<turnstile> {s'. s' = s \<and> (Kernel_Config.numDomains \<le> 1 \<longrightarrow> dom_' s' = 0)}
        Call ready_queues_index_'proc
-       \<lbrace>\<acute>ret__unsigned_long = (dom_' s) * 0x100 + (prio_' s)\<rbrace>"
-  by vcg (simp add: numDomains_sge_1_simp)
+       \<lbrace>\<acute>ret__unsigned_long = (dom_' s) * word_of_nat numPriorities + (prio_' s)\<rbrace>"
+  by vcg (simp add: numDomains_sge_1_simp numPriorities_def)
 
 lemma prio_to_l1index_spec:
   "\<forall>s. \<Gamma> \<turnstile> {s} Call prio_to_l1index_'proc
@@ -708,6 +442,22 @@ lemma invert_l1index_spec:
   by vcg
      (simp add: word_sle_def sdiv_int_def sdiv_word_def smod_word_def smod_int_def)
 
+lemma cbitmap_L1_relation_update:
+  "\<lbrakk> (\<sigma>, s) \<in> rf_sr ; cbitmap_L1_relation cupd aupd \<rbrakk>
+   \<Longrightarrow> (\<sigma>\<lparr>ksReadyQueuesL1Bitmap := aupd \<rparr>,
+       globals_update (ksReadyQueuesL1Bitmap_'_update (\<lambda>_. cupd)) s)
+      \<in> rf_sr"
+  by (simp add: rf_sr_def cstate_relation_def Let_def carch_state_relation_def
+                cmachine_state_relation_def)
+
+lemma cbitmap_L2_relation_update:
+  "\<lbrakk> (\<sigma>, s) \<in> rf_sr ; cbitmap_L2_relation cupd aupd \<rbrakk>
+   \<Longrightarrow> (\<sigma>\<lparr>ksReadyQueuesL2Bitmap := aupd \<rparr>,
+       globals_update (ksReadyQueuesL2Bitmap_'_update (\<lambda>_. cupd)) s)
+      \<in> rf_sr"
+  by (simp add: rf_sr_def cstate_relation_def Let_def carch_state_relation_def
+                cmachine_state_relation_def)
+
 lemma unat_ucast_prio_L1_cmask_simp:
   "unat (ucast (p::priority) && 0x1F :: machine_word) = unat (p && 0x1F)"
   using unat_ucast_prio_mask_simp[where m=5]
@@ -833,15 +583,6 @@ lemma rf_sr_drop_bitmaps_enqueue_helper:
              carch_state_relation_def cmachine_state_relation_def
   by (clarsimp simp: rf_sr_cbitmap_L1_relation rf_sr_cbitmap_L2_relation)
 
-lemma tcb_queue_relation'_empty_ksReadyQueues:
-  "\<lbrakk> sched_queue_relation' (cslift x) (q s) NULL NULL ; \<forall>t\<in> set (q s). tcb_at' t s  \<rbrakk> \<Longrightarrow> q s = []"
-  apply (clarsimp simp add: tcb_queue_relation'_def)
-  apply (subst (asm) eq_commute)
-  apply (cases "q s" rule: rev_cases, simp)
-  apply (clarsimp simp: tcb_at_not_NULL)
-  done
-
-
 lemma invert_prioToL1Index_c_simp:
   "p \<le> maxPriority
    \<Longrightarrow>
@@ -855,13 +596,247 @@ lemma c_invert_assist: "7 - (ucast (p :: priority) >> 5 :: machine_word) < 8"
   using prio_ucast_shiftr_wordRadix_helper'[simplified wordRadix_def]
   by - (rule word_less_imp_diff_less, simp_all)
 
+lemma addToBitmap_ccorres:
+  "ccorres dc xfdc
+     (K (tdom \<le> maxDomain \<and> prio \<le> maxPriority)) (\<lbrace>\<acute>dom = ucast tdom\<rbrace> \<inter> \<lbrace>\<acute>prio = ucast prio\<rbrace>) hs
+     (addToBitmap tdom prio) (Call addToBitmap_'proc)"
+  supply prio_and_dom_limit_helpers[simp] invert_prioToL1Index_c_simp[simp]
+  apply (rule ccorres_from_vcg)
+  apply (rule allI, rule conseqPre, vcg)
+  apply clarsimp
+  apply (frule maxDomain_le_unat_ucast_explicit)
+  apply (clarsimp simp: getQueue_def gets_def get_def setQueue_def modify_def
+                        put_def bind_def return_def bitmap_fun_defs)
+  apply (intro conjI impI allI)
+   apply (fastforce simp: c_invert_assist l2BitmapSize_def' wordRadix_def)
+  apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
+                        carch_state_relation_def cmachine_state_relation_def)
+  apply (rule conjI)
+   apply (clarsimp intro!: cbitmap_L1_relation_bit_set)
+  apply (fastforce dest!: cbitmap_L2_relation_bit_set simp: wordRadix_def mask_def)
+  done
+
+lemma rf_sr_tcb_update_twice:
+  "h_t_valid (hrs_htd (hrs2 (globals s') (t_hrs_' (gs2 (globals s'))))) c_guard
+      (ptr (t_hrs_' (gs2 (globals s'))) (globals s'))
+    \<Longrightarrow> ((s, globals_update (\<lambda>gs. t_hrs_'_update (\<lambda>ths.
+        hrs_mem_update (heap_update (ptr ths gs :: tcb_C ptr) (v ths gs))
+            (hrs_mem_update (heap_update (ptr ths gs) (v' ths gs)) (hrs2 gs ths))) (gs2 gs)) s') \<in> rf_sr)
+    = ((s, globals_update (\<lambda>gs. t_hrs_'_update (\<lambda>ths.
+        hrs_mem_update (heap_update (ptr ths gs) (v ths gs)) (hrs2 gs ths)) (gs2 gs)) s') \<in> rf_sr)"
+  by (simp add: rf_sr_def cstate_relation_def Let_def
+                cpspace_relation_def typ_heap_simps'
+                carch_state_relation_def cmachine_state_relation_def
+                packed_heap_update_collapse_hrs)
+
+lemmas rf_sr_tcb_update_no_queue_gen2 =
+  rf_sr_obj_update_helper[OF rf_sr_tcb_update_no_queue_gen, simplified]
+
+lemma tcb_queue_prepend_ccorres:
+  "ccorres ctcb_queue_relation ret__struct_tcb_queue_C_'
+     (\<lambda>s. tcb_at' tcbPtr s
+          \<and> (tcbQueueHead queue \<noteq> None \<longleftrightarrow> tcbQueueEnd queue \<noteq> None)
+          \<and> (\<forall>head. tcbQueueHead queue = Some head \<longrightarrow> tcb_at' head s))
+     (\<lbrace>ctcb_queue_relation queue \<acute>queue\<rbrace> \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr tcbPtr\<rbrace>) hs
+     (tcbQueuePrepend queue tcbPtr) (Call tcb_queue_prepend_'proc)"
+  (is "ccorres _ _ ?abs _ _ _ _")
+  supply if_split[split del]
+  apply (cinit lift: tcb_')
+   \<comment> \<open>cinit is not able to lift queue_' because queue_' is later modified in the C program\<close>
+   apply (rule_tac xf'=queue_' in ccorres_abstract, ceqv, rename_tac cqueue)
+   apply (rule_tac P="ctcb_queue_relation queue cqueue" in ccorres_gen_asm2)
+   apply (rule_tac xf'=ret__unsigned_long_'
+               and val="from_bool (tcbQueueEmpty queue)"
+               and R="?abs"
+               and R'="\<lbrace>\<acute>queue = cqueue\<rbrace>"
+                in ccorres_symb_exec_r_known_rv)
+      apply (rule conseqPre, vcg)
+      apply (fastforce dest: tcb_at_not_NULL
+                       simp: ctcb_queue_relation_def option_to_ctcb_ptr_def tcbQueueEmpty_def)
+     apply ceqv
+    apply (rule_tac r'=ctcb_queue_relation and xf'=queue_' in ccorres_split_nothrow)
+        apply (rule_tac Q="?abs"
+                    and Q'="\<lambda>s'. queue_' s' = cqueue"
+                     in ccorres_cond_both')
+          apply fastforce
+         apply clarsimp
+         apply (rule ccorres_return[where R=\<top>])
+         apply (rule conseqPre, vcg)
+         apply (fastforce simp: ctcb_queue_relation_def option_to_ctcb_ptr_def)
+        apply (rule ccorres_seq_skip'[THEN iffD1])
+        apply (rule ccorres_rhs_assoc)+
+        apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+            apply (rule ccorres_Guard)
+            apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb tcbPtr s
+                                            \<and> head_C cqueue = option_to_ctcb_ptr (tcbQueueHead queue)}"
+                        and R="\<lbrace>head_C cqueue = option_to_ctcb_ptr (tcbQueueHead queue)\<rbrace>"
+                         in threadSet_ccorres_lemma4[where P=\<top> and P'=\<top>])
+             apply (rule conseqPre, vcg)
+             apply clarsimp
+             apply (frule (1) obj_at_cslift_tcb)
+             apply (fastforce intro!: rf_sr_tcb_update_no_queue_gen2
+                                simp: typ_heap_simps' tcb_cte_cases_def cteSizeBits_def
+                                      ctcb_relation_def option_to_ctcb_ptr_def)
+            apply (clarsimp simp: ctcb_relation_def option_to_ctcb_ptr_def split: if_splits)
+           apply ceqv
+          apply simp
+          apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+              apply (rule ccorres_Guard)
+              apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr
+                                              \<and> ko_at' tcb (the (tcbQueueHead queue)) s
+                                              \<and> head_C cqueue = option_to_ctcb_ptr (tcbQueueHead queue)}"
+                          and R="\<lbrace>head_C cqueue = option_to_ctcb_ptr (tcbQueueHead queue)\<rbrace>"
+                           in threadSet_ccorres_lemma4[where P=\<top> and P'=\<top>])
+               apply (rule conseqPre, vcg)
+               apply clarsimp
+               apply (frule (1) obj_at_cslift_tcb)
+               apply (fastforce intro!: rf_sr_tcb_update_no_queue_gen2
+                                  simp: typ_heap_simps' tcb_cte_cases_def cteSizeBits_def
+                                        ctcb_relation_def option_to_ctcb_ptr_def tcbQueueEmpty_def)
+              apply fastforce
+             apply ceqv
+            apply (rule ccorres_return_Skip')
+           apply wpsimp
+          apply vcg
+         apply wpsimp
+        apply vcg
+       apply ceqv
+      apply csymbr
+      apply (fastforce intro: ccorres_return_C')
+     apply wpsimp
+    apply vcg
+   apply clarsimp
+   apply (vcg exspec=tcb_queue_empty_modifies)
+  apply clarsimp
+  apply (frule (1) tcb_at_h_t_valid)
+  by (force dest: tcb_at_h_t_valid
+            simp: ctcb_queue_relation_def option_to_ctcb_ptr_def tcbQueueEmpty_def)
+
+lemma tcb_queue_append_ccorres:
+  "ccorres ctcb_queue_relation ret__struct_tcb_queue_C_'
+     (\<lambda>s. tcb_at' tcbPtr s
+          \<and> (tcbQueueHead queue \<noteq> None \<longleftrightarrow> tcbQueueEnd queue \<noteq> None)
+          \<and> (\<forall>head. tcbQueueHead queue = Some head \<longrightarrow> tcb_at' head s)
+          \<and> (\<forall>end. tcbQueueEnd queue = Some end \<longrightarrow> tcb_at' end s))
+     (\<lbrace>ctcb_queue_relation queue \<acute>queue\<rbrace> \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr tcbPtr\<rbrace>) hs
+     (tcbQueueAppend queue tcbPtr) (Call tcb_queue_append_'proc)"
+  (is "ccorres _ _ ?abs _ _ _ _")
+  supply if_split[split del]
+  apply (cinit lift: tcb_')
+   \<comment> \<open>cinit is not able to lift queue_' because queue_' is later modified in the C program\<close>
+   apply (rule_tac xf'=queue_' in ccorres_abstract, ceqv, rename_tac cqueue)
+   apply (rule_tac P="ctcb_queue_relation queue cqueue
+                      \<and> (tcbQueueHead queue \<noteq> None \<longleftrightarrow> tcbQueueEnd queue \<noteq> None)"
+                in ccorres_gen_asm2)
+   apply (rule_tac xf'=ret__unsigned_long_'
+               and val="from_bool (tcbQueueEmpty queue)"
+               and R="?abs"
+               and R'="\<lbrace>\<acute>queue = cqueue\<rbrace>"
+                in ccorres_symb_exec_r_known_rv)
+      apply (rule conseqPre, vcg)
+      apply (fastforce dest: tcb_at_not_NULL
+                       simp: ctcb_queue_relation_def option_to_ctcb_ptr_def tcbQueueEmpty_def)
+     apply ceqv
+    apply (rule_tac r'=ctcb_queue_relation and xf'=queue_' in ccorres_split_nothrow)
+        apply (rule_tac Q="?abs"
+                    and Q'="\<lambda>s'. queue_' s' = cqueue"
+                     in ccorres_cond_both')
+          apply (fastforce dest: tcb_at_not_NULL
+                           simp: ctcb_queue_relation_def option_to_ctcb_ptr_def)
+         apply clarsimp
+         apply (rule ccorres_return[where R=\<top>])
+         apply (rule conseqPre, vcg)
+         apply (fastforce simp: ctcb_queue_relation_def option_to_ctcb_ptr_def)
+        apply (rule ccorres_seq_skip'[THEN iffD1])
+        apply (rule ccorres_rhs_assoc)+
+        apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+            apply (rule ccorres_Guard)
+            apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb tcbPtr s
+                                            \<and> end_C cqueue = option_to_ctcb_ptr (tcbQueueEnd queue)}"
+                        and R="\<lbrace>end_C cqueue = option_to_ctcb_ptr (tcbQueueEnd queue)\<rbrace>"
+                         in threadSet_ccorres_lemma4[where P=\<top> and P'=\<top>])
+             apply (rule conseqPre, vcg)
+             apply clarsimp
+             apply (frule (1) obj_at_cslift_tcb)
+             apply (fastforce intro!: rf_sr_tcb_update_no_queue_gen2
+                                simp: typ_heap_simps' tcb_cte_cases_def cteSizeBits_def
+                                      ctcb_relation_def option_to_ctcb_ptr_def)
+            apply (clarsimp simp: ctcb_relation_def option_to_ctcb_ptr_def split: if_splits)
+           apply ceqv
+          apply simp
+          apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+              apply (rule ccorres_Guard)
+              apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr
+                                              \<and> ko_at' tcb (the (tcbQueueEnd queue)) s
+                                              \<and> end_C cqueue = option_to_ctcb_ptr (tcbQueueEnd queue)}"
+                          and R="\<lbrace>end_C cqueue = option_to_ctcb_ptr (tcbQueueEnd queue)\<rbrace>"
+                           in threadSet_ccorres_lemma4[where P=\<top> and P'=\<top>])
+               apply (rule conseqPre, vcg)
+               apply clarsimp
+               apply (frule (1) obj_at_cslift_tcb)
+               apply (fastforce intro!: rf_sr_tcb_update_no_queue_gen2
+                                  simp: typ_heap_simps' tcb_cte_cases_def cteSizeBits_def
+                                        ctcb_relation_def option_to_ctcb_ptr_def tcbQueueEmpty_def)
+              apply fastforce
+             apply ceqv
+            apply (rule ccorres_return_Skip')
+           apply wpsimp
+          apply vcg
+         apply wpsimp
+        apply vcg
+       apply ceqv
+      apply csymbr
+      apply (fastforce intro: ccorres_return_C')
+     apply wpsimp
+    apply vcg
+   apply (vcg exspec=tcb_queue_empty_modifies)
+  apply clarsimp
+  apply (frule (1) tcb_at_h_t_valid)
+  by (force dest: tcb_at_h_t_valid
+            simp: ctcb_queue_relation_def option_to_ctcb_ptr_def tcbQueueEmpty_def)
+
+lemma getQueue_ccorres:
+  "ccorres ctcb_queue_relation queue_'
+     (K (tdom \<le> maxDomain \<and> prio \<le> maxPriority))
+     \<lbrace>\<acute>idx = word_of_nat (cready_queues_index_to_C tdom prio)\<rbrace> hs
+     (getQueue tdom prio) (\<acute>queue :== \<acute>ksReadyQueues.[unat \<acute>idx])"
+  apply (rule ccorres_from_vcg)
+  apply (rule allI, rule conseqPre, vcg)
+  apply (clarsimp simp: getQueue_def gets_def get_def bind_def return_def)
+  apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def)
+  apply (frule (1) cready_queues_index_to_C_in_range)
+  apply (clarsimp simp: unat_of_nat_eq cready_queues_relation_def)
+  done
+
+lemma setQueue_ccorres:
+  "ctcb_queue_relation queue cqueue \<Longrightarrow>
+   ccorres dc xfdc
+     (K (tdom \<le> maxDomain \<and> prio \<le> maxPriority))
+     \<lbrace>\<acute>idx = word_of_nat (cready_queues_index_to_C tdom prio)\<rbrace> hs
+     (setQueue tdom prio queue)
+     (Basic (\<lambda>s. globals_update
+                  (ksReadyQueues_'_update
+                   (\<lambda>_. Arrays.update (ksReadyQueues_' (globals s)) (unat (idx_' s)) cqueue)) s))"
+  apply (rule ccorres_from_vcg)
+  apply (rule allI, rule conseqPre, vcg)
+  apply (clarsimp simp: setQueue_def get_def modify_def put_def bind_def)
+  apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
+                        carch_state_relation_def cmachine_state_relation_def)
+  apply (frule (1) cready_queues_index_to_C_in_range)
+  apply (clarsimp simp: unat_of_nat_eq cready_queues_relation_def)
+  apply (frule cready_queues_index_to_C_distinct, assumption+)
+  apply (frule_tac qdom=d and prio=p in cready_queues_index_to_C_in_range)
+   apply fastforce
+  apply clarsimp
+  done
+
+crunch (empty_fail) empty_fail[wp]: isRunnable
+
 lemma tcbSchedEnqueue_ccorres:
   "ccorres dc xfdc
-           (valid_queues and tcb_at' t and valid_objs')
-           (UNIV \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace>)
-           hs
-           (tcbSchedEnqueue t)
-           (Call tcbSchedEnqueue_'proc)"
+     (tcb_at' t and valid_objs' and pspace_aligned' and pspace_distinct')
+     \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace> hs
+     (tcbSchedEnqueue t) (Call tcbSchedEnqueue_'proc)"
 proof -
   note prio_and_dom_limit_helpers[simp] word_sle_def[simp] maxDom_to_H[simp] maxPrio_to_H[simp]
   note invert_prioToL1Index_c_simp[simp]
@@ -871,35 +846,13 @@ proof -
   note word_less_1[simp del]
 
   show ?thesis
-  apply (cinit lift: tcb_')
-   apply (rule_tac r'="\<lambda>rv rv'. rv = to_bool rv'"
-               and xf'="ret__unsigned_'" in ccorres_split_nothrow)
-       apply (rule threadGet_vcg_corres)
-       apply (rule allI, rule conseqPre, vcg)
-       apply clarsimp
-       apply (drule obj_at_ko_at', clarsimp)
-       apply (drule spec, drule(1) mp, clarsimp)
-       apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-      apply ceqv
-     apply (simp add: when_def unless_def del: Collect_const split del: if_split)
-     apply (rule ccorres_cond[where R=\<top>])
-       apply (simp add: to_bool_def)
-      apply (rule ccorres_rhs_assoc)+
-      apply csymbr
-      apply csymbr
-      apply csymbr
-      apply csymbr
-      apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv"
-          and xf'="dom_'" in ccorres_split_nothrow)
-          apply (rule threadGet_vcg_corres)
-          apply (rule allI, rule conseqPre, vcg)
-          apply clarsimp
-          apply (drule obj_at_ko_at', clarsimp)
-          apply (drule spec, drule(1) mp, clarsimp)
-          apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-         apply ceqv
-        apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv"
-            and xf'="prio_'" in ccorres_split_nothrow)
+    apply (cinit lift: tcb_')
+     apply (rule ccorres_stateAssert)+
+     apply (rule ccorres_symb_exec_l)
+        apply (rule ccorres_assert)
+        apply (thin_tac runnable)
+        apply (rule_tac r'="\<lambda>rv rv'. rv = to_bool rv'" and xf'="ret__unsigned_'"
+                     in ccorres_split_nothrow)
             apply (rule threadGet_vcg_corres)
             apply (rule allI, rule conseqPre, vcg)
             apply clarsimp
@@ -907,235 +860,246 @@ proof -
             apply (drule spec, drule(1) mp, clarsimp)
             apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
            apply ceqv
-          apply (rule ccorres_rhs_assoc2)+
-          apply (simp only: bind_assoc[symmetric])
-          apply (rule ccorres_split_nothrow_novcg_dc)
-             prefer 2
-             apply (rule ccorres_move_c_guard_tcb)
-             apply ctac
-            prefer 2
-            apply (wp, clarsimp, wp+)
-           apply (rule_tac P="\<lambda>s. valid_queues s \<and> (\<forall>p. t \<notin> set (ksReadyQueues s p))
-                                  \<and> (\<exists>tcb. ko_at' tcb t s \<and> tcbDomain tcb =rva
-                                  \<and> tcbPriority tcb = rvb \<and> valid_tcb' tcb s)"
-                       and P'=UNIV in ccorres_from_vcg)
-           apply (rule allI, rule conseqPre, vcg)
-           apply (clarsimp simp: getQueue_def gets_def get_def setQueue_def modify_def
-                                 put_def bind_def return_def bitmap_fun_defs null_def)
-           apply (clarsimp simp: queue_in_range valid_tcb'_def)
-           apply (rule conjI; clarsimp simp: queue_in_range)
-            (* queue is empty, set t to be new queue *)
-            apply (drule (1) obj_at_cslift_tcb)
-            apply clarsimp
-            apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb"
-                     in rf_sr_sched_queue_relation)
-              apply clarsimp
-             apply clarsimp
-            apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL)
-             apply (simp add: valid_queues_valid_q)
-            apply (subgoal_tac
-                     "head_C (ksReadyQueues_'
-                        (globals x).[cready_queues_index_to_C (tcbDomain tcb) (tcbPriority tcb)]) = NULL")
-             prefer 2
-             apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL; simp add: valid_queues_valid_q)
-            apply (subgoal_tac
-                     "end_C (ksReadyQueues_'
-                        (globals x).[cready_queues_index_to_C (tcbDomain tcb) (tcbPriority tcb)]) = NULL")
-             prefer 2
-             apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL[symmetric]; simp add: valid_queues_valid_q)
-            apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                      unat_trans_ucast_helper\<close>)
-            apply (frule maxDomain_le_unat_ucast_explicit)
-            apply (clarsimp simp: cready_queues_index_to_C_def numPriorities_def)
-            apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-             apply (simp add: t_hrs_ksReadyQueues_upd_absorb)
-             apply (rule conjI)
-              apply (clarsimp simp: l2BitmapSize_def' wordRadix_def c_invert_assist)
-
-             apply (subst rf_sr_drop_bitmaps_enqueue_helper, assumption)
-               apply (fastforce intro: cbitmap_L1_relation_bit_set)
-              apply (fastforce intro: cbitmap_L2_relation_bit_set simp: wordRadix_def mask_def)
-
-            apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb"
-                     in rf_sr_sched_queue_relation)
-              apply clarsimp
-             apply clarsimp
-            apply (drule_tac qhead'="tcb_ptr_to_ctcb_ptr t" and s=\<sigma> in tcbSchedEnqueue_update,
-                   simp_all add: valid_queues_valid_q)[1]
-             apply (rule tcb_at_not_NULL, erule obj_at'_weakenE, simp)
-
-             apply (erule(1) state_relation_queue_update_helper[where S="{t}"],
-                    (simp | rule globals.equality)+,
-                    simp_all add: cready_queues_index_to_C_def2 numPriorities_def
-                                  t_hrs_ksReadyQueues_upd_absorb upd_unless_null_def
-                                  typ_heap_simps)[1]
-               apply (fastforce simp: tcb_null_sched_ptrs_def elim: obj_at'_weaken)+
-           apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                     unat_trans_ucast_helper\<close>)
-           apply clarsimp
-           apply (rule conjI; clarsimp simp: queue_in_range)
-            (* invalid, disagreement between C and Haskell on emptiness of queue *)
-            apply (drule (1) obj_at_cslift_tcb)
-            apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-            apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb"
-                     in rf_sr_sched_queue_relation)
-              apply clarsimp
-             apply clarsimp
-            apply (clarsimp simp: cready_queues_index_to_C_def numPriorities_def)
-            apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL)
-             apply (simp add: valid_queues_valid_q)
-            apply clarsimp
-            apply (drule tcb_queue_relation'_empty_ksReadyQueues; simp add: valid_queues_valid_q)
-           (* queue was not empty, add t to queue and leave bitmaps alone *)
-           apply (drule (1) obj_at_cslift_tcb)
-           apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-           apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb"
-                    in rf_sr_sched_queue_relation)
-             apply clarsimp
-            apply clarsimp
-           apply (clarsimp simp: cready_queues_index_to_C_def numPriorities_def)
-           apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL)
-            apply (simp add: valid_queues_valid_q)
-           apply clarsimp
-           apply (frule_tac t=\<sigma> in tcb_queue_relation_qhead_mem')
-            apply (simp add: valid_queues_valid_q)
-           apply (frule(1) tcb_queue_relation_qhead_valid')
-            apply (simp add: valid_queues_valid_q)
-           apply (clarsimp simp: typ_heap_simps h_t_valid_clift_Some_iff numPriorities_def
-                                 cready_queues_index_to_C_def2)
-           apply (drule_tac qhead'="tcb_ptr_to_ctcb_ptr t" and s=\<sigma> in tcbSchedEnqueue_update,
-                    simp_all add: valid_queues_valid_q)[1]
-             apply clarsimp
-            apply (rule tcb_at_not_NULL, erule obj_at'_weakenE, simp)
-           apply (frule(2) obj_at_cslift_tcb[OF valid_queues_obj_at'D])
-           apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-           apply (erule_tac S="{t, v}" for v in state_relation_queue_update_helper,
-                  (simp | rule globals.equality)+,
-                  simp_all add: typ_heap_simps if_Some_helper numPriorities_def
-                                cready_queues_index_to_C_def2 upd_unless_null_def
-                           cong: if_cong split del: if_split
-                           del: fun_upd_restrict_conv)[1]
-              apply simp
-              apply (rule conjI)
+          apply (simp add: when_def unless_def del: Collect_const split del: if_split)
+          apply (rule ccorres_cond[where R=\<top>])
+            apply (simp add: to_bool_def)
+           apply (rule ccorres_rhs_assoc)+
+           apply csymbr
+           apply csymbr
+           apply csymbr
+           apply csymbr
+           apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="dom_'" in ccorres_split_nothrow)
+               apply (rule threadGet_vcg_corres)
+               apply (rule allI, rule conseqPre, vcg)
                apply clarsimp
-               apply (drule_tac s="tcb_ptr_to_ctcb_ptr t" in sym, simp)
-              apply (clarsimp simp add: fun_upd_twist)
-             prefer 3
-             apply (simp add: obj_at'_weakenE[OF _ TrueI])
-             apply (rule disjI1, erule valid_queues_obj_at'D)
-             apply simp+
-           apply (fastforce simp: tcb_null_sched_ptrs_def)
-          apply (simp add: guard_is_UNIV_def)
-         apply simp
-         apply (wp threadGet_wp)
-        apply vcg
-       apply simp
-       apply (wp threadGet_wp)
-      apply vcg
-     apply (rule ccorres_return_Skip)
-    apply simp
-    apply (wp threadGet_wp)
-   apply vcg
-  apply (fastforce simp: valid_objs'_def obj_at'_def ran_def projectKOs typ_at'_def
-                         valid_obj'_def inQ_def
-                   dest!: valid_queues_obj_at'D)
-  done
+               apply (drule obj_at_ko_at', clarsimp)
+               apply (drule spec, drule(1) mp, clarsimp)
+               apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+              apply ceqv
+             apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="prio_'" in ccorres_split_nothrow)
+                 apply (rule threadGet_vcg_corres)
+                 apply (rule allI, rule conseqPre, vcg)
+                 apply clarsimp
+                 apply (drule obj_at_ko_at', clarsimp)
+                 apply (drule spec, drule(1) mp, clarsimp)
+                 apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+                apply ceqv
+               apply (rule ccorres_rhs_assoc2)+
+               apply (simp only: bind_assoc[symmetric])
+               apply (rule ccorres_split_nothrow_novcg_dc)
+                  prefer 2
+                  apply (rule ccorres_move_c_guard_tcb)
+                  apply (simp only: dc_def[symmetric])
+                  apply ctac
+                 apply (rule ccorres_rhs_assoc)+
+                 apply (rule ccorres_symb_exec_r)
+                   apply (rule ccorres_Guard_Seq)
+                   apply (simp add: bind_assoc)
+                   apply (ctac add: getQueue_ccorres)
+                     apply (rename_tac queue cqueue)
+                     apply (rule_tac xf'=ret__unsigned_long_'
+                                 and val="from_bool (tcbQueueEmpty queue)"
+                                 and R="\<lambda>s. \<not> tcbQueueEmpty queue \<longrightarrow> tcb_at' (the (tcbQueueHead queue)) s
+                                            \<and> (tcbQueueHead queue \<noteq> None \<longleftrightarrow> tcbQueueEnd queue \<noteq> None)"
+                                 and R'="{s'. queue_' s' = cqueue}"
+                                  in ccorres_symb_exec_r_known_rv)
+                        apply (rule conseqPre, vcg)
+                        apply (fastforce dest: tcb_at_not_NULL
+                                         simp: ctcb_queue_relation_def option_to_ctcb_ptr_def
+                                               tcbQueueEmpty_def)
+                       apply ceqv
+                      apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                          apply (rule ccorres_cond[where R=\<top>])
+                            apply fastforce
+                           apply (ctac add: addToBitmap_ccorres)
+                          apply (rule ccorres_return_Skip)
+                         apply ceqv
+                        apply (ctac add: tcb_queue_prepend_ccorres)
+                          apply (rule ccorres_Guard)
+                          apply (rule setQueue_ccorres)
+                          apply fastforce
+                         apply wpsimp
+                        apply (vcg exspec=tcb_queue_prepend_modifies)
+                       apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift')
+                      apply (vcg exspec=addToBitmap_modifies)
+                     apply vcg
+                    apply wpsimp
+                   apply vcg
+                  apply clarsimp
+                  apply vcg
+                 apply (rule conseqPre, vcg)
+                 apply clarsimp
+                apply wpsimp
+               apply (clarsimp simp: guard_is_UNIV_def)
+              apply (wpsimp wp: threadGet_wp)
+             apply vcg
+            apply clarsimp
+            apply (wpsimp wp: threadGet_wp)
+           apply vcg
+          apply (rule ccorres_return_Skip)
+         apply (wpsimp wp: threadGet_wp)
+        apply (vcg expsec=thread_state_get_tcbQueued_modifies)
+       apply wpsimp
+      apply (wpsimp wp: isRunnable_wp)
+     apply wpsimp
+    apply normalise_obj_at'
+    apply (rename_tac tcb)
+    apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+    apply (clarsimp simp: valid_tcb'_def)
+    apply (frule (1) obj_at_cslift_tcb)
+    apply (rule conjI)
+     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
+     apply (frule (3) obj_at'_tcbQueueHead_ksReadyQueues)
+     apply (force dest!: tcbQueueHead_iff_tcbQueueEnd simp: tcbQueueEmpty_def obj_at'_def)
+    apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+    apply (rule conjI)
+     apply (clarsimp simp: maxDomain_def)
+    apply (cut_tac qdom="tcbDomain tcb" and prio="tcbPriority tcb"
+                in cready_queues_index_to_C_in_range)
+      apply fastforce
+     apply fastforce
+    apply (clarsimp simp: word_less_nat_alt cready_queues_index_to_C_def2)
+    done
 qed
 
-lemmas tcbSchedDequeue_update
-    = tcbDequeue_update[where tn=tcbSchedNext_C and tn_update=tcbSchedNext_C_update
-                          and tp=tcbSchedPrev_C and tp_update=tcbSchedPrev_C_update,
-                        simplified]
-
-lemma tcb_queue_relation_prev_next:
-  "\<lbrakk> tcb_queue_relation tn tp mp queue qprev qhead;
-     tcbp \<in> set queue; distinct (ctcb_ptr_to_tcb_ptr qprev # queue);
-     \<forall>t \<in> set queue. tcb_at' t s; qprev \<noteq> tcb_Ptr 0 \<longrightarrow> mp qprev \<noteq> None;
-     mp (tcb_ptr_to_ctcb_ptr tcbp) = Some tcb \<rbrakk>
-      \<Longrightarrow> (tn tcb \<noteq> tcb_Ptr 0 \<longrightarrow> tn tcb \<in> tcb_ptr_to_ctcb_ptr ` set queue
-                       \<and> mp (tn tcb) \<noteq> None \<and> tn tcb \<noteq> tcb_ptr_to_ctcb_ptr tcbp)
-        \<and> (tp tcb \<noteq> tcb_Ptr 0 \<longrightarrow> (tp tcb \<in> tcb_ptr_to_ctcb_ptr ` set queue
-                                         \<or> tp tcb = qprev)
-                       \<and> mp (tp tcb) \<noteq> None \<and> tp tcb \<noteq> tcb_ptr_to_ctcb_ptr tcbp)
-        \<and> (tn tcb \<noteq> tcb_Ptr 0 \<longrightarrow> tn tcb \<noteq> tp tcb)"
-  apply (induct queue arbitrary: qprev qhead)
-   apply simp
-  apply simp
-  apply (erule disjE)
-   apply clarsimp
-   apply (case_tac "queue")
-    apply clarsimp
-   apply clarsimp
-   apply (rule conjI)
-    apply clarsimp
-   apply clarsimp
-   apply (drule_tac f=ctcb_ptr_to_tcb_ptr in arg_cong[where y="tp tcb"], simp)
-  apply clarsimp
-  apply fastforce
-  done
-
-lemma tcb_queue_relation_prev_next':
-  "\<lbrakk> tcb_queue_relation' tn tp mp queue qhead qend; tcbp \<in> set queue; distinct queue;
-       \<forall>t \<in> set queue. tcb_at' t s; mp (tcb_ptr_to_ctcb_ptr tcbp) = Some tcb \<rbrakk>
-      \<Longrightarrow> (tn tcb \<noteq> tcb_Ptr 0 \<longrightarrow> tn tcb \<in> tcb_ptr_to_ctcb_ptr ` set queue
-                       \<and> mp (tn tcb) \<noteq> None \<and> tn tcb \<noteq> tcb_ptr_to_ctcb_ptr tcbp)
-        \<and> (tp tcb \<noteq> tcb_Ptr 0 \<longrightarrow> tp tcb \<in> tcb_ptr_to_ctcb_ptr ` set queue
-                       \<and> mp (tp tcb) \<noteq> None \<and> tp tcb \<noteq> tcb_ptr_to_ctcb_ptr tcbp)
-        \<and> (tn tcb \<noteq> tcb_Ptr 0 \<longrightarrow> tn tcb \<noteq> tp tcb)"
-  apply (clarsimp simp: tcb_queue_relation'_def split: if_split_asm)
-  apply (drule(1) tcb_queue_relation_prev_next, simp_all)
-   apply (fastforce dest: tcb_at_not_NULL)
-  apply clarsimp
-  done
+lemma tcbSchedAppend_ccorres:
+  "ccorres dc xfdc
+     (tcb_at' t and valid_objs' and pspace_aligned' and pspace_distinct')
+     \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace> hs
+     (tcbSchedAppend t) (Call tcbSchedAppend_'proc)"
+proof -
+  note prio_and_dom_limit_helpers[simp] word_sle_def[simp] maxDom_to_H[simp] maxPrio_to_H[simp]
+  note invert_prioToL1Index_c_simp[simp]
 
-(* L1 bitmap only updated if L2 entry bits end up all zero *)
-lemma rf_sr_drop_bitmaps_dequeue_helper_L2:
-  "\<lbrakk> (\<sigma>,\<sigma>') \<in> rf_sr ;
-     cbitmap_L2_relation ksqL2upd' ksqL2upd \<rbrakk>
-   \<Longrightarrow>
-((\<sigma>\<lparr>ksReadyQueues := ksqupd,
-   ksReadyQueuesL2Bitmap := ksqL2upd\<rparr>,
- \<sigma>'\<lparr>idx_' := i',
-   queue_' := queue_upd',
-   globals := globals \<sigma>'
-     \<lparr>ksReadyQueuesL2Bitmap_' := ksqL2upd',
-      ksReadyQueues_' := ksqupd'\<rparr>\<rparr>)
-         \<in> rf_sr)
- =
-((\<sigma>\<lparr>ksReadyQueues := ksqupd\<rparr>,
- \<sigma>'\<lparr>idx_' := i',
-   queue_' := queue_upd',
-   globals := globals \<sigma>'
-     \<lparr>ksReadyQueues_' := ksqupd'\<rparr>\<rparr>) \<in> rf_sr)
-"
-  unfolding rf_sr_def cstate_relation_def Let_def
-             carch_state_relation_def cmachine_state_relation_def
-  by (clarsimp simp: rf_sr_cbitmap_L1_relation rf_sr_cbitmap_L2_relation)
+  (* when numDomains = 1, array bounds checks would become _ = 0 rather than _ < 1, changing the
+     shape of the proof compared to when numDomains > 1 *)
+  note word_less_1[simp del]
 
-lemma rf_sr_drop_bitmaps_dequeue_helper:
-  "\<lbrakk> (\<sigma>,\<sigma>') \<in> rf_sr ;
-     cbitmap_L1_relation ksqL1upd' ksqL1upd ; cbitmap_L2_relation ksqL2upd' ksqL2upd \<rbrakk>
-   \<Longrightarrow>
-((\<sigma>\<lparr>ksReadyQueues := ksqupd,
-   ksReadyQueuesL2Bitmap := ksqL2upd,
-   ksReadyQueuesL1Bitmap := ksqL1upd\<rparr>,
- \<sigma>'\<lparr>idx_' := i',
-   queue_' := queue_upd',
-   globals := globals \<sigma>'
-     \<lparr>ksReadyQueuesL2Bitmap_' := ksqL2upd',
-      ksReadyQueuesL1Bitmap_' := ksqL1upd',
-      ksReadyQueues_' := ksqupd'\<rparr>\<rparr>)
-         \<in> rf_sr)
- =
-((\<sigma>\<lparr>ksReadyQueues := ksqupd\<rparr>,
- \<sigma>'\<lparr>idx_' := i',
-   queue_' := queue_upd',
-   globals := globals \<sigma>'
-     \<lparr>ksReadyQueues_' := ksqupd'\<rparr>\<rparr>) \<in> rf_sr)
-"
-  unfolding rf_sr_def cstate_relation_def Let_def
-             carch_state_relation_def cmachine_state_relation_def
-  by (clarsimp simp: rf_sr_cbitmap_L1_relation rf_sr_cbitmap_L2_relation)
+  show ?thesis
+    apply (cinit lift: tcb_')
+     apply (rule ccorres_stateAssert)+
+     apply (rule ccorres_symb_exec_l)
+        apply (rule ccorres_assert)
+        apply (thin_tac "runnable")
+        apply (rule_tac r'="\<lambda>rv rv'. rv = to_bool rv'" and xf'="ret__unsigned_'"
+                     in ccorres_split_nothrow)
+            apply (rule threadGet_vcg_corres)
+            apply (rule allI, rule conseqPre, vcg)
+            apply clarsimp
+            apply (drule obj_at_ko_at', clarsimp)
+            apply (drule spec, drule(1) mp, clarsimp)
+            apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+           apply ceqv
+          apply (simp add: when_def unless_def del: Collect_const split del: if_split)
+          apply (rule ccorres_cond[where R=\<top>])
+            apply (simp add: to_bool_def)
+           apply (rule ccorres_rhs_assoc)+
+           apply csymbr
+           apply csymbr
+           apply csymbr
+           apply csymbr
+           apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="dom_'" in ccorres_split_nothrow)
+               apply (rule threadGet_vcg_corres)
+               apply (rule allI, rule conseqPre, vcg)
+               apply clarsimp
+               apply (drule obj_at_ko_at', clarsimp)
+               apply (drule spec, drule(1) mp, clarsimp)
+               apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+              apply ceqv
+             apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="prio_'" in ccorres_split_nothrow)
+                 apply (rule threadGet_vcg_corres)
+                 apply (rule allI, rule conseqPre, vcg)
+                 apply clarsimp
+                 apply (drule obj_at_ko_at', clarsimp)
+                 apply (drule spec, drule(1) mp, clarsimp)
+                 apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+                apply ceqv
+               apply (rule ccorres_rhs_assoc2)+
+               apply (simp only: bind_assoc[symmetric])
+               apply (rule ccorres_split_nothrow_novcg_dc)
+                  prefer 2
+                  apply (rule ccorres_move_c_guard_tcb)
+                  apply (simp only: dc_def[symmetric])
+                  apply ctac
+                 apply (rule ccorres_rhs_assoc)+
+                 apply (rule ccorres_symb_exec_r)
+                   apply (rule ccorres_Guard_Seq)
+                   apply (simp add: bind_assoc)
+                   apply (ctac add: getQueue_ccorres)
+                     apply (rename_tac queue cqueue)
+                     apply (rule_tac xf'=ret__unsigned_long_'
+                                 and val="from_bool (tcbQueueEmpty queue)"
+                                 and R="\<lambda>s. \<not> tcbQueueEmpty queue \<longrightarrow> tcb_at' (the (tcbQueueHead queue)) s
+                                            \<and> (tcbQueueHead queue \<noteq> None \<longleftrightarrow> tcbQueueEnd queue \<noteq> None)"
+                                 and R'="{s'. queue_' s' = cqueue}"
+                                  in ccorres_symb_exec_r_known_rv)
+                        apply (rule conseqPre, vcg)
+                        apply (fastforce dest: tcb_at_not_NULL
+                                         simp: ctcb_queue_relation_def option_to_ctcb_ptr_def
+                                               tcbQueueEmpty_def)
+                       apply ceqv
+                      apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                          apply (rule ccorres_cond[where R=\<top>])
+                            apply (fastforce dest!: tcb_at_not_NULL
+                                              simp: ctcb_queue_relation_def option_to_ctcb_ptr_def)
+                           apply (ctac add: addToBitmap_ccorres)
+                          apply (rule ccorres_return_Skip)
+                         apply ceqv
+                        apply (ctac add: tcb_queue_append_ccorres)
+                          apply (rule ccorres_Guard)
+                          apply (rule setQueue_ccorres)
+                          apply fastforce
+                         apply wpsimp
+                        apply (vcg exspec=tcb_queue_prepend_modifies)
+                       apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift')
+                      apply (vcg exspec=addToBitmap_modifies)
+                     apply vcg
+                    apply wpsimp
+                   apply vcg
+                  apply clarsimp
+                  apply vcg
+                 apply (rule conseqPre, vcg)
+                 apply clarsimp
+                apply wpsimp
+               apply (clarsimp simp: guard_is_UNIV_def)
+              apply (wpsimp wp: threadGet_wp)
+             apply vcg
+            apply clarsimp
+            apply (wpsimp wp: threadGet_wp)
+           apply clarsimp
+           apply vcg
+          apply (rule ccorres_return_Skip)
+         apply (wpsimp wp: threadGet_wp)
+        apply (vcg expsec=thread_state_get_tcbQueued_modifies)
+       apply wpsimp
+      apply (wpsimp wp: isRunnable_wp)
+     apply wpsimp
+    apply normalise_obj_at'
+    apply (rename_tac tcb)
+    apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+    apply (clarsimp simp: valid_tcb'_def)
+    apply (frule (1) obj_at_cslift_tcb)
+    apply (rule conjI)
+     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
+     apply (frule (3) obj_at'_tcbQueueHead_ksReadyQueues)
+     apply (frule (3) obj_at'_tcbQueueEnd_ksReadyQueues)
+     apply (force dest!: tcbQueueHead_iff_tcbQueueEnd simp: tcbQueueEmpty_def obj_at'_def)
+    apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+    apply (rule conjI)
+     apply (clarsimp simp: maxDomain_def)
+    apply (cut_tac qdom="tcbDomain tcb" and prio="tcbPriority tcb"
+                in cready_queues_index_to_C_in_range)
+      apply fastforce
+     apply fastforce
+    apply (clarsimp simp: word_less_nat_alt cready_queues_index_to_C_def2 tcbQueueEmpty_def)
+    done
+qed
 
 (* FIXME same proofs as bit_set, maybe can generalise? *)
 lemma cbitmap_L1_relation_bit_clear:
@@ -1152,27 +1116,6 @@ lemma cbitmap_L1_relation_bit_clear:
                      invertL1Index_def l2BitmapSize_def'
                      le_maxDomain_eq_less_numDomains word_le_nat_alt num_domains_index_updates)
 
-lemma cready_queues_relation_empty_queue_helper:
-  "\<lbrakk> tcbDomain ko \<le> maxDomain ; tcbPriority ko \<le> maxPriority ;
-     cready_queues_relation (cslift \<sigma>') (ksReadyQueues_' (globals \<sigma>')) (ksReadyQueues \<sigma>)\<rbrakk>
-   \<Longrightarrow>
-   cready_queues_relation (cslift \<sigma>')
-          (Arrays.update (ksReadyQueues_' (globals \<sigma>')) (unat (tcbDomain ko) * 256 + unat (tcbPriority ko))
-            (tcb_queue_C.end_C_update (\<lambda>_. NULL)
-              (head_C_update (\<lambda>_. NULL)
-                (ksReadyQueues_' (globals \<sigma>').[unat (tcbDomain ko) * 256 + unat (tcbPriority ko)]))))
-          ((ksReadyQueues \<sigma>)((tcbDomain ko, tcbPriority ko) := []))"
-  unfolding cready_queues_relation_def Let_def
-  using maxPrio_to_H[simp] maxDom_to_H[simp]
-  apply clarsimp
-  apply (frule (1) cready_queues_index_to_C_in_range[simplified maxDom_to_H maxPrio_to_H])
-  apply (fold cready_queues_index_to_C_def[simplified numPriorities_def])
-  apply (case_tac "qdom = tcbDomain ko",
-          simp_all add: prio_and_dom_limit_helpers seL4_MinPrio_def
-                        minDom_def)
-   apply (fastforce simp: cready_queues_index_to_C_in_range simp: cready_queues_index_to_C_distinct)+
-  done
-
 lemma cbitmap_L2_relationD:
   "\<lbrakk> cbitmap_L2_relation cbitmap2 abitmap2 ; d \<le> maxDomain ; i < l2BitmapSize \<rbrakk> \<Longrightarrow>
     cbitmap2.[unat d].[i] = abitmap2 (d, i)"
@@ -1202,464 +1145,301 @@ lemma cbitmap_L2_relation_bit_clear:
   apply (case_tac "da = d" ; clarsimp simp: num_domains_index_updates)
   done
 
-lemma tcbSchedDequeue_ccorres':
+lemma removeFromBitmap_ccorres:
   "ccorres dc xfdc
-           ((\<lambda>s. \<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s)
-                     \<and> distinct (ksReadyQueues s (d, p)))
-             and valid_queues' and tcb_at' t and valid_objs')
-           (UNIV \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace>)
-           []
-           (tcbSchedDequeue t)
-           (Call tcbSchedDequeue_'proc)"
+     (K (tdom \<le> maxDomain \<and> prio \<le> maxPriority)) (\<lbrace>\<acute>dom = ucast tdom\<rbrace> \<inter> \<lbrace>\<acute>prio = ucast prio\<rbrace>) hs
+     (removeFromBitmap tdom prio) (Call removeFromBitmap_'proc)"
 proof -
-
   note prio_and_dom_limit_helpers[simp] word_sle_def[simp]
 
   (* when numDomains = 1, array bounds checks would become _ = 0 rather than _ < 1, changing the
      shape of the proof compared to when numDomains > 1 *)
   include no_less_1_simps
 
-  have ksQ_tcb_at': "\<And>s ko d p.
-    \<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s)
-                                          \<and> distinct (ksReadyQueues s (d, p)) \<Longrightarrow>
-    \<forall>t\<in>set (ksReadyQueues s (d, p)). tcb_at' t s"
-    by (fastforce dest: spec elim: obj_at'_weakenE)
-
-  have invert_l1_index_limit: "\<And>p. invertL1Index (prioToL1Index p) < 8"
+  have invert_l1_index_limit: "\<And>p. invertL1Index (prioToL1Index p) < l2BitmapSize"
     unfolding invertL1Index_def l2BitmapSize_def' prioToL1Index_def
     by simp
 
   show ?thesis
-  apply (cinit lift: tcb_')
-   apply (rule_tac r'="\<lambda>rv rv'. rv = to_bool rv'"
-              and xf'="ret__unsigned_'" in ccorres_split_nothrow)
-       apply (rule threadGet_vcg_corres)
-       apply (rule allI, rule conseqPre, vcg)
-       apply clarsimp
-       apply (drule obj_at_ko_at', clarsimp)
-       apply (drule spec, drule(1) mp, clarsimp)
-       apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-      apply ceqv
-     apply (simp add: when_def
-                 del: Collect_const split del: if_split)
-     apply (rule ccorres_cond[where R=\<top>])
-       apply (simp add: to_bool_def)
-      apply (rule ccorres_rhs_assoc)+
-      apply csymbr
-      apply csymbr
-      apply csymbr
-      apply csymbr
-      apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv"
-              and xf'="dom_'" in ccorres_split_nothrow)
-          apply (rule threadGet_vcg_corres)
+    supply if_split[split del]
+    (* pull out static assms *)
+    apply simp
+    apply (rule ccorres_grab_asm[where P=\<top>, simplified])
+    apply (cinit lift: dom_' prio_')
+     apply clarsimp
+     apply csymbr
+     apply csymbr
+     (* we can clear up all C guards now *)
+     apply (clarsimp simp: maxDomain_le_unat_ucast_explicit word_and_less')
+     apply (simp add: invert_prioToL1Index_c_simp word_less_nat_alt)
+     apply (simp add: invert_l1_index_limit[simplified l2BitmapSize_def'])
+     apply ccorres_rewrite
+     (* handle L2 update *)
+     apply (rule_tac ccorres_split_nothrow_novcg_dc)
+        apply (rule_tac P=\<top> and P'=UNIV in ccorres_from_vcg)
+        apply (rule allI, rule conseqPre, vcg)
+        apply (clarsimp simp: simpler_gets_def get_def modify_def
+                              put_def bind_def return_def bitmap_fun_defs)
+        apply (frule rf_sr_cbitmap_L2_relation)
+        apply (erule cbitmap_L2_relation_update)
+        apply (erule (1) cbitmap_L2_relation_bit_clear)
+       (* the check on the C side is identical to checking the L2 entry, rewrite the condition *)
+       apply (simp add: getReadyQueuesL2Bitmap_def)
+       apply (rule ccorres_symb_exec_l3, rename_tac l2)
+          apply (rule_tac C'="{s. l2 = 0}"
+                      and Q="\<lambda>s. l2 = ksReadyQueuesL2Bitmap s (tdom, invertL1Index (prioToL1Index prio))"
+                   in ccorres_rewrite_cond_sr[where Q'=UNIV])
+           apply clarsimp
+           apply (frule rf_sr_cbitmap_L2_relation)
+           apply (clarsimp simp: cbitmap_L2_relationD invert_l1_index_limit split: if_split)
+          (* unset L1 bit when L2 entry is empty *)
+          apply (rule ccorres_from_vcg[where P=\<top> and P'=UNIV])
           apply (rule allI, rule conseqPre, vcg)
-          apply clarsimp
-          apply (drule obj_at_ko_at', clarsimp)
-          apply (drule spec, drule(1) mp, clarsimp)
-          apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-         apply ceqv
-        apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv"
-                and xf'="prio_'" in ccorres_split_nothrow)
-            apply (rule threadGet_vcg_corres)
-            apply (rule allI, rule conseqPre, vcg)
-            apply clarsimp
-            apply (drule obj_at_ko_at', clarsimp)
-            apply (drule spec, drule(1) mp, clarsimp)
-            apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-           apply ceqv
-          apply (rule ccorres_rhs_assoc2)+
-          apply (simp only: bind_assoc[symmetric])
-          apply (rule ccorres_split_nothrow_novcg_dc)
-             prefer 2
-             apply (rule ccorres_move_c_guard_tcb)
-             apply ctac
-            prefer 2
-            apply (wp, clarsimp, wp+)
-           apply (rule_tac P="(\<lambda>s. \<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s)
-                                       \<and> distinct(ksReadyQueues s (d, p)))
-                               and valid_queues' and obj_at' (inQ rva rvb) t
-                               and (\<lambda>s. rva \<le> maxDomain \<and> rvb \<le> maxPriority)"
-                       and P'=UNIV in ccorres_from_vcg)
-           apply (rule allI, rule conseqPre, vcg)
-           apply (clarsimp simp: getQueue_def gets_def get_def setQueue_def modify_def
-                                 put_def bind_def return_def bitmap_fun_defs when_def
-                                 null_def)
-
-           apply (rule conjI; clarsimp simp: queue_in_range[simplified maxDom_to_H maxPrio_to_H])
-            apply (rule conjI; clarsimp simp: queue_in_range[simplified maxDom_to_H maxPrio_to_H])
-             apply (frule(1) valid_queuesD')
-             apply (drule (1) obj_at_cslift_tcb, clarsimp simp: inQ_def)
-             apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko"
-                       in rf_sr_sched_queue_relation)
-               apply (fastforce simp: maxDom_to_H maxPrio_to_H)+
-             apply (frule_tac s=\<sigma> in tcb_queue_relation_prev_next'; (fastforce simp: ksQ_tcb_at')?)
-             apply (drule_tac s=\<sigma> in tcbSchedDequeue_update, assumption,
-                     simp_all add: remove1_filter ksQ_tcb_at')[1]
-             apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                       unat_trans_ucast_helper\<close>)
-             apply (clarsimp simp: maxDomain_le_unat_ucast_explicit)
-             apply (intro conjI ;
-                     clarsimp simp: h_val_field_clift'
-                                    h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)+
-               apply (drule(2) filter_empty_unfiltered_contr, simp)+
-             apply (rule conjI; clarsimp)
-              apply (rule conjI)
-               apply (fastforce simp: c_invert_assist l2BitmapSize_def' wordRadix_def)
-              apply (rule conjI; clarsimp)
-               apply (subst rf_sr_drop_bitmaps_dequeue_helper, assumption)
-                 apply (fastforce intro: cbitmap_L1_relation_bit_clear)
-                apply (simp add: invert_prioToL1Index_c_simp)
-                apply (frule rf_sr_cbitmap_L2_relation)
-                apply (clarsimp simp: cbitmap_L2_relation_def
-                                      word_size prioToL1Index_def wordRadix_def mask_def
-                                      word_le_nat_alt
-                                      numPriorities_def wordBits_def l2BitmapSize_def'
-                                      invertL1Index_def numDomains_less_numeric_explicit)
-                apply (case_tac "d = tcbDomain ko"
-                       ; fastforce simp: le_maxDomain_eq_less_numDomains
-                                         numDomains_less_numeric_explicit)
-               apply (drule (1) obj_at_cslift_tcb, clarsimp simp: inQ_def)
-               apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko"
-                        in rf_sr_sched_queue_relation)
-                 apply (fold_subgoals (prefix))[2]
-                 subgoal premises prems using prems by (fastforce simp: maxDom_to_H maxPrio_to_H)+
-
-               apply (frule_tac s=\<sigma> in tcb_queue_relation_prev_next', assumption)
-                  prefer 3
-                  apply fastforce
-                 apply (fold_subgoals (prefix))[2]
-                 subgoal premises prems using prems by ((fastforce simp: ksQ_tcb_at')+)
-               apply (drule_tac s=\<sigma> in tcbSchedDequeue_update, assumption,
-                      simp_all add: remove1_filter ksQ_tcb_at')[1]
-               (* trivial case, setting queue to empty *)
-               apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def carch_state_relation_def
-                                     cmachine_state_relation_def)
-               apply (erule (2) cready_queues_relation_empty_queue_helper)
-              (* impossible case, C L2 update disagrees with Haskell update *)
-              apply (simp add: invert_prioToL1Index_c_simp)
-              apply (subst (asm) num_domains_index_updates)
-               subgoal by (simp add: le_maxDomain_eq_less_numDomains word_le_nat_alt)
-              apply (subst (asm) Arrays.index_update)
-               apply (simp add: invert_l1_index_limit)
-
-              apply (frule rf_sr_cbitmap_L2_relation)
-              apply (drule_tac i="invertL1Index (prioToL1Index (tcbPriority ko))"
-                        in cbitmap_L2_relationD, assumption)
-               apply (fastforce simp: l2BitmapSize_def' invert_l1_index_limit)
-              apply (fastforce simp: prioToL1Index_def invertL1Index_def mask_def wordRadix_def)
-             (* impossible case *)
-             apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-             apply (drule(2) filter_empty_unfiltered_contr, fastforce)
-
-            apply (frule (1) valid_queuesD')
-            apply (drule (1) obj_at_cslift_tcb, clarsimp simp: inQ_def)
-            apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko"
-                     in rf_sr_sched_queue_relation)
-              apply fold_subgoals[2]
-              apply (fastforce simp: maxDom_to_H maxPrio_to_H)+
-            apply (clarsimp simp: h_val_field_clift'
-                                  h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)
-            apply (frule_tac s=\<sigma> in tcb_queue_relation_prev_next', assumption)
-               prefer 3
-               apply fastforce
-              apply (fold_subgoals (prefix))[2]
-              subgoal premises prems using prems by (fastforce simp: ksQ_tcb_at')+
-            apply (drule_tac s=\<sigma> in tcbSchedDequeue_update, assumption,
-                   simp_all add: remove1_filter ksQ_tcb_at')[1]
-            apply (clarsimp simp:  filter_noteq_op upd_unless_null_def)
-            apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                      unat_trans_ucast_helper\<close>)
-            apply (clarsimp simp: maxDomain_le_unat_ucast_explicit)
-            apply (rule conjI, clarsimp)
-             apply (clarsimp simp: h_val_field_clift'
-                                   h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)
-             apply (rule conjI; clarsimp)
-              apply (simp add: typ_heap_simps)
-              apply (clarsimp simp: h_t_valid_c_guard [OF h_t_valid_field, OF h_t_valid_clift]
-                                    h_t_valid_field[OF h_t_valid_clift] h_t_valid_clift)
-              apply (erule_tac S="set (ksReadyQueues \<sigma> (tcbDomain ko, tcbPriority ko))"
-                       in state_relation_queue_update_helper',
-                     (simp | rule globals.equality)+,
-                     simp_all add: clift_field_update if_Some_helper numPriorities_def
-                                   cready_queues_index_to_C_def2 typ_heap_simps
-                                   maxDom_to_H maxPrio_to_H
-                  cong: if_cong split del: if_split)[1]
-              apply (fold_subgoals (prefix))[2]
-              subgoal premises prems using prems by (fastforce simp: tcb_null_sched_ptrs_def)+
-             apply (erule_tac S="set (ksReadyQueues \<sigma> (tcbDomain ko, tcbPriority ko))"
-                      in state_relation_queue_update_helper',
-                    (simp | rule globals.equality)+,
-                    simp_all add: clift_field_update if_Some_helper numPriorities_def
-                                  cready_queues_index_to_C_def2
-                                  maxDom_to_H maxPrio_to_H
-                             cong: if_cong split del: if_split,
-                    simp_all add: typ_heap_simps')[1]
-              subgoal by (fastforce simp: tcb_null_sched_ptrs_def)
-             subgoal by fastforce
+          apply (clarsimp simp: simpler_gets_def get_def modify_def
+                                put_def bind_def return_def bitmap_fun_defs)
+          apply (frule rf_sr_cbitmap_L1_relation)
+          apply (erule cbitmap_L1_relation_update)
+          apply (erule (1) cbitmap_L1_relation_bit_clear)
+         apply wpsimp+
+     apply (fastforce simp: guard_is_UNIV_def)
+    apply clarsimp
+    done
+qed
 
+lemma ctcb_ptr_to_tcb_ptr_option_to_ctcb_ptr[simp]:
+  "ctcb_ptr_to_tcb_ptr (option_to_ctcb_ptr (Some ptr)) = ptr"
+  by (clarsimp simp: option_to_ctcb_ptr_def)
+
+lemma tcb_queue_remove_ccorres:
+  "ccorres ctcb_queue_relation ret__struct_tcb_queue_C_'
+     (\<lambda>s. tcb_at' tcbPtr s \<and> valid_objs' s
+          \<and> (tcbQueueHead queue \<noteq> None \<longleftrightarrow> tcbQueueEnd queue \<noteq> None))
+     (\<lbrace>ctcb_queue_relation queue \<acute>queue\<rbrace> \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr tcbPtr\<rbrace>) hs
+     (tcbQueueRemove queue tcbPtr) (Call tcb_queue_remove_'proc)"
+  (is "ccorres _ _ ?abs _ _ _ _")
+  supply if_split[split del]
+  apply (cinit' lift: tcb_')
+   apply (rename_tac tcb')
+   apply (simp only: tcbQueueRemove_def)
+    \<comment> \<open>cinit is not able to lift queue_' because queue_' is later modified in the C program\<close>
+   apply (rule_tac xf'=queue_' in ccorres_abstract, ceqv, rename_tac cqueue)
+   apply (rule_tac P="ctcb_queue_relation queue cqueue" in ccorres_gen_asm2)
+   apply (rule ccorres_pre_getObject_tcb, rename_tac tcb)
+   apply (rule ccorres_symb_exec_l, rename_tac beforePtrOpt)
+      apply (rule ccorres_symb_exec_l, rename_tac afterPtrOpt)
+         apply (rule ccorres_move_c_guard_tcb)
+         apply (rule_tac xf'="before___ptr_to_struct_tcb_C_'"
+                     and val="option_to_ctcb_ptr beforePtrOpt"
+                     and R="ko_at' tcb tcbPtr and K (tcbSchedPrev tcb = beforePtrOpt)"
+                     and R'=UNIV
+                      in ccorres_symb_exec_r_known_rv)
+            apply (rule conseqPre, vcg)
+            apply (fastforce dest: obj_at_cslift_tcb simp: typ_heap_simps ctcb_relation_def)
+           apply ceqv
+          apply (rule ccorres_move_c_guard_tcb)
+          apply (rule_tac xf'="after___ptr_to_struct_tcb_C_'"
+                      and val="option_to_ctcb_ptr afterPtrOpt"
+                      and R="ko_at' tcb tcbPtr and K (tcbSchedNext tcb = afterPtrOpt)"
+                       in ccorres_symb_exec_r_known_rv[where R'=UNIV])
+             apply (rule conseqPre, vcg)
+             apply (fastforce dest: obj_at_cslift_tcb simp: typ_heap_simps ctcb_relation_def)
+            apply ceqv
+           apply (rule ccorres_cond_seq)
+           apply (rule ccorres_cond[where R="?abs"])
+             apply (fastforce dest: tcb_at_not_NULL
+                              simp: ctcb_queue_relation_def option_to_ctcb_ptr_def)
+            apply (rule ccorres_rhs_assoc)+
+            apply csymbr
+            apply csymbr
+            apply (fastforce intro: ccorres_return_C')
+           apply (rule ccorres_cond_seq)
+           apply (rule_tac Q="?abs" and Q'=\<top> in ccorres_cond_both')
+             apply (fastforce dest: tcb_at_not_NULL
+                              simp: ctcb_queue_relation_def option_to_ctcb_ptr_def split: if_splits)
             apply clarsimp
-            apply (rule conjI; clarsimp)
-             apply (rule conjI)
-              apply (fastforce simp: c_invert_assist l2BitmapSize_def' wordRadix_def)
-             apply (rule conjI; clarsimp)
-              (* invalid, missing bitmap updates on haskell side *)
-              apply (fold_subgoals (prefix))[2]
-              subgoal premises prems using prems
-                        by (fastforce dest!: tcb_queue_relation'_empty_ksReadyQueues
-                                      elim: obj_at'_weaken)+
-            apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-            apply (erule_tac S="set (ksReadyQueues \<sigma> (tcbDomain ko, tcbPriority ko))"
-                     in state_relation_queue_update_helper',
-                   (simp | rule globals.equality)+,
-                   simp_all add: clift_field_update if_Some_helper numPriorities_def
-                                 cready_queues_index_to_C_def2
-                                 maxDom_to_H maxPrio_to_H
-                 cong: if_cong split del: if_split)[1]
-               apply (fold_subgoals (prefix))[4]
-               subgoal premises prems using prems
-                         by (fastforce simp: typ_heap_simps tcb_null_sched_ptrs_def)+
-           apply (rule conjI; clarsimp simp: queue_in_range[simplified maxDom_to_H maxPrio_to_H])
-            apply (frule (1) valid_queuesD')
-            apply (drule (1) obj_at_cslift_tcb, clarsimp simp: inQ_def)
-            apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko"
-                     in rf_sr_sched_queue_relation)
-              apply (fold_subgoals (prefix))[2]
-              subgoal premises prems using prems by (fastforce simp: maxDom_to_H maxPrio_to_H)+
-            apply (clarsimp simp: h_val_field_clift'
-                                  h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)
-            apply (frule_tac s=\<sigma> in tcb_queue_relation_prev_next')
+            apply (rule ccorres_assert2)
+            apply (rule ccorres_rhs_assoc)+
+            apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                apply (rule ccorres_move_c_guard_tcb)+
+                apply (rule_tac P=\<top> and P'="tcb_at' tcbPtr"
+                            and Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb (the afterPtrOpt) s}"
+                             in threadSet_ccorres_lemma3)
+                 apply (rule conseqPre, vcg)
+                 apply clarsimp
+                 apply (frule (1) obj_at_cslift_tcb)
+                 apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                   simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                         tcb_cte_cases_def cteSizeBits_def)
                 apply fastforce
-               prefer 3
-               apply fastforce
-              apply (fold_subgoals (prefix))[2]
-              subgoal premises prems using prems by (fastforce simp: ksQ_tcb_at')+
-            apply (drule_tac s=\<sigma> in tcbSchedDequeue_update, assumption,
-                   simp_all add: remove1_filter ksQ_tcb_at')[1]
-            apply (clarsimp simp:  filter_noteq_op upd_unless_null_def)
-            apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                      unat_trans_ucast_helper\<close>)
-            apply (clarsimp simp: maxDomain_le_unat_ucast_explicit)
-            apply (rule conjI; clarsimp)
-             apply (clarsimp simp: h_val_field_clift'
-                                   h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)
-             apply (clarsimp simp: typ_heap_simps)
-             apply (rule conjI; clarsimp simp: typ_heap_simps)
-             apply (drule(2) filter_empty_unfiltered_contr[simplified filter_noteq_op], simp)
-            apply (rule conjI)
-             apply (fastforce simp: c_invert_assist l2BitmapSize_def' wordRadix_def)
-            apply (rule conjI; clarsimp)
-             (* impossible case, C L2 update disagrees with Haskell update *)
-             apply (subst (asm) num_domains_index_updates)
-              apply (simp add: le_maxDomain_eq_less_numDomains word_le_nat_alt)
-             apply (subst (asm) Arrays.index_update)
-              subgoal using invert_l1_index_limit
-                by (fastforce simp add: invert_prioToL1Index_c_simp intro: nat_Suc_less_le_imp)
-             apply (frule rf_sr_cbitmap_L2_relation)
-             apply (simp add: invert_prioToL1Index_c_simp)
-             apply (drule_tac i="invertL1Index (prioToL1Index (tcbPriority ko))"
-                      in cbitmap_L2_relationD, assumption)
-              subgoal by (simp add: invert_l1_index_limit l2BitmapSize_def')
-             apply (fastforce simp: prioToL1Index_def invertL1Index_def mask_def wordRadix_def)
-
-            apply (simp add: invert_prioToL1Index_c_simp)
-            apply (subst rf_sr_drop_bitmaps_dequeue_helper_L2, assumption)
-             subgoal by (fastforce dest: rf_sr_cbitmap_L2_relation elim!: cbitmap_L2_relation_bit_clear)
-
-            (* trivial case, setting queue to empty *)
-            apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def carch_state_relation_def
-                                  cmachine_state_relation_def)
-            apply (erule (2) cready_queues_relation_empty_queue_helper)
-
-           apply (frule (1) valid_queuesD')
-           apply (drule (1) obj_at_cslift_tcb, clarsimp simp: inQ_def)
-           apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko"
-                    in rf_sr_sched_queue_relation)
-             apply (fold_subgoals (prefix))[2]
-             subgoal premises prems using prems by (fastforce simp: maxDom_to_H maxPrio_to_H)+
-           apply (clarsimp simp: h_val_field_clift'
-                                 h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)
-           apply (simp add: invert_prioToL1Index_c_simp)
-           apply (frule_tac s=\<sigma> in tcb_queue_relation_prev_next')
-              apply (fastforce simp add: ksQ_tcb_at')+
-           apply (drule_tac s=\<sigma> in tcbSchedDequeue_update, assumption,
-                  simp_all add: remove1_filter ksQ_tcb_at')[1]
-           apply (clarsimp simp: filter_noteq_op upd_unless_null_def)
-           apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                     unat_trans_ucast_helper\<close>)
-           apply (clarsimp simp: maxDomain_le_unat_ucast_explicit)
-           apply (rule conjI, clarsimp)
-            apply (clarsimp simp: h_val_field_clift'
-                                  h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)
-            apply (clarsimp simp: typ_heap_simps)
-            apply (rule conjI; clarsimp simp: typ_heap_simps)
-             apply (erule_tac S="set (ksReadyQueues \<sigma> (tcbDomain ko, tcbPriority ko))"
-                      in state_relation_queue_update_helper',
-                    (simp | rule globals.equality)+,
-                    simp_all add: clift_field_update if_Some_helper numPriorities_def
-                                  cready_queues_index_to_C_def2
-                                  maxDom_to_H maxPrio_to_H
-                             cong: if_cong split del: if_split)[1]
-               apply (fastforce simp: typ_heap_simps tcb_null_sched_ptrs_def)+
-            apply (erule_tac S="set (ksReadyQueues \<sigma> (tcbDomain ko, tcbPriority ko))"
-                     in state_relation_queue_update_helper',
-                   (simp | rule globals.equality)+,
-                   simp_all add: clift_field_update if_Some_helper numPriorities_def
-                                 cready_queues_index_to_C_def2
-                                 maxDom_to_H maxPrio_to_H
-                            cong: if_cong split del: if_split)[1]
-               apply (fold_subgoals (prefix))[4]
-               subgoal premises prems using prems
-                         by (fastforce simp: typ_heap_simps tcb_null_sched_ptrs_def)+
-           apply (clarsimp)
-           apply (rule conjI; clarsimp simp: typ_heap_simps)
-            apply (rule conjI)
-             apply (fastforce simp: c_invert_assist l2BitmapSize_def' wordRadix_def)
-            apply (rule conjI; clarsimp)
-             (* invalid, missing bitmap updates on haskell side *)
-             apply (drule tcb_queue_relation'_empty_ksReadyQueues)
-              apply (fold_subgoals (prefix))[2]
-              subgoal premises prems using prems by (fastforce elim: obj_at'_weaken)+
-            (* invalid, missing bitmap updates on haskell side *)
-            apply (drule tcb_queue_relation'_empty_ksReadyQueues)
-             apply (fold_subgoals (prefix))[2]
-             subgoal premises prems using prems by (fastforce elim: obj_at'_weaken)+
-           apply (erule_tac S="set (ksReadyQueues \<sigma> (tcbDomain ko, tcbPriority ko))"
-                    in state_relation_queue_update_helper',
-                  (simp | rule globals.equality)+,
-                  simp_all add: clift_field_update if_Some_helper numPriorities_def
-                                cready_queues_index_to_C_def2 typ_heap_simps
-                                maxDom_to_H maxPrio_to_H
-                           cong: if_cong split del: if_split)[1]
-             apply (fold_subgoals (prefix))[2]
-             subgoal premises prems using prems
-                       by (fastforce simp: typ_heap_simps tcb_null_sched_ptrs_def)+
-          apply (simp add: guard_is_UNIV_def)
-         apply simp
-         apply (wp threadGet_wp)
-        apply vcg
-       apply simp
-       apply (wp threadGet_wp)
-      apply vcg
-     apply (rule ccorres_return_Skip)
-    apply simp
-    apply (wp threadGet_wp)
-   apply vcg
-  by (fastforce simp: valid_objs'_def obj_at'_def ran_def projectKOs typ_at'_def
-                         valid_obj'_def valid_tcb'_def inQ_def)
-qed
-
-lemma tcbSchedDequeue_ccorres:
-  "ccorres dc xfdc
-           (valid_queues and valid_queues' and tcb_at' t and valid_objs')
-           (UNIV \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace>)
-           []
-           (tcbSchedDequeue t)
-           (Call tcbSchedDequeue_'proc)"
-  apply (rule ccorres_guard_imp [OF tcbSchedDequeue_ccorres'])
-   apply (clarsimp simp: valid_queues_def valid_queues_no_bitmap_def)
-   apply (drule_tac x=d in spec)
-   apply (drule_tac x=p in spec)
-   apply (clarsimp)
-   apply (drule(1) bspec)
-   apply (erule obj_at'_weakenE)
-   apply (clarsimp)+
-  done
-
-lemma tcb_queue_relation_append:
-  "\<lbrakk> tcb_queue_relation tn tp mp queue qprev qhead; queue \<noteq> [];
-     qend' \<notin> tcb_ptr_to_ctcb_ptr ` set queue; mp qend' = Some tcb;
-     queue = queue' @ [ctcb_ptr_to_tcb_ptr qend]; distinct queue;
-     \<forall>x \<in> set queue. tcb_ptr_to_ctcb_ptr x \<noteq> NULL; qend' \<noteq> NULL;
-     \<And>v f g. tn (tn_update f v) = f (tn v) \<and> tp (tp_update g v) = g (tp v)
-                \<and> tn (tp_update f v) = tn v \<and> tp (tn_update g v) = tp v \<rbrakk>
-    \<Longrightarrow> tcb_queue_relation tn tp
-          (mp (qend \<mapsto> tn_update (\<lambda>_. qend') (the (mp qend)),
-               qend' \<mapsto> tn_update (\<lambda>_. NULL) (tp_update (\<lambda>_. qend) tcb)))
-          (queue @ [ctcb_ptr_to_tcb_ptr qend']) qprev qhead"
-  using [[hypsubst_thin = true]]
-  apply clarsimp
-  apply (induct queue' arbitrary: qprev qhead)
-   apply clarsimp
-  apply clarsimp
-  done
-
-lemma tcbSchedAppend_update:
-  assumes sr: "sched_queue_relation' mp queue qhead qend"
-  and     qh': "qend' \<notin> tcb_ptr_to_ctcb_ptr ` set queue"
-  and  cs_tcb: "mp qend' = Some tcb"
-  and valid_ep: "\<forall>t\<in>set queue. tcb_at' t s" "distinct queue"
-  and     qhN: "qend' \<noteq> NULL"
-  shows
-  "sched_queue_relation'
-            (upd_unless_null qend (tcbSchedNext_C_update (\<lambda>_. qend') (the (mp qend)))
-                (mp(qend' \<mapsto> tcb\<lparr>tcbSchedNext_C := NULL, tcbSchedPrev_C := qend\<rparr>)))
-            (queue @ [ctcb_ptr_to_tcb_ptr qend']) (if queue = [] then qend' else qhead) qend'"
-  using sr qh' valid_ep cs_tcb qhN
-  apply -
-  apply (rule rev_cases[where xs=queue])
-   apply (simp add: tcb_queue_relation'_def upd_unless_null_def)
-  apply (clarsimp simp: tcb_queue_relation'_def upd_unless_null_def tcb_at_not_NULL)
-  apply (drule_tac qend'=qend' and tn_update=tcbSchedNext_C_update
-             and tp_update=tcbSchedPrev_C_update and qend="tcb_ptr_to_ctcb_ptr y"
-             in tcb_queue_relation_append, simp_all)
-   apply (fastforce simp add: tcb_at_not_NULL)
-  apply (simp add: fun_upd_twist)
-  done
-
-lemma tcb_queue_relation_qend_mems:
-  "\<lbrakk> tcb_queue_relation' getNext getPrev mp queue qhead qend;
-     \<forall>x \<in> set queue. tcb_at' x s \<rbrakk>
-      \<Longrightarrow> (qend = NULL \<longrightarrow> queue = [])
-       \<and> (qend \<noteq> NULL \<longrightarrow> ctcb_ptr_to_tcb_ptr qend \<in> set queue)"
-  apply (clarsimp simp: tcb_queue_relation'_def)
-  apply (drule bspec, erule last_in_set)
-  apply (simp add: tcb_at_not_NULL)
+               apply ceqv
+              apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                  apply (rule ccorres_move_c_guard_tcb)
+                  apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb tcbPtr s}"
+                               in threadSet_ccorres_lemma3[where P=\<top> and P'=\<top>, simplified])
+                   apply (rule conseqPre, vcg)
+                   apply clarsimp
+                   apply (frule (1) obj_at_cslift_tcb[where thread=tcbPtr])
+                   apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                     simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                           tcb_cte_cases_def cteSizeBits_def)
+                  apply clarsimp
+                 apply ceqv
+                apply (rule ccorres_symb_exec_r)
+                  apply (fastforce intro: ccorres_return_C')
+                 apply vcg
+                apply (rule conseqPre, vcg)
+                apply clarsimp
+               apply wpsimp
+              apply vcg
+             apply wpsimp
+            apply vcg
+           apply (rule ccorres_cond_seq)
+           apply (rule_tac Q="?abs" and Q'=\<top> in ccorres_cond_both')
+             apply (fastforce dest: tcb_at_not_NULL
+                              simp: ctcb_queue_relation_def option_to_ctcb_ptr_def split: if_splits)
+            apply clarsimp
+            apply (rule ccorres_assert2)
+            apply (rule ccorres_rhs_assoc)+
+            apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                apply (rule ccorres_move_c_guard_tcb)+
+                apply (rule_tac P=\<top> and P'="tcb_at' tcbPtr"
+                            and Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb (the beforePtrOpt) s}"
+                             in threadSet_ccorres_lemma3)
+                 apply (rule conseqPre, vcg)
+                 apply clarsimp
+                 apply (frule (1) obj_at_cslift_tcb)
+                 apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                   simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                         tcb_cte_cases_def cteSizeBits_def)
+                apply fastforce
+               apply ceqv
+              apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                  apply (rule ccorres_move_c_guard_tcb)
+                  apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb tcbPtr s}"
+                               in threadSet_ccorres_lemma3[where P=\<top> and P'=\<top>, simplified])
+                   apply (rule conseqPre, vcg)
+                   apply clarsimp
+                   apply (frule (1) obj_at_cslift_tcb[where thread=tcbPtr])
+                   apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                     simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                           tcb_cte_cases_def cteSizeBits_def)
+                  apply clarsimp
+                 apply ceqv
+                apply (rule ccorres_symb_exec_r)
+                  apply (fastforce intro: ccorres_return_C')
+                 apply vcg
+                apply (rule conseqPre, vcg)
+                apply clarsimp
+               apply wpsimp
+              apply vcg
+             apply wpsimp
+            apply vcg
+           apply clarsimp
+           apply (rule ccorres_assert2)+
+           apply (rule ccorres_rhs_assoc)+
+           apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+               apply (rule ccorres_move_c_guard_tcb)+
+               apply (rule_tac Q="\<lambda>s tcb'. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb' (the beforePtrOpt) s}"
+                            in threadSet_ccorres_lemma3[where P=\<top> and P'=\<top>, simplified])
+                apply (rule conseqPre, vcg)
+                apply clarsimp
+                apply (frule (1) obj_at_cslift_tcb)
+                apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                  simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                        tcb_cte_cases_def cteSizeBits_def)
+               apply clarsimp
+              apply ceqv
+             apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                 apply (rule ccorres_move_c_guard_tcb)+
+                 apply (rule_tac P=\<top> and P'="tcb_at' tcbPtr"
+                             and Q="\<lambda>s tcb'. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb' (the afterPtrOpt) s}"
+                              in threadSet_ccorres_lemma3)
+                  apply (rule conseqPre, vcg)
+                  apply clarsimp
+                  apply (frule (1) obj_at_cslift_tcb)
+                  apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                    simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                          tcb_cte_cases_def cteSizeBits_def)
+                 apply clarsimp
+                apply ceqv
+               apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                   apply (rule ccorres_move_c_guard_tcb)
+                   apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb tcbPtr s}"
+                                in threadSet_ccorres_lemma3[where P=\<top> and P'=\<top>, simplified])
+                    apply (rule conseqPre, vcg)
+                    apply clarsimp
+                    apply (frule (1) obj_at_cslift_tcb[where thread=tcbPtr])
+                    apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                      simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                            tcb_cte_cases_def cteSizeBits_def)
+                   apply clarsimp
+                  apply ceqv
+                 apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                     apply (rule ccorres_move_c_guard_tcb)
+                     apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb tcbPtr s}"
+                                  in threadSet_ccorres_lemma3[where P=\<top> and P'=\<top>, simplified])
+                      apply (rule conseqPre, vcg)
+                      apply clarsimp
+                      apply (frule (1) obj_at_cslift_tcb[where thread=tcbPtr])
+                      apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                        simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                              tcb_cte_cases_def cteSizeBits_def)
+                     apply fastforce
+                    apply ceqv
+                   apply (fastforce intro: ccorres_return_C')
+                  apply (wpsimp | vcg)+
+  apply (clarsimp split: if_splits)
+  apply normalise_obj_at'
+  apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+  by (intro conjI impI;
+      clarsimp simp: ctcb_queue_relation_def typ_heap_simps option_to_ctcb_ptr_def
+                     valid_tcb'_def valid_bound_tcb'_def)
+
+lemma tcbQueueRemove_tcb_at'_head:
+  "\<lbrace>\<lambda>s. valid_objs' s \<and> (\<forall>head. tcbQueueHead queue = Some head \<longrightarrow> tcb_at' head s)\<rbrace>
+   tcbQueueRemove queue t
+   \<lbrace>\<lambda>rv s. \<not> tcbQueueEmpty rv \<longrightarrow> tcb_at' (the (tcbQueueHead rv)) s\<rbrace>"
+  unfolding tcbQueueRemove_def
+  apply (wpsimp wp: getTCB_wp haskell_assert_wp hoare_vcg_imp_lift')
+  apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+  apply (fastforce simp: valid_tcb'_def valid_bound_tcb'_def tcbQueueEmpty_def obj_at'_def)
   done
 
-lemma tcbSchedAppend_ccorres:
+lemma tcbSchedDequeue_ccorres:
   "ccorres dc xfdc
-           (valid_queues and tcb_at' t and valid_objs')
-           (UNIV \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace>)
-           []
-           (tcbSchedAppend t)
-           (Call tcbSchedAppend_'proc)"
+     (tcb_at' t and valid_objs' and pspace_aligned' and pspace_distinct')
+     \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace> hs
+     (tcbSchedDequeue t) (Call tcbSchedDequeue_'proc)"
 proof -
   note prio_and_dom_limit_helpers[simp] word_sle_def[simp] maxDom_to_H[simp] maxPrio_to_H[simp]
+  note invert_prioToL1Index_c_simp[simp]
 
   (* when numDomains = 1, array bounds checks would become _ = 0 rather than _ < 1, changing the
      shape of the proof compared to when numDomains > 1 *)
-  include no_less_1_simps
+  note word_less_1[simp del]
 
   show ?thesis
-  apply (cinit lift: tcb_')
-   apply (rule_tac r'="\<lambda>rv rv'. rv = to_bool rv'"
-               and xf'="ret__unsigned_'" in ccorres_split_nothrow)
-       apply (rule threadGet_vcg_corres)
-       apply (rule allI, rule conseqPre, vcg)
-       apply clarsimp
-       apply (drule obj_at_ko_at', clarsimp)
-       apply (drule spec, drule(1) mp, clarsimp)
-       apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-      apply ceqv
-     apply (simp add: when_def unless_def del: Collect_const split del: if_split)
-     apply (rule ccorres_cond[where R=\<top>])
-       apply (simp add: to_bool_def)
-      apply (rule ccorres_rhs_assoc)+
-      apply csymbr
-      apply csymbr
-      apply csymbr
-      apply csymbr
-      apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv"
-          and xf'="dom_'" in ccorres_split_nothrow)
-          apply (rule threadGet_vcg_corres)
-          apply (rule allI, rule conseqPre, vcg)
-          apply clarsimp
-          apply (drule obj_at_ko_at', clarsimp)
-          apply (drule spec, drule(1) mp, clarsimp)
-          apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-         apply ceqv
-        apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv"
-            and xf'="prio_'" in ccorres_split_nothrow)
+    apply (cinit lift: tcb_')
+     apply (rule ccorres_stateAssert)+
+     apply (rule_tac r'="\<lambda>rv rv'. rv = to_bool rv'" and xf'="ret__unsigned_'"
+                  in ccorres_split_nothrow)
+         apply (rule threadGet_vcg_corres)
+         apply (rule allI, rule conseqPre, vcg)
+         apply clarsimp
+         apply (drule obj_at_ko_at', clarsimp)
+         apply (drule spec, drule(1) mp, clarsimp)
+         apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+        apply ceqv
+       apply (simp add: when_def del: Collect_const split del: if_split)
+       apply (rule ccorres_cond[where R=\<top>])
+         apply (simp add: to_bool_def)
+        apply (rule ccorres_rhs_assoc)+
+        apply csymbr
+        apply csymbr
+        apply csymbr
+        apply csymbr
+        apply csymbr
+        apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="dom_'" in ccorres_split_nothrow)
             apply (rule threadGet_vcg_corres)
             apply (rule allI, rule conseqPre, vcg)
             apply clarsimp
@@ -1667,124 +1447,98 @@ proof -
             apply (drule spec, drule(1) mp, clarsimp)
             apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
            apply ceqv
-          apply (rule ccorres_rhs_assoc2)+
-          apply (simp only: bind_assoc[symmetric])
-          apply (rule ccorres_split_nothrow_novcg_dc)
-             prefer 2
-             apply (rule ccorres_move_c_guard_tcb)
-             apply ctac
-            prefer 2
-            apply (wp, clarsimp, wp+)
-           apply (rule_tac P="\<lambda>s. valid_queues s \<and> (\<forall>p. t \<notin> set (ksReadyQueues s p))
-                                  \<and> (\<exists>tcb. ko_at' tcb t s \<and> tcbDomain tcb =rva
-                                  \<and> tcbPriority tcb = rvb \<and> valid_tcb' tcb s)"
-                       and P'=UNIV in ccorres_from_vcg)
-           apply (rule allI, rule conseqPre, vcg)
-           apply (clarsimp simp: getQueue_def gets_def get_def setQueue_def modify_def
-                                 put_def bind_def return_def bitmap_fun_defs null_def)
-           apply (clarsimp simp: queue_in_range valid_tcb'_def)
-           apply (rule conjI; clarsimp simp: queue_in_range)
-            apply (drule (1) obj_at_cslift_tcb)
-            apply clarsimp
-            apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb"
-                     in rf_sr_sched_queue_relation)
+          apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="prio_'" in ccorres_split_nothrow)
+              apply (rule threadGet_vcg_corres)
+              apply (rule allI, rule conseqPre, vcg)
               apply clarsimp
-             apply clarsimp
-            apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL)
-             apply (simp add: valid_queues_valid_q)
-            apply (frule_tac s=\<sigma> in tcb_queue_relation_qend_mems,  simp add: valid_queues_valid_q)
-            apply (drule_tac qend'="tcb_ptr_to_ctcb_ptr t" and s=\<sigma> in tcbSchedAppend_update,
-                   simp_all add: valid_queues_valid_q)[1]
-             apply (rule tcb_at_not_NULL, erule obj_at'_weakenE, simp)
-            apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-            apply (simp add: invert_prioToL1Index_c_simp)
-            apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                      unat_trans_ucast_helper\<close>)
-            apply (clarsimp simp: maxDomain_le_unat_ucast_explicit)
-            apply (rule conjI; clarsimp)
-             apply (rule conjI)
-              apply (fastforce simp: c_invert_assist l2BitmapSize_def' wordRadix_def)
-             apply (simp add: t_hrs_ksReadyQueues_upd_absorb)
-             apply (subst rf_sr_drop_bitmaps_enqueue_helper, assumption)
-               apply (fastforce intro: cbitmap_L1_relation_bit_set)
-              subgoal by (fastforce intro: cbitmap_L2_relation_bit_set simp: wordRadix_def mask_def)
-             apply (erule(1) state_relation_queue_update_helper[where S="{t}"],
-                    (simp | rule globals.equality)+,
-                    simp_all add: cready_queues_index_to_C_def2 numPriorities_def
-                                  t_hrs_ksReadyQueues_upd_absorb upd_unless_null_def
-                                  typ_heap_simps)[1]
-               apply (fastforce simp: tcb_null_sched_ptrs_def elim: obj_at'_weaken)+
-            apply (clarsimp simp: upd_unless_null_def cready_queues_index_to_C_def numPriorities_def)
-           apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                     unat_trans_ucast_helper\<close>)
-           apply (clarsimp simp: maxDomain_le_unat_ucast_explicit)
-           apply (rule conjI; clarsimp simp: queue_in_range)
-            apply (drule (1) obj_at_cslift_tcb)
-            apply clarsimp
-            apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb"
-                     in rf_sr_sched_queue_relation)
-              apply clarsimp
-             apply clarsimp
-            apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL)
-             apply (simp add: valid_queues_valid_q)
-            apply (frule_tac s=\<sigma> in tcb_queue_relation_qend_mems,
-                   simp add: valid_queues_valid_q)
-            apply (drule_tac qend'="tcb_ptr_to_ctcb_ptr t" and s=\<sigma> in tcbSchedAppend_update,
-                   simp_all add: valid_queues_valid_q)[1]
-              apply clarsimp
-             apply (rule tcb_at_not_NULL, erule obj_at'_weakenE, simp)
-            apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-            apply (clarsimp simp: upd_unless_null_def cready_queues_index_to_C_def numPriorities_def)
-           apply (drule (1) obj_at_cslift_tcb)
-           apply clarsimp
-           apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb"
-                    in rf_sr_sched_queue_relation)
-             apply clarsimp
+              apply (drule obj_at_ko_at', clarsimp)
+              apply (drule spec, drule(1) mp, clarsimp)
+              apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+             apply ceqv
+            apply (rule ccorres_symb_exec_r)
+              apply (rule ccorres_Guard_Seq)
+              apply (simp add: bind_assoc)
+              apply (ctac add: getQueue_ccorres)
+                apply (rule_tac r'=ctcb_queue_relation and xf'=new_queue_' in ccorres_split_nothrow)
+                    apply (ctac add: tcb_queue_remove_ccorres)
+                   apply ceqv
+                  apply (rename_tac queue' newqueue)
+                  apply (rule ccorres_Guard_Seq)
+                  apply (ctac add: setQueue_ccorres)
+                    apply (rule ccorres_split_nothrow_novcg_dc)
+                       apply ctac
+                      apply (rule_tac xf'=ret__unsigned_long_'
+                                  and val="from_bool (tcbQueueEmpty queue')"
+                                  and R="\<lambda>s. \<not> tcbQueueEmpty queue' \<longrightarrow> tcb_at' (the (tcbQueueHead queue')) s"
+                                  in ccorres_symb_exec_r_known_rv[where R'=UNIV])
+                         apply (rule conseqPre, vcg)
+                         apply (fastforce dest: tcb_at_not_NULL
+                                          simp: ctcb_queue_relation_def option_to_ctcb_ptr_def
+                                                tcbQueueEmpty_def split: option.splits)
+                        apply ceqv
+                       apply (rule ccorres_cond[where R=\<top>])
+                         apply fastforce
+                        apply (ctac add: removeFromBitmap_ccorres)
+                       apply (rule ccorres_return_Skip)
+                      apply vcg
+                     apply (wpsimp wp: hoare_vcg_imp_lift')
+                    apply (clarsimp simp: guard_is_UNIV_def)
+                   apply (wpsimp wp: hoare_vcg_imp_lift')
+                  apply vcg
+                 apply ((wpsimp wp: tcbQueueRemove_tcb_at'_head | wp (once) hoare_drop_imps)+)[1]
+                apply (vcg exspec=tcb_queue_remove_modifies)
+               apply wpsimp
+              apply vcg
+             apply vcg
+            apply (rule conseqPre, vcg)
             apply clarsimp
-           apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL)
-            apply (simp add: valid_queues_valid_q)
-           apply (frule_tac s=\<sigma> in tcb_queue_relation_qend_mems,
-                  simp add: valid_queues_valid_q)
-           apply (drule_tac qend'="tcb_ptr_to_ctcb_ptr t" and s=\<sigma> in tcbSchedAppend_update,
-                  simp_all add: valid_queues_valid_q)[1]
-             apply clarsimp
-            apply (rule tcb_at_not_NULL, erule obj_at'_weakenE, simp)
-           apply (clarsimp simp: cready_queues_index_to_C_def2 numPriorities_def)
-           apply (frule(2) obj_at_cslift_tcb[OF valid_queues_obj_at'D])
-           apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-           apply (erule_tac S="{t, v}" for v in state_relation_queue_update_helper,
-                  (simp | rule globals.equality)+,
-                  simp_all add: typ_heap_simps if_Some_helper numPriorities_def
-                                cready_queues_index_to_C_def2 upd_unless_null_def
-                           cong: if_cong split del: if_split
-                           del: fun_upd_restrict_conv)[1]
-              apply simp
-              apply (rule conjI)
-               apply clarsimp
-               apply (drule_tac s="tcb_ptr_to_ctcb_ptr t" in sym, simp)
-              apply (clarsimp simp add: fun_upd_twist)
-             prefer 3
-             apply (simp add: obj_at'_weakenE[OF _ TrueI])
-             apply (rule disjI1, erule valid_queues_obj_at'D)
-             subgoal by simp
-            subgoal by simp
-           subgoal by (fastforce simp: tcb_null_sched_ptrs_def)
-          apply (simp add: guard_is_UNIV_def)
-         apply simp
-         apply (wp threadGet_wp)
+           apply (wpsimp wp: threadGet_wp)
+          apply vcg
+         apply clarsimp
+         apply (wpsimp wp: threadGet_wp)
         apply vcg
-       apply simp
-       apply (wp threadGet_wp)
-      apply vcg
-     apply (rule ccorres_return_Skip)
-    apply simp
-    apply (wp threadGet_wp)
-   apply vcg
-  by (fastforce simp: valid_objs'_def obj_at'_def ran_def projectKOs typ_at'_def
-                         valid_obj'_def inQ_def
-                   dest!: valid_queues_obj_at'D)
+       apply (rule ccorres_return_Skip)
+      apply (wpsimp wp: threadGet_wp)
+     apply (vcg expsec=thread_state_get_tcbQueued_modifies)
+    apply normalise_obj_at'
+    apply (rename_tac tcb)
+    apply (frule (1) obj_at_cslift_tcb)
+    apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+    apply (clarsimp simp: valid_tcb'_def)
+    apply (cut_tac qdom="tcbDomain tcb" and prio="tcbPriority tcb"
+                in cready_queues_index_to_C_in_range)
+      apply fastforce
+     apply fastforce
+    apply (rule conjI)
+     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
+     apply (frule (3) obj_at'_tcbQueueHead_ksReadyQueues)
+     apply (force dest!: tcbQueueHead_iff_tcbQueueEnd simp: tcbQueueEmpty_def obj_at'_def)
+    by (fastforce simp: word_less_nat_alt
+                        cready_queues_index_to_C_def2 ctcb_relation_def
+                        typ_heap_simps le_maxDomain_eq_less_numDomains(2) unat_trans_ucast_helper)
 qed
 
+lemma tcb_queue_relation_append:
+  "\<lbrakk> tcb_queue_relation tn tp' mp queue qprev qhead; queue \<noteq> [];
+     qend' \<notin> tcb_ptr_to_ctcb_ptr ` set queue; mp qend' = Some tcb;
+     queue = queue' @ [ctcb_ptr_to_tcb_ptr qend]; distinct queue;
+     \<forall>x \<in> set queue. tcb_ptr_to_ctcb_ptr x \<noteq> NULL; qend' \<noteq> NULL;
+     \<And>v f g. tn (tn_update f v) = f (tn v) \<and> tp' (tp_update g v) = g (tp' v)
+                \<and> tn (tp_update f v) = tn v \<and> tp' (tn_update g v) = tp' v \<rbrakk>
+    \<Longrightarrow> tcb_queue_relation tn tp'
+          (mp (qend \<mapsto> tn_update (\<lambda>_. qend') (the (mp qend)),
+               qend' \<mapsto> tn_update (\<lambda>_. NULL) (tp_update (\<lambda>_. qend) tcb)))
+          (queue @ [ctcb_ptr_to_tcb_ptr qend']) qprev qhead"
+  using [[hypsubst_thin = true]]
+  apply clarsimp
+  apply (induct queue' arbitrary: qprev qhead)
+   apply clarsimp
+  apply clarsimp
+  done
+
 lemma isRunnable_spec:
   "\<forall>s. \<Gamma> \<turnstile> ({s} \<inter> {s. cslift s (thread_' s) \<noteq> None}) Call isRunnable_'proc
        {s'. ret__unsigned_long_' s' = from_bool (tsType_CL (thread_state_lift (tcbState_C (the (cslift s (thread_' s))))) \<in>
@@ -1820,8 +1574,11 @@ lemma tcb_at_1:
   done
 
 lemma rescheduleRequired_ccorres:
-  "ccorres dc xfdc (valid_queues and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and valid_objs')
-           UNIV [] rescheduleRequired (Call rescheduleRequired_'proc)"
+  "ccorres dc xfdc
+     ((\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and valid_objs'
+      and pspace_aligned' and pspace_distinct')
+     UNIV []
+     rescheduleRequired (Call rescheduleRequired_'proc)"
   apply cinit
    apply (rule ccorres_symb_exec_l)
       apply (rule ccorres_split_nothrow_novcg[where r'=dc and xf'=xfdc])
@@ -1927,16 +1684,18 @@ lemma rf_sr_ksReadyQueuesL1Bitmap_simp:
   done
 
 lemma lookupBitmapPriority_le_maxPriority:
-  "\<lbrakk> ksReadyQueuesL1Bitmap s d \<noteq> 0 ; valid_queues s \<rbrakk>
+  "\<lbrakk> ksReadyQueuesL1Bitmap s d \<noteq> 0 ;
+     \<forall>d p. d > maxDomain \<or> p > maxPriority \<longrightarrow> tcbQueueEmpty (ksReadyQueues s (d, p));
+     valid_bitmaps s \<rbrakk>
    \<Longrightarrow> lookupBitmapPriority d s \<le> maxPriority"
-   unfolding valid_queues_def valid_queues_no_bitmap_def
-   by (fastforce dest!: bitmapQ_from_bitmap_lookup bitmapQ_ksReadyQueuesI intro: ccontr)
+  apply (clarsimp simp: valid_bitmaps_def)
+  by (fastforce dest!: bitmapQ_from_bitmap_lookup bitmapQ_ksReadyQueuesI intro: ccontr)
 
 lemma ksReadyQueuesL1Bitmap_word_log2_max:
-    "\<lbrakk>valid_queues s; ksReadyQueuesL1Bitmap s d \<noteq> 0\<rbrakk>
-    \<Longrightarrow> word_log2 (ksReadyQueuesL1Bitmap s d) < l2BitmapSize"
-    unfolding valid_queues_def
-    by (fastforce dest: word_log2_nth_same bitmapQ_no_L1_orphansD)
+  "\<lbrakk>valid_bitmaps s; ksReadyQueuesL1Bitmap s d \<noteq> 0\<rbrakk>
+   \<Longrightarrow> word_log2 (ksReadyQueuesL1Bitmap s d) < l2BitmapSize"
+  unfolding valid_bitmaps_def
+  by (fastforce dest: word_log2_nth_same bitmapQ_no_L1_orphansD)
 
 lemma clzl_spec:
   "\<forall>s. \<Gamma> \<turnstile> {\<sigma>. s = \<sigma> \<and> x___unsigned_long_' s \<noteq> 0} Call clzl_'proc
@@ -2133,9 +1892,9 @@ lemma threadGet_get_obj_at'_has_domain:
 lemma possibleSwitchTo_ccorres:
   shows
   "ccorres dc xfdc
-         (valid_queues and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
+         ((\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
             and st_tcb_at' runnable' t and (\<lambda>s. ksCurDomain s \<le> maxDomain)
-            and valid_objs')
+            and valid_objs' and pspace_aligned' and pspace_distinct')
          ({s. target_' s = tcb_ptr_to_ctcb_ptr t}
           \<inter> UNIV) []
      (possibleSwitchTo t )
@@ -2183,8 +1942,8 @@ lemma possibleSwitchTo_ccorres:
 
 lemma scheduleTCB_ccorres':
   "ccorres dc xfdc
-           (tcb_at' thread and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and valid_queues
-                           and valid_objs')
+           (tcb_at' thread and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
+                           and valid_objs' and pspace_aligned' and pspace_distinct')
            (UNIV \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr thread})
            []
   (do (runnable, curThread, action) \<leftarrow> do
@@ -2234,24 +1993,26 @@ lemma scheduleTCB_ccorres':
            apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
                                  cscheduler_action_relation_def)
           apply wp+
-     apply (simp add: isRunnable_def isStopped_def)
-    apply wp
+   apply (simp add: isRunnable_def isStopped_def)
    apply (simp add: guard_is_UNIV_def)
   apply clarsimp
   apply (clarsimp simp: st_tcb_at'_def obj_at'_def weak_sch_act_wf_def)
   done
 
 lemma scheduleTCB_ccorres_valid_queues'_pre:
-        "ccorresG rf_sr \<Gamma> dc xfdc (tcb_at' thread and st_tcb_at' (not runnable') thread and valid_queues' and valid_queues and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and valid_objs')
-         (UNIV \<inter> \<lbrace>\<acute>tptr = tcb_ptr_to_ctcb_ptr thread\<rbrace>) []
-         (do (runnable, curThread, action) \<leftarrow> do
-             runnable \<leftarrow> isRunnable thread;
-             curThread \<leftarrow> getCurThread;
-             action \<leftarrow> getSchedulerAction;
-             return (runnable, curThread, action) od;
-             when (\<not> runnable \<and> curThread = thread \<and> action = ResumeCurrentThread) rescheduleRequired
-          od)
-         (Call scheduleTCB_'proc)"
+  "ccorresG rf_sr \<Gamma> dc xfdc
+     (tcb_at' thread and st_tcb_at' (not runnable') thread
+      and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
+      and valid_objs' and pspace_aligned' and pspace_distinct')
+     \<lbrace>\<acute>tptr = tcb_ptr_to_ctcb_ptr thread\<rbrace> []
+     (do (runnable, curThread, action) \<leftarrow> do runnable \<leftarrow> isRunnable thread;
+                                             curThread \<leftarrow> getCurThread;
+                                             action \<leftarrow> getSchedulerAction;
+                                             return (runnable, curThread, action)
+                                          od;
+         when (\<not> runnable \<and> curThread = thread \<and> action = ResumeCurrentThread) rescheduleRequired
+      od)
+     (Call scheduleTCB_'proc)"
   supply empty_fail_cond[simp]
   apply (cinit' lift: tptr_' simp del: word_neq_0_conv)
    apply (rule ccorres_rhs_assoc2)+
@@ -2292,17 +2053,17 @@ lemma scheduleTCB_ccorres_valid_queues'_pre:
                            split: scheduler_action.split_asm)
           apply wp+
      apply (simp add: isRunnable_def isStopped_def)
-    apply wp
    apply (simp add: guard_is_UNIV_def)
   apply (clarsimp simp: st_tcb_at'_def obj_at'_def)
   done
 
-
 lemmas scheduleTCB_ccorres_valid_queues'
     = scheduleTCB_ccorres_valid_queues'_pre[unfolded bind_assoc return_bind split_conv]
 
 lemma rescheduleRequired_ccorres_valid_queues'_simple:
-  "ccorresG rf_sr \<Gamma> dc xfdc (valid_queues' and sch_act_simple) UNIV [] rescheduleRequired (Call rescheduleRequired_'proc)"
+  "ccorresG rf_sr \<Gamma> dc xfdc
+     sch_act_simple UNIV []
+     rescheduleRequired (Call rescheduleRequired_'proc)"
   apply cinit
    apply (rule ccorres_symb_exec_l)
       apply (rule ccorres_split_nothrow_novcg[where r'=dc and xf'=xfdc])
@@ -2335,16 +2096,17 @@ lemma rescheduleRequired_ccorres_valid_queues'_simple:
                  split: scheduler_action.split_asm)
 
 lemma scheduleTCB_ccorres_valid_queues'_pre_simple:
-        "ccorresG rf_sr \<Gamma> dc xfdc (tcb_at' thread and st_tcb_at' (not runnable') thread and valid_queues' and sch_act_simple)
-         (UNIV \<inter> \<lbrace>\<acute>tptr = tcb_ptr_to_ctcb_ptr thread\<rbrace>) []
-         (do (runnable, curThread, action) \<leftarrow> do
-             runnable \<leftarrow> isRunnable thread;
-             curThread \<leftarrow> getCurThread;
-             action \<leftarrow> getSchedulerAction;
-             return (runnable, curThread, action) od;
-             when (\<not> runnable \<and> curThread = thread \<and> action = ResumeCurrentThread) rescheduleRequired
-          od)
-         (Call scheduleTCB_'proc)"
+  "ccorresG rf_sr \<Gamma> dc xfdc
+     (tcb_at' thread and st_tcb_at' (not runnable') thread and valid_queues' and sch_act_simple)
+     \<lbrace>\<acute>tptr = tcb_ptr_to_ctcb_ptr thread\<rbrace> []
+     (do (runnable, curThread, action) \<leftarrow> do runnable \<leftarrow> isRunnable thread;
+                                             curThread \<leftarrow> getCurThread;
+                                             action \<leftarrow> getSchedulerAction;
+                                             return (runnable, curThread, action)
+                                          od;
+         when (\<not> runnable \<and> curThread = thread \<and> action = ResumeCurrentThread) rescheduleRequired
+      od)
+     (Call scheduleTCB_'proc)"
   supply empty_fail_cond[simp]
   apply (cinit' lift: tptr_' simp del: word_neq_0_conv)
    apply (rule ccorres_rhs_assoc2)+
@@ -2383,11 +2145,10 @@ lemma scheduleTCB_ccorres_valid_queues'_pre_simple:
            apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
                                  cscheduler_action_relation_def)
           apply wp+
-     apply (simp add: isRunnable_def isStopped_def)
-    apply wp
+   apply (simp add: isRunnable_def isStopped_def)
    apply (simp add: guard_is_UNIV_def)
   apply clarsimp
-  apply (clarsimp simp: st_tcb_at'_def obj_at'_def valid_queues'_def)
+  apply (clarsimp simp: st_tcb_at'_def obj_at'_def)
   done
 
 lemmas scheduleTCB_ccorres_valid_queues'_simple
@@ -2407,48 +2168,35 @@ lemma threadSet_weak_sch_act_wf_runnable':
   apply (clarsimp)
 done
 
-lemma threadSet_valid_queues_and_runnable': "\<lbrace>\<lambda>s. valid_queues s \<and> (\<forall>p. thread \<in> set (ksReadyQueues s p) \<longrightarrow> runnable' st)\<rbrace>
-                 threadSet (tcbState_update (\<lambda>_. st)) thread
-               \<lbrace>\<lambda>rv s. valid_queues s\<rbrace>"
-  apply (wp threadSet_valid_queues)
-  apply (clarsimp simp: inQ_def)
-done
-
 lemma setThreadState_ccorres[corres]:
    "ccorres dc xfdc
-   (\<lambda>s. tcb_at' thread s \<and> valid_queues s \<and> valid_objs' s \<and> valid_tcb_state' st s \<and>
-                 (ksSchedulerAction s = SwitchToThread thread \<longrightarrow> runnable' st) \<and>
-                 (\<forall>p. thread \<in> set (ksReadyQueues s p) \<longrightarrow> runnable' st) \<and>
-                 sch_act_wf (ksSchedulerAction s) s)
-     ({s'. (\<forall>cl fl. cthread_state_relation_lifted st (cl\<lparr>tsType_CL := ts_' s' && mask 4\<rparr>, fl))}
-    \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr thread}) []
-         (setThreadState st thread) (Call setThreadState_'proc)"
+   (\<lambda>s. tcb_at' thread s \<and> valid_objs' s \<and> valid_tcb_state' st s
+        \<and> (ksSchedulerAction s = SwitchToThread thread \<longrightarrow> runnable' st)
+        \<and> sch_act_wf (ksSchedulerAction s) s \<and> pspace_aligned' s \<and> pspace_distinct' s)
+   ({s'. (\<forall>cl fl. cthread_state_relation_lifted st (cl\<lparr>tsType_CL := ts_' s' && mask 4\<rparr>, fl))}
+    \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr thread}) hs
+   (setThreadState st thread) (Call setThreadState_'proc)"
    apply (cinit lift: tptr_' cong add: call_ignore_cong)
    apply (ctac (no_vcg) add: threadSet_tcbState_simple_corres)
     apply (ctac add: scheduleTCB_ccorres)
-  apply (wp threadSet_weak_sch_act_wf_runnable' threadSet_valid_queues_and_runnable'
-            threadSet_valid_objs')
-  by (clarsimp simp: weak_sch_act_wf_def valid_queues_def valid_tcb'_tcbState_update)
-
-lemma threadSet_valid_queues'_and_not_runnable': "\<lbrace>tcb_at' thread and valid_queues' and (\<lambda>s. (\<not> runnable' st))\<rbrace>
-                  threadSet (tcbState_update (\<lambda>_. st)) thread
-               \<lbrace>\<lambda>rv. tcb_at' thread and st_tcb_at' (not runnable') thread and valid_queues' \<rbrace>"
-
-  apply (wp threadSet_valid_queues' threadSet_tcbState_st_tcb_at')
-  apply (clarsimp simp: pred_neg_def valid_queues'_def inQ_def)+
-done
+  apply (wp threadSet_weak_sch_act_wf_runnable' threadSet_valid_objs')
+  apply (clarsimp simp: weak_sch_act_wf_def valid_tcb'_tcbState_update)
+  done
 
 lemma setThreadState_ccorres_valid_queues':
-   "ccorres dc xfdc
-   (\<lambda>s. tcb_at' thread s \<and> valid_queues' s \<and> \<not> runnable' st \<and> weak_sch_act_wf (ksSchedulerAction s) s \<and> Invariants_H.valid_queues s \<and> (\<forall>p. thread \<notin> set (ksReadyQueues s p)) \<and> sch_act_not thread s \<and> valid_objs' s \<and> valid_tcb_state' st s)
+  "ccorres dc xfdc
+     (\<lambda>s. tcb_at' thread s \<and> \<not> runnable' st \<and> weak_sch_act_wf (ksSchedulerAction s) s
+          \<and> sch_act_not thread s \<and> valid_objs' s \<and> valid_tcb_state' st s
+          \<and> pspace_aligned' s \<and> pspace_distinct' s)
      ({s'. (\<forall>cl fl. cthread_state_relation_lifted st (cl\<lparr>tsType_CL := ts_' s' && mask 4\<rparr>, fl))}
-    \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr thread}) []
-         (setThreadState st thread) (Call setThreadState_'proc)"
+      \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr thread}) []
+     (setThreadState st thread) (Call setThreadState_'proc)"
    apply (cinit lift: tptr_' cong add: call_ignore_cong)
    apply (ctac (no_vcg) add: threadSet_tcbState_simple_corres)
     apply (ctac add: scheduleTCB_ccorres_valid_queues')
-   apply (wp threadSet_valid_queues'_and_not_runnable' threadSet_weak_sch_act_wf_runnable' threadSet_valid_queues_and_runnable' threadSet_valid_objs')
-  by (clarsimp simp: valid_tcb'_def tcb_cte_cases_def)
+   apply (wp threadSet_weak_sch_act_wf_runnable' threadSet_valid_objs'
+             threadSet_tcbState_st_tcb_at')
+  by (clarsimp simp: valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)
 
 lemma simp_list_case_return:
   "(case x of [] \<Rightarrow> return e | y # ys \<Rightarrow> return f) = return (if x = [] then e else f)"
@@ -2469,14 +2217,13 @@ lemma cancelSignal_ccorres [corres]:
    apply (rule ccorres_rhs_assoc2)
    apply (ctac (no_vcg) add: cancelSignal_ccorres_helper)
      apply (ctac add: setThreadState_ccorres_valid_queues')
-    apply ((wp setNotification_ksQ hoare_vcg_all_lift set_ntfn_valid_objs' | simp add: valid_tcb_state'_def split del: if_split)+)[1]
+    apply ((wp hoare_vcg_all_lift set_ntfn_valid_objs' | simp add: valid_tcb_state'_def split del: if_split)+)[1]
    apply (simp add: "StrictC'_thread_state_defs")
   apply (rule conjI, clarsimp, rule conjI, clarsimp)
     apply (frule (1) ko_at_valid_ntfn'[OF _ invs_valid_objs'])
    subgoal by ((auto simp: obj_at'_def projectKOs st_tcb_at'_def invs'_def valid_state'_def
                      isTS_defs cte_wp_at_ctes_of
-                     cthread_state_relation_def sch_act_wf_weak valid_ntfn'_def
-             dest!: valid_queues_not_runnable'_not_ksQ[where t=thread] |
+                     cthread_state_relation_def sch_act_wf_weak valid_ntfn'_def |
            clarsimp simp: eq_commute)+)
    apply (clarsimp)
    apply (frule (1) ko_at_valid_ntfn'[OF _ invs_valid_objs'])
@@ -2484,9 +2231,8 @@ lemma cancelSignal_ccorres [corres]:
    by (auto simp: obj_at'_def projectKOs st_tcb_at'_def invs'_def valid_state'_def
                      isTS_defs cte_wp_at_ctes_of valid_ntfn'_def
                      cthread_state_relation_def sch_act_wf_weak isWaitingNtfn_def
-             dest!: valid_queues_not_runnable'_not_ksQ[where t=thread]
-             split: ntfn.splits option.splits
-         |  clarsimp simp: eq_commute
+            split: ntfn.splits option.splits
+         | clarsimp simp: eq_commute
          | drule_tac x=thread in bspec)+
 
 lemma cmap_relation_ep:
@@ -2788,23 +2534,20 @@ lemma cancelIPC_ccorres_helper:
                         cpspace_relation_def update_ep_map_tos typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-       \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            subgoal by (clarsimp simp: comp_def)
-        \<comment> \<open>ep relation\<close>
-           apply (rule cpspace_relation_ep_update_ep, assumption+)
-            subgoal by (simp add: cendpoint_relation_def Let_def EPState_Idle_def)
-           subgoal by simp
-           \<comment> \<open>ntfn relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-          apply simp
-          apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
-           subgoal by simp
-          apply (erule (1) map_to_ko_atI')
-         apply (simp add: heap_to_user_data_def Let_def)
- \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         subgoal by (clarsimp simp: comp_def)
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           subgoal by (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (rule cpspace_relation_ep_update_ep, assumption+)
+           subgoal by (simp add: cendpoint_relation_def Let_def EPState_Idle_def)
+          subgoal by simp
+         \<comment> \<open>ntfn relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+          subgoal by simp
+         apply (erule (1) map_to_ko_atI')
+        apply (simp add: heap_to_user_data_def Let_def)
         subgoal by (simp add: carch_state_relation_def carch_globals_def
                               typ_heap_simps')
        subgoal by (simp add: cmachine_state_relation_def)
@@ -2825,38 +2568,36 @@ lemma cancelIPC_ccorres_helper:
                        cpspace_relation_def update_ep_map_tos typ_heap_simps')
       apply (elim conjE)
       apply (intro conjI)
-      \<comment> \<open>tcb relation\<close>
-           apply (erule ctcb_relation_null_queue_ptrs)
-           subgoal by (clarsimp simp: comp_def)
-       \<comment> \<open>ep relation\<close>
-          apply (rule cpspace_relation_ep_update_ep, assumption+)
-           apply (simp add: cendpoint_relation_def Let_def isSendEP_def isRecvEP_def split: endpoint.splits split del: if_split)
+          \<comment> \<open>tcb relation\<close>
+          apply (erule ctcb_relation_null_ep_ptrs)
+          subgoal by (clarsimp simp: comp_def)
+         \<comment> \<open>ep relation\<close>
+         apply (rule cpspace_relation_ep_update_ep, assumption+)
+          apply (simp add: cendpoint_relation_def Let_def isSendEP_def isRecvEP_def
+                    split: endpoint.splits split del: if_split)
            \<comment> \<open>recv case\<close>
-            apply (clarsimp simp add: Ptr_ptr_val h_t_valid_clift_Some_iff
-              tcb_queue_relation'_next_mask tcb_queue_relation'_prev_mask cong: tcb_queue_relation'_cong)
-            subgoal by (intro impI conjI; simp)
-           \<comment> \<open>send case\<close>
-           apply (clarsimp simp add: Ptr_ptr_val h_t_valid_clift_Some_iff
-             tcb_queue_relation'_next_mask tcb_queue_relation'_prev_mask cong: tcb_queue_relation'_cong)
+           apply (clarsimp simp: Ptr_ptr_val h_t_valid_clift_Some_iff
+                                 tcb_queue_relation'_next_mask tcb_queue_relation'_prev_mask
+                           cong: tcb_queue_relation'_cong)
            subgoal by (intro impI conjI; simp)
-          subgoal by simp
-                \<comment> \<open>ntfn relation\<close>
-         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-         apply simp
-         apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
-         apply simp
-         apply (erule (1) map_to_ko_atI')
-         \<comment> \<open>queue relation\<close>
-        apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-        subgoal by (clarsimp simp: comp_def)
-       subgoal by (simp add: carch_state_relation_def carch_globals_def
-                             typ_heap_simps')
+          \<comment> \<open>send case\<close>
+          apply (clarsimp simp: Ptr_ptr_val h_t_valid_clift_Some_iff
+                         tcb_queue_relation'_next_mask tcb_queue_relation'_prev_mask cong: tcb_queue_relation'_cong)
+          subgoal by (intro impI conjI; simp)
+         subgoal by simp
+        \<comment> \<open>ntfn relation\<close>
+        apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+        apply simp
+        apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+        apply simp
+        apply (erule (1) map_to_ko_atI')
+       subgoal by (simp add: carch_state_relation_def carch_globals_def typ_heap_simps')
       subgoal by (simp add: cmachine_state_relation_def)
      subgoal by (simp add: h_t_valid_clift_Some_iff)
     subgoal by (simp add: objBits_simps')
    subgoal by (simp add: objBits_simps)
   apply assumption
-   done
+  done
 
 declare empty_fail_get[iff]
 
@@ -3063,37 +2804,35 @@ lemma cancelIPC_ccorres1:
      subgoal by (auto simp: obj_at'_def projectKOs pred_tcb_at'_def invs'_def valid_state'_def
                      isTS_defs cte_wp_at_ctes_of
                      cthread_state_relation_def sch_act_wf_weak valid_ep'_def
-             dest!: valid_queues_not_runnable'_not_ksQ[where t=thread] split: thread_state.splits)
+                     split: thread_state.splits)
     apply clarsimp
     apply (frule (2) ep_blocked_in_queueD_recv)
     apply (frule (1) ko_at_valid_ep'[OF _ invs_valid_objs'])
     subgoal by (auto simp: obj_at'_def projectKOs pred_tcb_at'_def invs'_def valid_state'_def
                          isTS_defs cte_wp_at_ctes_of isRecvEP_def
                          cthread_state_relation_def sch_act_wf_weak valid_ep'_def
-                 dest!: valid_queues_not_runnable'_not_ksQ[where t=thread] split: thread_state.splits endpoint.splits)
+                    split: thread_state.splits endpoint.splits)
    apply (rule conjI)
     apply (clarsimp simp: inQ_def)
-   apply (rule conjI)
-    apply clarsimp
    apply clarsimp
    apply (rule conjI)
     subgoal by (auto simp: obj_at'_def projectKOs pred_tcb_at'_def invs'_def valid_state'_def
                          isTS_defs cte_wp_at_ctes_of
                          cthread_state_relation_def sch_act_wf_weak valid_ep'_def
-                 dest!: valid_queues_not_runnable'_not_ksQ[where t=thread] split: thread_state.splits)
+                    split: thread_state.splits)
    apply clarsimp
    apply (rule conjI)
     subgoal by (auto simp: obj_at'_def projectKOs pred_tcb_at'_def invs'_def valid_state'_def
                          isTS_defs cte_wp_at_ctes_of
                          cthread_state_relation_def sch_act_wf_weak valid_ep'_def
-                 dest!: valid_queues_not_runnable'_not_ksQ[where t=thread] split: thread_state.splits)
+                    split: thread_state.splits)
    apply clarsimp
    apply (frule (2) ep_blocked_in_queueD_send)
    apply (frule (1) ko_at_valid_ep'[OF _ invs_valid_objs'])
    subgoal by (auto simp: obj_at'_def projectKOs pred_tcb_at'_def invs'_def valid_state'_def
                         isTS_defs cte_wp_at_ctes_of isSendEP_def
                         cthread_state_relation_def sch_act_wf_weak valid_ep'_def
-                dest!: valid_queues_not_runnable'_not_ksQ[where t=thread] split: thread_state.splits endpoint.splits)[1]
+                   split: thread_state.splits endpoint.splits)[1]
   apply (auto simp: isTS_defs cthread_state_relation_def typ_heap_simps weak_sch_act_wf_def)
   apply (case_tac ts,
            auto simp: isTS_defs cthread_state_relation_def typ_heap_simps)
diff --git a/proof/crefine/ARM/Ipc_C.thy b/proof/crefine/ARM/Ipc_C.thy
index 846ab97da4..886916933b 100644
--- a/proof/crefine/ARM/Ipc_C.thy
+++ b/proof/crefine/ARM/Ipc_C.thy
@@ -1207,18 +1207,14 @@ shows
   done
 
 lemma asUser_tcbFault_obj_at:
-  "\<lbrace>obj_at' (\<lambda>tcb. P (tcbFault tcb)) t\<rbrace> asUser t' m
-   \<lbrace>\<lambda>rv. obj_at' (\<lambda>tcb. P (tcbFault tcb)) t\<rbrace>"
+  "asUser t' m \<lbrace>obj_at' (\<lambda>tcb. P (tcbFault tcb)) t\<rbrace>"
   apply (simp add: asUser_def split_def)
   apply (wp threadGet_wp)
   apply (simp cong: if_cong)
   done
 
 lemma asUser_atcbContext_obj_at:
-  "t \<noteq> t' \<Longrightarrow>
-    \<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>
-      asUser t' m
-    \<lbrace>\<lambda>rv. obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
+  "t \<noteq> t' \<Longrightarrow> asUser t' m \<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
   apply (simp add: asUser_def split_def atcbContextGet_def atcbContextSet_def)
   apply (wp threadGet_wp)
   apply simp
@@ -3934,10 +3930,6 @@ lemma doReplyTransfer_ccorres [corres]:
           \<inter> \<lbrace>\<acute>grant = from_bool grant\<rbrace>)  hs
     (doReplyTransfer sender receiver slot grant)
     (Call doReplyTransfer_'proc)"
-proof -
-  have invs_valid_queues_strg: "\<And>s. invs' s \<longrightarrow> valid_queues s"
-    by clarsimp
-  show ?thesis
   apply (cinit lift: sender_' receiver_' slot_' grant_')
    apply (rule getThreadState_ccorres_foo)
    apply (rule ccorres_assert2)
@@ -3969,7 +3961,7 @@ proof -
         apply (ctac(no_vcg) add: cteDeleteOne_ccorres[where w="scast cap_reply_cap"])
          apply (ctac(no_vcg) add: setThreadState_ccorres)
           apply (ctac(no_vcg) add: possibleSwitchTo_ccorres)
-         apply (wpsimp wp: sts_running_valid_queues setThreadState_st_tcb)+
+         apply (wpsimp wp: sts_valid_objs' setThreadState_st_tcb)+
         apply (wp cteDeleteOne_sch_act_wf)
        apply vcg
       apply (rule conseqPre, vcg)
@@ -3978,8 +3970,7 @@ proof -
      apply wp
      apply (simp add: cap_get_tag_isCap)
      apply (strengthen invs_weak_sch_act_wf_strg
-                       cte_wp_at_imp_consequent'[where P="\<lambda>ct. Ex (ccap_relation (cteCap ct))" for ct]
-                       invs_valid_queues_strg)
+                       cte_wp_at_imp_consequent'[where P="\<lambda>ct. Ex (ccap_relation (cteCap ct))" for ct])
      apply (simp add: cap_reply_cap_def)
      apply (wp doIPCTransfer_reply_or_replyslot)
     apply (clarsimp simp: seL4_Fault_NullFault_def ccorres_cond_iffs
@@ -4014,19 +4005,20 @@ proof -
               apply (ctac (no_vcg))
                apply (simp only: K_bind_def)
                apply (ctac add: possibleSwitchTo_ccorres)
-              apply (wp sts_running_valid_queues setThreadState_st_tcb | simp)+
-             apply (ctac add: setThreadState_ccorres_valid_queues'_simple)
+              apply (wp sts_valid_objs' setThreadState_st_tcb | simp)+
+             apply (ctac add: setThreadState_ccorres_simple)
              apply wp
-            apply ((wp threadSet_valid_queues threadSet_sch_act threadSet_valid_queues' hoare_weak_lift_imp
+            apply ((wp threadSet_sch_act hoare_weak_lift_imp
                        threadSet_valid_objs' threadSet_weak_sch_act_wf
                          | simp add: valid_tcb_state'_def)+)[1]
            apply (clarsimp simp: guard_is_UNIV_def ThreadState_defs mask_def option_to_ctcb_ptr_def)
 
-          apply (rule_tac Q="\<lambda>rv. valid_queues and tcb_at' receiver and valid_queues' and
+          apply (rule_tac Q="\<lambda>rv. tcb_at' receiver and
                                 valid_objs' and sch_act_simple and (\<lambda>s. ksCurDomain s \<le> maxDomain) and
-                                (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)" in hoare_post_imp)
+                                (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and
+                                pspace_aligned' and pspace_distinct'" in hoare_post_imp)
            apply (clarsimp simp: inQ_def weak_sch_act_wf_def)
-          apply (wp threadSet_valid_queues threadSet_sch_act handleFaultReply_sch_act_wf)
+          apply (wp threadSet_sch_act handleFaultReply_sch_act_wf)
          apply (clarsimp simp: guard_is_UNIV_def)
         apply assumption
        apply clarsimp
@@ -4035,7 +4027,7 @@ proof -
        apply (erule(1) cmap_relation_ko_atE [OF cmap_relation_tcb])
        apply (clarsimp simp: ctcb_relation_def typ_heap_simps)
       apply wp
-      apply (strengthen vp_invs_strg' invs_valid_queues')
+      apply (strengthen vp_invs_strg')
       apply (wp cteDeleteOne_tcbFault cteDeleteOne_sch_act_wf)
      apply vcg
     apply (rule conseqPre, vcg)
@@ -4051,7 +4043,6 @@ proof -
                         cap_get_tag_isCap)
   apply fastforce
   done
-qed
 
 lemma ccorres_getCTE_cte_at:
   "ccorresG rf_sr \<Gamma> r xf P P' hs (getCTE p >>= f) c
@@ -4071,7 +4062,7 @@ lemma ccorres_getCTE_cte_at:
   done
 
 lemma setupCallerCap_ccorres [corres]:
-  "ccorres dc xfdc (valid_queues and valid_pspace' and (\<lambda>s. \<forall>d p. sender \<notin> set (ksReadyQueues s (d, p)))
+  "ccorres dc xfdc (valid_pspace'
                     and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and sch_act_not sender
                     and tcb_at' sender and tcb_at' receiver
                     and tcb_at' sender and tcb_at' receiver)
@@ -4202,23 +4193,20 @@ lemma sendIPC_dequeue_ccorres_helper:
                          typ_heap_simps')
         apply (elim conjE)
         apply (intro conjI)
-             \<comment> \<open>tcb relation\<close>
-             apply (erule ctcb_relation_null_queue_ptrs)
-             apply (clarsimp simp: comp_def)
-            \<comment> \<open>ep relation\<close>
-            apply (rule cpspace_relation_ep_update_ep, assumption+)
-             apply (simp add: cendpoint_relation_def Let_def EPState_Idle_def
-                              tcb_queue_relation'_def)
-            apply simp
-           \<comment> \<open>ntfn relation\<close>
-           apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+            \<comment> \<open>tcb relation\<close>
+            apply (erule ctcb_relation_null_ep_ptrs)
+            apply (clarsimp simp: comp_def)
+           \<comment> \<open>ep relation\<close>
+           apply (rule cpspace_relation_ep_update_ep, assumption+)
+            apply (simp add: cendpoint_relation_def Let_def EPState_Idle_def
+                             tcb_queue_relation'_def)
            apply simp
-           apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
-            apply simp
-           apply (erule (1) map_to_ko_atI')
-          \<comment> \<open>queue relation\<close>
-          apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-          apply (clarsimp simp: comp_def)
+          \<comment> \<open>ntfn relation\<close>
+          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+          apply simp
+          apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+           apply simp
+          apply (erule (1) map_to_ko_atI')
          apply (simp add: carch_state_relation_def typ_heap_simps')
         apply (simp add: cmachine_state_relation_def)
        apply (simp add: h_t_valid_clift_Some_iff)
@@ -4242,31 +4230,28 @@ lemma sendIPC_dequeue_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-             \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (rule cpspace_relation_ep_update_ep, assumption+)
-            apply (clarsimp simp: cendpoint_relation_def Let_def
-                                  isRecvEP_def isSendEP_def
-                                  tcb_queue_relation'_def valid_ep'_def
-                           split: endpoint.splits list.splits
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (rule cpspace_relation_ep_update_ep, assumption+)
+           apply (clarsimp simp: cendpoint_relation_def Let_def
+                                 isRecvEP_def isSendEP_def
+                                 tcb_queue_relation'_def valid_ep'_def
+                          split: endpoint.splits list.splits
+                      split del: if_split)
+           apply (subgoal_tac "tcb_at' (if x22 = [] then x21 else last x22) \<sigma>")
+            apply (clarsimp simp: is_aligned_neg_mask
+                           dest!: is_aligned_tcb_ptr_to_ctcb_ptr
                        split del: if_split)
-            apply (subgoal_tac "tcb_at' (if x22 = [] then x21 else last x22) \<sigma>")
-             apply (clarsimp simp: is_aligned_neg_mask
-                            dest!: is_aligned_tcb_ptr_to_ctcb_ptr
-                        split del: if_split)
-            apply (clarsimp split: if_split)
-           apply simp
-          \<comment> \<open>ntfn relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+           apply (clarsimp split: if_split)
           apply simp
-          apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
-           apply simp
-          apply (erule (1) map_to_ko_atI')
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         apply (clarsimp simp: comp_def)
+         \<comment> \<open>ntfn relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+          apply simp
+         apply (erule (1) map_to_ko_atI')
         apply (simp add: carch_state_relation_def typ_heap_simps')
        apply (simp add: cmachine_state_relation_def)
       apply (simp add: h_t_valid_clift_Some_iff)
@@ -4289,10 +4274,9 @@ lemma rf_sr_tcb_update_twice:
                 cmachine_state_relation_def)
 
 lemma sendIPC_block_ccorres_helper:
-  "ccorres dc xfdc (tcb_at' thread and valid_queues and valid_objs' and
+  "ccorres dc xfdc (tcb_at' thread and valid_objs' and pspace_aligned' and pspace_distinct' and
                     sch_act_not thread and ep_at' epptr and
-                    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s \<and>
-                         (\<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))) and
+                    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and
                     K (bos = ThreadState_BlockedOnSend
                       \<and> epptr' = epptr \<and> badge' = badge
                       \<and> cg = from_bool canGrant \<and> cgr = from_bool canGrantReply
@@ -4348,7 +4332,7 @@ lemma sendIPC_block_ccorres_helper:
        apply ceqv
       apply clarsimp
       apply ctac
-     apply (wp threadSet_weak_sch_act_wf_runnable' threadSet_valid_queues
+     apply (wp threadSet_weak_sch_act_wf_runnable'
                threadSet_valid_objs')
     apply (clarsimp simp: guard_is_UNIV_def)
    apply (clarsimp simp: sch_act_wf_weak valid_tcb'_def valid_tcb_state'_def
@@ -4452,6 +4436,19 @@ lemma tcb_queue_relation_qend_valid':
   apply (simp add: h_t_valid_clift_Some_iff)
   done
 
+lemma tcb_queue'_head_end_NULL:
+  assumes qr: "tcb_queue_relation' getNext getPrev mp queue qhead qend"
+  and   tat: "\<forall>t\<in>set queue. tcb_at' t s"
+  shows "(qend = NULL) = (qhead = NULL)"
+  using qr tat
+  apply -
+  apply (erule tcb_queue_relationE')
+  apply (simp add: tcb_queue_head_empty_iff split: if_splits)
+  apply (rule tcb_at_not_NULL)
+  apply (erule bspec)
+  apply simp
+  done
+
 lemma tcbEPAppend_spec:
   "\<forall>s queue. \<Gamma> \<turnstile> \<lbrace>s. \<exists>t. (t, s) \<in> rf_sr
                       \<and> (\<forall>tcb\<in>set queue. tcb_at' tcb t) \<and> distinct queue
@@ -4572,29 +4569,26 @@ lemma sendIPC_enqueue_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-            \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (rule cpspace_relation_ep_update_ep', assumption+)
-            apply (clarsimp simp: cendpoint_relation_def Let_def
-                                  mask_def [where n=2] EPState_Send_def)
-            apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask)
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (rule cpspace_relation_ep_update_ep', assumption+)
+           apply (clarsimp simp: cendpoint_relation_def Let_def
+                                 mask_def [where n=2] EPState_Send_def)
+           apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask)
+          apply (simp add: isSendEP_def isRecvEP_def)
+         \<comment> \<open>ntfn relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cnotification_relation_ep_queue, assumption+)
            apply (simp add: isSendEP_def isRecvEP_def)
-          \<comment> \<open>ntfn relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
           apply simp
-          apply (rule cnotification_relation_ep_queue, assumption+)
-            apply (simp add: isSendEP_def isRecvEP_def)
-           apply simp
-          apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
-          apply (erule(2) map_to_ko_at_updI')
-           apply (simp only:projectKOs injectKO_ep objBits_simps)
-           apply clarsimp
-          apply (clarsimp simp: obj_at'_def projectKOs)
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         apply (clarsimp simp: comp_def)
+         apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
+         apply (erule(2) map_to_ko_at_updI')
+          apply (simp only:projectKOs injectKO_ep objBits_simps)
+          apply clarsimp
+         apply (clarsimp simp: obj_at'_def projectKOs)
         apply (simp add: carch_state_relation_def typ_heap_simps')
        apply (simp add: cmachine_state_relation_def)
       apply (simp add: typ_heap_simps')
@@ -4611,31 +4605,28 @@ lemma sendIPC_enqueue_ccorres_helper:
                        typ_heap_simps')
       apply (elim conjE)
       apply (intro conjI)
-           \<comment> \<open>tcb relation\<close>
-           apply (erule ctcb_relation_null_queue_ptrs)
-           apply (clarsimp simp: comp_def)
-          \<comment> \<open>ep relation\<close>
-          apply (rule cpspace_relation_ep_update_ep', assumption+)
-           apply (clarsimp simp: cendpoint_relation_def Let_def
-                                 mask_def [where n=2] EPState_Send_def
-                          split: if_split)
-           apply (fastforce simp: tcb_queue_relation'_def is_aligned_neg_mask
-                                 valid_ep'_def
-                           dest: tcb_queue_relation_next_not_NULL)
+          \<comment> \<open>tcb relation\<close>
+          apply (erule ctcb_relation_null_ep_ptrs)
+          apply (clarsimp simp: comp_def)
+         \<comment> \<open>ep relation\<close>
+         apply (rule cpspace_relation_ep_update_ep', assumption+)
+          apply (clarsimp simp: cendpoint_relation_def Let_def
+                                mask_def [where n=2] EPState_Send_def
+                         split: if_split)
+          apply (fastforce simp: tcb_queue_relation'_def is_aligned_neg_mask
+                                valid_ep'_def
+                          dest: tcb_queue_relation_next_not_NULL)
+         apply (simp add: isSendEP_def isRecvEP_def)
+        \<comment> \<open>ntfn relation\<close>
+        apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+        apply simp
+        apply (rule cnotification_relation_ep_queue, assumption+)
           apply (simp add: isSendEP_def isRecvEP_def)
-         \<comment> \<open>ntfn relation\<close>
-         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
          apply simp
-         apply (rule cnotification_relation_ep_queue, assumption+)
-           apply (simp add: isSendEP_def isRecvEP_def)
-          apply simp
-         apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
-         apply (erule(2) map_to_ko_at_updI')
-          apply (clarsimp simp: objBitsKO_def)
-         apply (clarsimp simp: obj_at'_def projectKOs)
-        \<comment> \<open>queue relation\<close>
-        apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-        apply (clarsimp simp: comp_def)
+        apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
+        apply (erule(2) map_to_ko_at_updI')
+         apply (clarsimp simp: objBitsKO_def)
+        apply (clarsimp simp: obj_at'_def projectKOs)
        apply (simp add: carch_state_relation_def typ_heap_simps')
       apply (simp add: cmachine_state_relation_def)
      apply (simp add: h_t_valid_clift_Some_iff)
@@ -4655,8 +4646,7 @@ lemma ctcb_relation_blockingIPCCanGrantD:
 
 lemma sendIPC_ccorres [corres]:
   "ccorres dc xfdc (invs' and st_tcb_at' simple' thread
-                          and sch_act_not thread and ep_at' epptr and
-                          (\<lambda>s. \<forall>d p. thread \<notin> set (ksReadyQueues s (d, p))))
+                          and sch_act_not thread and ep_at' epptr)
      (UNIV \<inter> \<lbrace>\<acute>blocking = from_bool blocking\<rbrace>
            \<inter> \<lbrace>\<acute>do_call = from_bool do_call\<rbrace>
            \<inter> \<lbrace>\<acute>badge = badge\<rbrace>
@@ -4687,8 +4677,7 @@ lemma sendIPC_ccorres [corres]:
      apply ceqv
     apply (rule_tac A="invs' and st_tcb_at' simple' thread
                           and sch_act_not thread and ko_at' ep epptr
-                          and ep_at' epptr
-                          and (\<lambda>s. \<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))"
+                          and ep_at' epptr"
                  in ccorres_guard_imp2 [where A'=UNIV])
      apply wpc
        \<comment> \<open>RecvEP case\<close>
@@ -4736,12 +4725,11 @@ lemma sendIPC_ccorres [corres]:
               apply (ctac add: setThreadState_ccorres)
              apply (rule ccorres_return_Skip)
             apply (wpsimp wp: hoare_drop_imps hoare_vcg_all_lift possibleSwitchTo_sch_act_not
-                              possibleSwitchTo_sch_act_not sts_st_tcb'
-                              possibleSwitchTo_ksQ' sts_valid_queues sts_ksQ'
+                              possibleSwitchTo_sch_act_not sts_st_tcb' sts_valid_objs'
                           simp: valid_tcb_state'_def)+
           apply vcg
-         apply (wpsimp wp: doIPCTransfer_sch_act setEndpoint_ksQ hoare_vcg_all_lift
-                          set_ep_valid_objs' setEndpoint_valid_mdb'
+         apply (wpsimp wp: doIPCTransfer_sch_act hoare_vcg_all_lift
+                           set_ep_valid_objs' setEndpoint_valid_mdb'
                 | wp (once) hoare_drop_imp
                 | strengthen sch_act_wf_weak)+
        apply (fastforce simp: guard_is_UNIV_def ThreadState_defs Collect_const_mem
@@ -4817,7 +4805,7 @@ lemma sendIPC_ccorres [corres]:
                              st_tcb_at'_def valid_tcb_state'_def ko_wp_at'_def
                              isBlockedOnSend_def projectKO_opt_tcb
                       split: if_split_asm if_split)
-       apply (rule conjI, simp, rule impI, clarsimp simp: valid_pspace_valid_objs')
+       apply (rule conjI, simp, rule impI, clarsimp simp: valid_pspace'_def)
        apply (erule delta_sym_refs)
         apply (clarsimp split: if_split_asm
                         dest!: symreftype_inverse')+
@@ -4861,10 +4849,9 @@ lemma ctcb_relation_blockingIPCCanGrantReplyD:
   done
 
 lemma receiveIPC_block_ccorres_helper:
-  "ccorres dc xfdc (tcb_at' thread and valid_queues and valid_objs' and
+  "ccorres dc xfdc (tcb_at' thread and valid_objs' and pspace_aligned' and pspace_distinct' and
                     sch_act_not thread and ep_at' epptr and
-                    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s \<and>
-                     (\<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))) and
+                    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and
                     K (epptr = epptr && ~~ mask 4) and
                     K (isEndpointCap cap \<and> ccap_relation cap cap'))
                    UNIV hs
@@ -4902,7 +4889,7 @@ lemma receiveIPC_block_ccorres_helper:
        apply ceqv
       apply clarsimp
       apply ctac
-     apply (wp threadSet_valid_queues hoare_vcg_all_lift threadSet_valid_objs'
+     apply (wp hoare_vcg_all_lift threadSet_valid_objs'
                threadSet_weak_sch_act_wf_runnable')
     apply (clarsimp simp: guard_is_UNIV_def)
    apply (clarsimp simp: sch_act_wf_weak valid_tcb'_def valid_tcb_state'_def
@@ -4967,31 +4954,28 @@ lemma receiveIPC_enqueue_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-             \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (rule cpspace_relation_ep_update_ep', assumption+)
-            apply (clarsimp simp: cendpoint_relation_def Let_def
-                                  mask_def [where n=2] EPState_Recv_def
-                           split: if_split)
-            apply (fastforce simp: tcb_queue_relation'_def is_aligned_neg_mask
-                                  valid_ep'_def
-                            dest: tcb_queue_relation_next_not_NULL)
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (rule cpspace_relation_ep_update_ep', assumption+)
+           apply (clarsimp simp: cendpoint_relation_def Let_def
+                                 mask_def [where n=2] EPState_Recv_def
+                          split: if_split)
+           apply (fastforce simp: tcb_queue_relation'_def is_aligned_neg_mask
+                                 valid_ep'_def
+                           dest: tcb_queue_relation_next_not_NULL)
+          apply (simp add: isSendEP_def isRecvEP_def)
+         \<comment> \<open>ntfn relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cnotification_relation_ep_queue, assumption+)
            apply (simp add: isSendEP_def isRecvEP_def)
-          \<comment> \<open>ntfn relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
           apply simp
-          apply (rule cnotification_relation_ep_queue, assumption+)
-            apply (simp add: isSendEP_def isRecvEP_def)
-           apply simp
-          apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
-          apply (erule(2) map_to_ko_at_updI')
-           apply (clarsimp simp: objBitsKO_def)
-          apply (clarsimp simp: obj_at'_def projectKOs)
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         apply (clarsimp simp: comp_def)
+         apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
+         apply (erule(2) map_to_ko_at_updI')
+          apply (clarsimp simp: objBitsKO_def)
+         apply (clarsimp simp: obj_at'_def projectKOs)
         apply (simp add: carch_state_relation_def typ_heap_simps')
        apply (simp add: cmachine_state_relation_def)
       apply (simp add: h_t_valid_clift_Some_iff)
@@ -5008,28 +4992,25 @@ lemma receiveIPC_enqueue_ccorres_helper:
                        typ_heap_simps')
       apply (elim conjE)
       apply (intro conjI)
-           \<comment> \<open>tcb relation\<close>
-           apply (erule ctcb_relation_null_queue_ptrs)
-           apply (clarsimp simp: comp_def)
-          \<comment> \<open>ep relation\<close>
-          apply (rule cpspace_relation_ep_update_ep', assumption+)
-           apply (clarsimp simp: cendpoint_relation_def Let_def
-                                 mask_def [where n=2] EPState_Recv_def)
-           apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask)
+          \<comment> \<open>tcb relation\<close>
+          apply (erule ctcb_relation_null_ep_ptrs)
+          apply (clarsimp simp: comp_def)
+         \<comment> \<open>ep relation\<close>
+         apply (rule cpspace_relation_ep_update_ep', assumption+)
+          apply (clarsimp simp: cendpoint_relation_def Let_def
+                                mask_def [where n=2] EPState_Recv_def)
+          apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask)
+         apply (simp add: isSendEP_def isRecvEP_def)
+        \<comment> \<open>ntfn relation\<close>
+        apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+        apply simp
+        apply (rule cnotification_relation_ep_queue, assumption+)
           apply (simp add: isSendEP_def isRecvEP_def)
-         \<comment> \<open>ntfn relation\<close>
-         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
          apply simp
-         apply (rule cnotification_relation_ep_queue, assumption+)
-           apply (simp add: isSendEP_def isRecvEP_def)
-          apply simp
-         apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
-         apply (erule(2) map_to_ko_at_updI')
-          apply (clarsimp simp: objBitsKO_def)
-         apply (clarsimp simp: obj_at'_def projectKOs)
-        \<comment> \<open>queue relation\<close>
-        apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-        apply (clarsimp simp: comp_def)
+        apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
+        apply (erule(2) map_to_ko_at_updI')
+         apply (clarsimp simp: objBitsKO_def)
+        apply (clarsimp simp: obj_at'_def projectKOs)
        apply (simp add: carch_state_relation_def typ_heap_simps')
       apply (simp add: cmachine_state_relation_def)
      apply (simp add: typ_heap_simps')
@@ -5097,23 +5078,20 @@ lemma receiveIPC_dequeue_ccorres_helper:
                          typ_heap_simps')
         apply (elim conjE)
         apply (intro conjI)
-             \<comment> \<open>tcb relation\<close>
-             apply (erule ctcb_relation_null_queue_ptrs)
-             apply (clarsimp simp: comp_def)
-            \<comment> \<open>ep relation\<close>
-            apply (rule cpspace_relation_ep_update_ep, assumption+)
-             apply (simp add: cendpoint_relation_def Let_def EPState_Idle_def
-                              tcb_queue_relation'_def)
-            apply simp
-           \<comment> \<open>ntfn relation\<close>
-           apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-           apply simp
-           apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+            \<comment> \<open>tcb relation\<close>
+            apply (erule ctcb_relation_null_ep_ptrs)
+            apply (clarsimp simp: comp_def)
+           \<comment> \<open>ep relation\<close>
+           apply (rule cpspace_relation_ep_update_ep, assumption+)
+            apply (simp add: cendpoint_relation_def Let_def EPState_Idle_def
+                             tcb_queue_relation'_def)
            apply simp
+          \<comment> \<open>ntfn relation\<close>
+          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+          apply simp
+          apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+          apply simp
           apply (erule (1) map_to_ko_atI')
-          \<comment> \<open>queue relation\<close>
-          apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-          apply (clarsimp simp: comp_def)
          apply (simp add: carch_state_relation_def typ_heap_simps')
         apply (simp add: cmachine_state_relation_def)
        apply (simp add: typ_heap_simps')
@@ -5137,31 +5115,28 @@ lemma receiveIPC_dequeue_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-            \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (rule cpspace_relation_ep_update_ep, assumption+)
-            apply (clarsimp simp: cendpoint_relation_def Let_def
-                                  isRecvEP_def isSendEP_def
-                                  tcb_queue_relation'_def valid_ep'_def
-                           split: endpoint.splits list.splits
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (rule cpspace_relation_ep_update_ep, assumption+)
+           apply (clarsimp simp: cendpoint_relation_def Let_def
+                                 isRecvEP_def isSendEP_def
+                                 tcb_queue_relation'_def valid_ep'_def
+                          split: endpoint.splits list.splits
+                      split del: if_split)
+           apply (subgoal_tac "tcb_at' (if x22 = [] then x21 else last x22) \<sigma>")
+            apply (clarsimp simp: is_aligned_neg_mask
+                           dest!: is_aligned_tcb_ptr_to_ctcb_ptr
                        split del: if_split)
-            apply (subgoal_tac "tcb_at' (if x22 = [] then x21 else last x22) \<sigma>")
-             apply (clarsimp simp: is_aligned_neg_mask
-                            dest!: is_aligned_tcb_ptr_to_ctcb_ptr
-                        split del: if_split)
-            apply (clarsimp split: if_split)
-           apply simp
-          \<comment> \<open>ntfn relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+           apply (clarsimp split: if_split)
           apply simp
-          apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
-           apply simp
-          apply (erule (1) map_to_ko_atI')
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         apply (clarsimp simp: comp_def)
+         \<comment> \<open>ntfn relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+          apply simp
+         apply (erule (1) map_to_ko_atI')
         apply (simp add: carch_state_relation_def typ_heap_simps')
        apply (simp add: cmachine_state_relation_def)
       apply (simp add: typ_heap_simps')
@@ -5278,7 +5253,6 @@ lemma receiveIPC_ccorres [corres]:
   notes option.case_cong_weak [cong]
   shows
   "ccorres dc xfdc (invs' and st_tcb_at' simple' thread and sch_act_not thread
-                          and (\<lambda>s. \<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))
                           and valid_cap' cap and K (isEndpointCap cap))
      (UNIV \<inter> \<lbrace>\<acute>thread = tcb_ptr_to_ctcb_ptr thread\<rbrace>
            \<inter> \<lbrace>ccap_relation cap \<acute>cap\<rbrace>
@@ -5354,7 +5328,6 @@ lemma receiveIPC_ccorres [corres]:
           apply ceqv
          apply (rule_tac A="invs' and st_tcb_at' simple' thread
                                   and sch_act_not thread
-                              and (\<lambda>s. \<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))
                                   and ko_at' ep (capEPPtr cap)"
                      in ccorres_guard_imp2 [where A'=UNIV])
            apply wpc
@@ -5494,27 +5467,25 @@ lemma receiveIPC_ccorres [corres]:
                  apply ccorres_rewrite
                  apply ctac
                    apply (ctac add: possibleSwitchTo_ccorres)
-                  apply (wpsimp wp: sts_st_tcb' sts_valid_queues)
+                  apply (wpsimp wp: sts_st_tcb' sts_valid_objs')
                  apply (vcg exspec=setThreadState_modifies)
                 apply (fastforce simp: guard_is_UNIV_def ThreadState_defs mask_def
                                        cap_get_tag_isCap ccap_relation_ep_helpers)
                apply (clarsimp simp: valid_tcb_state'_def)
-               apply (rule_tac Q="\<lambda>_. valid_pspace' and valid_queues
+               apply (rule_tac Q="\<lambda>_. valid_pspace'
                                        and st_tcb_at' ((=) sendState) sender and tcb_at' thread
                                        and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)
-                                       and (\<lambda>s. (\<forall>a b. sender \<notin> set (ksReadyQueues s (a, b))))
                                        and sch_act_not sender and K (thread \<noteq> sender)
                                        and (\<lambda>s. ksCurDomain s \<le> maxDomain)" in hoare_post_imp)
-                apply (clarsimp simp: valid_pspace_valid_objs' pred_tcb_at'_def sch_act_wf_weak
-                                      obj_at'_def)
+                apply (fastforce simp: valid_pspace_valid_objs' pred_tcb_at'_def sch_act_wf_weak
+                                       obj_at'_def)
                apply (wpsimp simp: guard_is_UNIV_def option_to_ptr_def option_to_0_def conj_ac)+
-           apply (rule_tac Q="\<lambda>rv. valid_queues and valid_pspace'
+           apply (rule_tac Q="\<lambda>rv. valid_pspace'
                                and cur_tcb' and tcb_at' sender and tcb_at' thread
                                and sch_act_not sender and K (thread \<noteq> sender)
                                and ep_at' (capEPPtr cap)
                                and (\<lambda>s. ksCurDomain s \<le> maxDomain)
-                               and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s \<and>
-                                        (\<forall>d p. sender \<notin> set (ksReadyQueues s (d, p))))"
+                               and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)"
                             in hoare_post_imp)
              subgoal by (auto, auto simp: st_tcb_at'_def obj_at'_def)
         apply (wp hoare_vcg_all_lift set_ep_valid_objs')
@@ -5549,13 +5520,11 @@ lemma receiveIPC_ccorres [corres]:
                                   split: if_split_asm bool.splits) (*very long *)
             apply (clarsimp simp: obj_at'_def state_refs_of'_def projectKOs)
            apply (frule(1) sym_refs_ko_atD' [OF _ invs_sym'])
-           apply (frule invs_queues)
            apply clarsimp
            apply (rename_tac list x xa)
            apply (rule_tac P="x\<in>set list" in case_split)
             apply (clarsimp simp:st_tcb_at_refs_of_rev')
             apply (erule_tac x=x and P="\<lambda>x. st_tcb_at' P x s" for P in ballE)
-             apply (drule_tac t=x in valid_queues_not_runnable'_not_ksQ)
               apply (clarsimp simp: st_tcb_at'_def obj_at'_def)
              apply (subgoal_tac "sch_act_not x s")
               prefer 2
@@ -5634,23 +5603,20 @@ lemma sendSignal_dequeue_ccorres_helper:
                          typ_heap_simps')
         apply (elim conjE)
         apply (intro conjI)
-             \<comment> \<open>tcb relation\<close>
-             apply (erule ctcb_relation_null_queue_ptrs)
-             apply (clarsimp simp: comp_def)
-            \<comment> \<open>ep relation\<close>
-            apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-            apply simp
-            apply (rule cendpoint_relation_ntfn_queue [OF invs_sym'], assumption+)
-             apply simp+
-            apply (erule (1) map_to_ko_atI')
-           \<comment> \<open>ntfn relation\<close>
-           apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
-            apply (simp add: cnotification_relation_def Let_def NtfnState_Idle_def
-                             tcb_queue_relation'_def)
+            \<comment> \<open>tcb relation\<close>
+            apply (erule ctcb_relation_null_ep_ptrs)
+            apply (clarsimp simp: comp_def)
+           \<comment> \<open>ep relation\<close>
+           apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
            apply simp
-          \<comment> \<open>queue relation\<close>
-          apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-          apply (clarsimp simp: comp_def)
+           apply (rule cendpoint_relation_ntfn_queue [OF invs_sym'], assumption+)
+            apply simp+
+           apply (erule (1) map_to_ko_atI')
+          \<comment> \<open>ntfn relation\<close>
+          apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
+           apply (simp add: cnotification_relation_def Let_def NtfnState_Idle_def
+                            tcb_queue_relation'_def)
+          apply simp
          apply (simp add: carch_state_relation_def typ_heap_simps')
         apply (simp add: cmachine_state_relation_def)
        apply (simp add: h_t_valid_clift_Some_iff)
@@ -5676,31 +5642,28 @@ lemma sendSignal_dequeue_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-            \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-           apply simp
-           apply (rule cendpoint_relation_ntfn_queue [OF invs_sym'], assumption+)
-            apply simp+
-           apply (erule (1) map_to_ko_atI')
-          \<comment> \<open>ntfn relation\<close>
-          apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
-           apply (clarsimp simp: cnotification_relation_def Let_def
-                                 isWaitingNtfn_def
-                                 tcb_queue_relation'_def valid_ntfn'_def
-                          split: Structures_H.notification.splits list.splits
-                      split del: if_split)
-           apply (subgoal_tac "tcb_at' (if x22 = [] then x21 else last x22) \<sigma>")
-            apply (clarsimp simp: is_aligned_neg_mask
-                           dest!: is_aligned_tcb_ptr_to_ctcb_ptr
-                       split del: if_split)
-           apply (clarsimp split: if_split)
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
           apply simp
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         apply (clarsimp simp: comp_def)
+          apply (rule cendpoint_relation_ntfn_queue [OF invs_sym'], assumption+)
+           apply simp+
+          apply (erule (1) map_to_ko_atI')
+         \<comment> \<open>ntfn relation\<close>
+         apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
+          apply (clarsimp simp: cnotification_relation_def Let_def
+                                isWaitingNtfn_def
+                                tcb_queue_relation'_def valid_ntfn'_def
+                         split: Structures_H.notification.splits list.splits
+                     split del: if_split)
+          apply (subgoal_tac "tcb_at' (if x22 = [] then x21 else last x22) \<sigma>")
+           apply (clarsimp simp: is_aligned_neg_mask
+                          dest!: is_aligned_tcb_ptr_to_ctcb_ptr
+                      split del: if_split)
+          apply (clarsimp split: if_split)
+         apply simp
         apply (simp add: carch_state_relation_def typ_heap_simps')
        apply (simp add: cmachine_state_relation_def)
       apply (simp add: h_t_valid_clift_Some_iff)
@@ -5802,7 +5765,7 @@ lemma sendSignal_ccorres [corres]:
          apply (ctac(no_vcg) add: setThreadState_ccorres)
           apply (ctac(no_vcg) add: setRegister_ccorres)
            apply (ctac add: possibleSwitchTo_ccorres)
-          apply (wp sts_running_valid_queues sts_st_tcb_at'_cases
+          apply (wp sts_valid_objs' sts_st_tcb_at'_cases
                  | simp add: option_to_ctcb_ptr_def split del: if_split)+
         apply (rule_tac Q="\<lambda>_. tcb_at' (the (ntfnBoundTCB ntfn)) and invs'"
                  in hoare_post_imp)
@@ -5868,10 +5831,8 @@ lemma sendSignal_ccorres [corres]:
        apply (ctac (no_vcg))
         apply (ctac add: possibleSwitchTo_ccorres)
        apply (simp)
-       apply (wp weak_sch_act_wf_lift_linear
-         setThreadState_oa_queued
-         sts_valid_queues tcb_in_cur_domain'_lift)[1]
-      apply (wp sts_valid_queues sts_runnable)
+       apply (wp weak_sch_act_wf_lift_linear tcb_in_cur_domain'_lift)[1]
+      apply (wp sts_valid_objs' sts_runnable)
      apply (wp setThreadState_st_tcb set_ntfn_valid_objs' | clarsimp)+
     apply (clarsimp simp: guard_is_UNIV_def ThreadState_defs mask_def
                           badgeRegister_def Kernel_C.badgeRegister_def
@@ -5896,10 +5857,9 @@ lemma sendSignal_ccorres [corres]:
   done
 
 lemma receiveSignal_block_ccorres_helper:
-  "ccorres dc xfdc (tcb_at' thread and valid_queues and sch_act_not thread and
-                    valid_objs' and ntfn_at' ntfnptr and
-                    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s \<and>
-                        (\<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))) and
+  "ccorres dc xfdc (tcb_at' thread and sch_act_not thread and
+                    valid_objs' and ntfn_at' ntfnptr and pspace_aligned' and pspace_distinct' and
+                    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and
                     K (ntfnptr = ntfnptr && ~~ mask 4))
                    UNIV hs
            (setThreadState (Structures_H.thread_state.BlockedOnNotification
@@ -5932,7 +5892,7 @@ lemma receiveSignal_block_ccorres_helper:
        apply ceqv
       apply clarsimp
       apply ctac
-     apply (wp threadSet_valid_queues hoare_vcg_all_lift threadSet_valid_objs'
+     apply (wp hoare_vcg_all_lift threadSet_valid_objs'
                threadSet_weak_sch_act_wf_runnable')
     apply (clarsimp simp: guard_is_UNIV_def)
    apply (auto simp: weak_sch_act_wf_def valid_tcb'_def tcb_cte_cases_def
@@ -6053,31 +6013,28 @@ lemma receiveSignal_enqueue_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-            \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+          apply simp
+          apply (rule cendpoint_relation_ntfn_queue, assumption+)
+            apply (simp add: isWaitingNtfn_def)
            apply simp
-           apply (rule cendpoint_relation_ntfn_queue, assumption+)
-             apply (simp add: isWaitingNtfn_def)
-            apply simp
-           apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
-           apply (erule(2) map_to_ko_at_updI')
-            apply (clarsimp simp: objBitsKO_def)
-           apply (clarsimp simp: obj_at'_def projectKOs)
-          \<comment> \<open>ntfn relation\<close>
-          apply (rule cpspace_relation_ntfn_update_ntfn', assumption+)
-            apply (case_tac "ntfn", simp_all)[1]
-           apply (clarsimp simp: cnotification_relation_def Let_def
-                                 mask_def [where n=2] NtfnState_Waiting_def)
-           subgoal by (fastforce simp: tcb_queue_relation'_def is_aligned_neg_mask_weaken
-                                 valid_ntfn'_def
-                           dest: tcb_queue_relation_next_not_NULL)
-          apply (simp add: isWaitingNtfn_def)
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         subgoal by (clarsimp simp: comp_def)
+          apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
+          apply (erule(2) map_to_ko_at_updI')
+           apply (clarsimp simp: objBitsKO_def)
+          apply (clarsimp simp: obj_at'_def projectKOs)
+         \<comment> \<open>ntfn relation\<close>
+         apply (rule cpspace_relation_ntfn_update_ntfn', assumption+)
+           apply (case_tac "ntfn", simp_all)[1]
+          apply (clarsimp simp: cnotification_relation_def Let_def
+                                mask_def [where n=2] NtfnState_Waiting_def)
+          subgoal by (fastforce simp: tcb_queue_relation'_def is_aligned_neg_mask_weaken
+                                valid_ntfn'_def
+                          dest: tcb_queue_relation_next_not_NULL)
+         apply (simp add: isWaitingNtfn_def)
         apply (simp add: carch_state_relation_def typ_heap_simps')
        apply (simp add: cmachine_state_relation_def)
       apply (simp add: h_t_valid_clift_Some_iff)
@@ -6094,30 +6051,27 @@ lemma receiveSignal_enqueue_ccorres_helper:
                        typ_heap_simps')
       apply (elim conjE)
       apply (intro conjI)
-           \<comment> \<open>tcb relation\<close>
-           apply (erule ctcb_relation_null_queue_ptrs)
-           apply (clarsimp simp: comp_def)
-          \<comment> \<open>ep relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+          \<comment> \<open>tcb relation\<close>
+          apply (erule ctcb_relation_null_ep_ptrs)
+          apply (clarsimp simp: comp_def)
+         \<comment> \<open>ep relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cendpoint_relation_ntfn_queue, assumption+)
+           apply (simp add: isWaitingNtfn_def)
           apply simp
-          apply (rule cendpoint_relation_ntfn_queue, assumption+)
-            apply (simp add: isWaitingNtfn_def)
-           apply simp
-          apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
-          apply (erule(2) map_to_ko_at_updI')
-           apply (clarsimp simp: objBitsKO_def)
-          apply (clarsimp simp: obj_at'_def projectKOs)
-         \<comment> \<open>ntfn relation\<close>
-         apply (rule cpspace_relation_ntfn_update_ntfn', assumption+)
-           apply (case_tac "ntfn", simp_all)[1]
-          apply (clarsimp simp: cnotification_relation_def Let_def
-                                mask_def [where n=2] NtfnState_Waiting_def
-                         split: if_split)
-          apply (fastforce simp: tcb_queue_relation'_def is_aligned_neg_mask_weaken)
-         apply (simp add: isWaitingNtfn_def)
-        \<comment> \<open>queue relation\<close>
-        apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-        apply (clarsimp simp: comp_def)
+         apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
+         apply (erule(2) map_to_ko_at_updI')
+          apply (clarsimp simp: objBitsKO_def)
+         apply (clarsimp simp: obj_at'_def projectKOs)
+        \<comment> \<open>ntfn relation\<close>
+        apply (rule cpspace_relation_ntfn_update_ntfn', assumption+)
+          apply (case_tac "ntfn", simp_all)[1]
+         apply (clarsimp simp: cnotification_relation_def Let_def
+                               mask_def [where n=2] NtfnState_Waiting_def
+                        split: if_split)
+         apply (fastforce simp: tcb_queue_relation'_def is_aligned_neg_mask_weaken)
+        apply (simp add: isWaitingNtfn_def)
        apply (simp add: carch_state_relation_def typ_heap_simps')
       apply (simp add: cmachine_state_relation_def)
      apply (simp add: h_t_valid_clift_Some_iff)
@@ -6129,7 +6083,6 @@ lemma receiveSignal_enqueue_ccorres_helper:
 lemma receiveSignal_ccorres [corres]:
   "ccorres dc xfdc (invs' and valid_cap' cap and st_tcb_at' simple' thread
                     and sch_act_not thread
-                    and (\<lambda>s. \<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))
                     and K (isNotificationCap cap))
      (UNIV \<inter> \<lbrace>\<acute>thread = tcb_ptr_to_ctcb_ptr thread\<rbrace>
            \<inter> \<lbrace>ccap_relation cap \<acute>cap\<rbrace>
diff --git a/proof/crefine/ARM/IsolatedThreadAction.thy b/proof/crefine/ARM/IsolatedThreadAction.thy
index a4326bc4da..41ca7f5f0b 100644
--- a/proof/crefine/ARM/IsolatedThreadAction.thy
+++ b/proof/crefine/ARM/IsolatedThreadAction.thy
@@ -859,9 +859,11 @@ lemma oblivious_switchToThread_schact:
                    threadSet_def tcbSchedEnqueue_def unless_when asUser_def
                    getQueue_def setQueue_def storeWordUser_def setRegister_def
                    pointerInUserData_def isRunnable_def isStopped_def
-                   getThreadState_def tcbSchedDequeue_def bitmap_fun_defs)
+                   getThreadState_def tcbSchedDequeue_def tcbQueueRemove_def bitmap_fun_defs
+                   ksReadyQueues_asrt_def)
   by (safe intro!: oblivious_bind
-              | simp_all add: oblivious_setVMRoot_schact)+
+              | simp_all add: ready_qs_runnable_def idleThreadNotQueued_def
+                              oblivious_setVMRoot_schact)+
 
 (* FIXME move *)
 lemma empty_fail_getCurThread[intro!, wp, simp]:
@@ -901,9 +903,8 @@ lemma tcbSchedEnqueue_tcbPriority[wp]:
   done
 
 crunch obj_at_prio[wp]: cteDeleteOne "obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t"
-  (wp: crunch_wps setEndpoint_obj_at_tcb'
-       setThreadState_obj_at_unchanged setNotification_tcb setBoundNotification_obj_at_unchanged
-        simp: crunch_simps unless_def)
+  (wp: crunch_wps setEndpoint_obj_at'_tcb setNotification_tcb
+   simp: crunch_simps unless_def setBoundNotification_def)
 
 context
 notes if_cong[cong]
@@ -1027,8 +1028,6 @@ lemma setCTE_assert_modify:
        apply (rule word_and_le2)
       apply (simp add: objBits_simps mask_def field_simps)
      apply (simp add: simpler_modify_def cong: option.case_cong if_cong)
-     apply (rule kernel_state.fold_congs[OF refl refl])
-     apply (clarsimp simp: projectKO_opt_tcb cong: if_cong)
     apply (clarsimp simp: lookupAround2_char1 word_and_le2)
     apply (rule ccontr, clarsimp)
     apply (erule(2) ps_clearD)
@@ -1167,11 +1166,14 @@ lemma thread_actions_isolatableD:
 lemma tcbSchedDequeue_rewrite:
   "monadic_rewrite True True (obj_at' (Not \<circ> tcbQueued) t) (tcbSchedDequeue t) (return ())"
   apply (simp add: tcbSchedDequeue_def)
-   apply (wp_pre, monadic_rewrite_symb_exec_l_known False, simp)
-    apply (rule monadic_rewrite_refl)
-   apply (wpsimp wp: threadGet_const)+
+  apply wp_pre
+  apply monadic_rewrite_symb_exec_l
+    apply (monadic_rewrite_symb_exec_l_known False, simp)
+     apply (rule monadic_rewrite_refl)
+    apply (wpsimp wp: threadGet_const)+
   done
 
+(* FIXME: improve automation here *)
 lemma switchToThread_rewrite:
   "monadic_rewrite True True
        (ct_in_state' (Not \<circ> runnable') and cur_tcb' and obj_at' (Not \<circ> tcbQueued) t)
@@ -1179,7 +1181,9 @@ lemma switchToThread_rewrite:
        (do Arch.switchToThread t; setCurThread t od)"
   apply (simp add: switchToThread_def Thread_H.switchToThread_def)
   apply (monadic_rewrite_l tcbSchedDequeue_rewrite, simp)
-   apply (rule monadic_rewrite_refl)
+   (* strip LHS of getters and asserts until LHS and RHS are the same *)
+   apply (repeat_unless \<open>rule monadic_rewrite_refl\<close> monadic_rewrite_symb_exec_l)
+      apply wpsimp+
   apply (clarsimp simp: comp_def)
   done
 
@@ -1223,9 +1227,33 @@ lemma threadGet_isolatable:
                 split: tcb_state_regs.split)+
   done
 
+lemma tcbQueued_put_tcb_state_regs_tcb:
+  "tcbQueued (put_tcb_state_regs_tcb tsr tcb) = tcbQueued tcb"
+  apply (clarsimp simp: put_tcb_state_regs_tcb_def)
+  by (cases tsr; clarsimp)
+
+lemma idleThreadNotQueued_isolatable:
+  "thread_actions_isolatable idx (stateAssert idleThreadNotQueued [])"
+  apply (simp add: stateAssert_def2 stateAssert_def)
+  apply (intro thread_actions_isolatable_bind[OF _ _ hoare_pre(1)]
+               gets_isolatable
+               thread_actions_isolatable_if
+               thread_actions_isolatable_returns
+               thread_actions_isolatable_fail)
+    unfolding idleThreadNotQueued_def
+    apply (clarsimp simp: obj_at_partial_overwrite_If)
+    apply (clarsimp simp: obj_at'_def tcbQueued_put_tcb_state_regs_tcb)
+   apply wpsimp+
+  done
+
 lemma setCurThread_isolatable:
   "thread_actions_isolatable idx (setCurThread t)"
-  by (simp add: setCurThread_def modify_isolatable)
+  unfolding setCurThread_def
+  apply (rule thread_actions_isolatable_bind)
+    apply (rule idleThreadNotQueued_isolatable)
+   apply (fastforce intro: modify_isolatable)
+  apply wpsimp
+  done
 
 lemma isolate_thread_actions_tcbs_at:
   assumes f: "\<And>x. \<lbrace>tcb_at' (idx x)\<rbrace> f \<lbrace>\<lambda>rv. tcb_at' (idx x)\<rbrace>" shows
diff --git a/proof/crefine/ARM/Recycle_C.thy b/proof/crefine/ARM/Recycle_C.thy
index 1eed49e966..bd9f5452c6 100644
--- a/proof/crefine/ARM/Recycle_C.thy
+++ b/proof/crefine/ARM/Recycle_C.thy
@@ -550,16 +550,6 @@ lemma cnotification_relation_q_cong:
   apply (auto intro: iffD1[OF tcb_queue_relation'_cong[OF refl refl refl]])
   done
 
-lemma tcbSchedEnqueue_ep_at:
-  "\<lbrace>obj_at' (P :: endpoint \<Rightarrow> bool) ep\<rbrace>
-      tcbSchedEnqueue t
-   \<lbrace>\<lambda>rv. obj_at' P ep\<rbrace>"
-  including no_pre
-  apply (simp add: tcbSchedEnqueue_def unless_def null_def)
-  apply (wp threadGet_wp, clarsimp, wp+)
-  apply (clarsimp split: if_split, wp)
-  done
-
 lemma ccorres_duplicate_guard:
   "ccorres r xf (P and P) Q hs f f' \<Longrightarrow> ccorres r xf P Q hs f f'"
   by (erule ccorres_guard_imp, auto)
@@ -579,10 +569,11 @@ lemma cancelBadgedSends_ccorres:
               (UNIV \<inter> {s. epptr_' s = Ptr ptr} \<inter> {s. badge_' s = bdg}) []
        (cancelBadgedSends ptr bdg) (Call cancelBadgedSends_'proc)"
   apply (cinit lift: epptr_' badge_' simp: whileAnno_def)
+   apply (rule ccorres_stateAssert)
    apply (simp add: list_case_return
               cong: list.case_cong Structures_H.endpoint.case_cong call_ignore_cong
                del: Collect_const)
-   apply (rule ccorres_pre_getEndpoint)
+   apply (rule ccorres_pre_getEndpoint, rename_tac ep)
    apply (rule_tac R="ko_at' ep ptr" and xf'="ret__unsigned_'"
                and val="case ep of RecvEP q \<Rightarrow> scast EPState_Recv | IdleEP \<Rightarrow> scast EPState_Idle
                                 | SendEP q \<Rightarrow> scast EPState_Send"
@@ -634,8 +625,9 @@ lemma cancelBadgedSends_ccorres:
                    st_tcb_at' (\<lambda>st. isBlockedOnSend st \<and> blockingObject st = ptr) x s)
                               \<and> distinct (xs @ list) \<and> ko_at' IdleEP ptr s
                               \<and> (\<forall>p. \<forall>x \<in> set (xs @ list). \<forall>rf. (x, rf) \<notin> {r \<in> state_refs_of' s p. snd r \<noteq> NTFNBound})
-                              \<and> valid_queues s \<and> pspace_aligned' s \<and> pspace_distinct' s
-                              \<and> sch_act_wf (ksSchedulerAction s) s \<and> valid_objs' s"
+                              \<and> pspace_aligned' s \<and> pspace_distinct' s
+                              \<and> sch_act_wf (ksSchedulerAction s) s \<and> valid_objs' s
+                              \<and> ksReadyQueues_head_end s \<and> ksReadyQueues_head_end_tcb_at' s"
                      and P'="\<lambda>xs. {s. ep_queue_relation' (cslift s) (xs @ list)
                                          (head_C (queue_' s)) (end_C (queue_' s))}
                                 \<inter> {s. thread_' s = (case list of [] \<Rightarrow> tcb_Ptr 0
@@ -731,8 +723,9 @@ lemma cancelBadgedSends_ccorres:
                    apply (rule_tac rrel=dc and xf=xfdc
                                and P="\<lambda>s. (\<forall>t \<in> set (x @ a # lista). tcb_at' t s)
                                           \<and> (\<forall>p. \<forall>t \<in> set (x @ a # lista). \<forall>rf. (t, rf) \<notin> {r \<in> state_refs_of' s p. snd r \<noteq> NTFNBound})
-                                          \<and> valid_queues s \<and> distinct (x @ a # lista)
-                                          \<and> pspace_aligned' s \<and> pspace_distinct' s"
+                                          \<and> distinct (x @ a # lista)
+                                          \<and> pspace_aligned' s \<and> pspace_distinct' s
+                                          \<and> ksReadyQueues_head_end s \<and> ksReadyQueues_head_end_tcb_at' s"
                               and P'="{s. ep_queue_relation' (cslift s) (x @ a # lista)
                                            (head_C (queue_' s)) (end_C (queue_' s))}"
                                in ccorres_from_vcg)
@@ -748,8 +741,7 @@ lemma cancelBadgedSends_ccorres:
                    apply (clarsimp simp: return_def rf_sr_def cstate_relation_def Let_def)
                    apply (rule conjI)
                     apply (clarsimp simp: cpspace_relation_def)
-                    apply (rule conjI, erule ctcb_relation_null_queue_ptrs)
-                     apply (rule null_ep_queue)
+                    apply (rule conjI, erule ctcb_relation_null_ep_ptrs)
                      subgoal by (simp add: o_def)
                     apply (rule conjI)
                      apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
@@ -771,9 +763,6 @@ lemma cancelBadgedSends_ccorres:
                     apply (clarsimp simp: image_iff)
                     apply (drule_tac x=p in spec)
                     subgoal by fastforce
-                   apply (rule conjI)
-                    apply (erule cready_queues_relation_not_queue_ptrs;
-                           fastforce dest: null_ep_schedD[unfolded o_def] simp: o_def)
                    apply (simp add: carch_state_relation_def
                                     cmachine_state_relation_def
                                     h_t_valid_clift_Some_iff)
@@ -784,12 +773,11 @@ lemma cancelBadgedSends_ccorres:
                  apply wp
                 apply simp
                 apply vcg
-               apply (wp hoare_vcg_const_Ball_lift tcbSchedEnqueue_ep_at
-                         sch_act_wf_lift)
+               apply (wp hoare_vcg_const_Ball_lift sch_act_wf_lift)
               apply simp
               apply (vcg exspec=tcbSchedEnqueue_cslift_spec)
              apply (wp hoare_vcg_const_Ball_lift sts_st_tcb_at'_cases
-                       sts_sch_act sts_valid_queues setThreadState_oa_queued)
+                       sts_sch_act sts_valid_objs')
             apply (vcg exspec=setThreadState_cslift_spec)
            apply (simp add: ccorres_cond_iffs)
            apply (rule ccorres_symb_exec_r2)
@@ -813,14 +801,11 @@ lemma cancelBadgedSends_ccorres:
            apply (clarsimp simp: cscheduler_action_relation_def st_tcb_at'_def
                           split: scheduler_action.split_asm)
            apply (rename_tac word)
-           apply (frule_tac x=word in tcbSchedEnqueue_cslift_precond_discharge)
-              apply simp
-             subgoal by clarsimp
-            subgoal by clarsimp
+           apply (frule_tac x=word in tcbSchedEnqueue_cslift_precond_discharge; simp?)
            subgoal by clarsimp
           apply clarsimp
           apply (rule conjI)
-           apply (frule(3) tcbSchedEnqueue_cslift_precond_discharge)
+           apply (frule(3) tcbSchedEnqueue_cslift_precond_discharge; simp?)
            subgoal by clarsimp
           apply clarsimp
           apply (rule context_conjI)
@@ -860,8 +845,19 @@ lemma cancelBadgedSends_ccorres:
    apply (clarsimp split: if_split)
    apply (drule sym_refsD, clarsimp)
    apply (drule(1) bspec)+
-   by (auto simp: obj_at'_def projectKOs state_refs_of'_def pred_tcb_at'_def tcb_bound_refs'_def
-              dest!: symreftype_inverse')
+   apply (frule ksReadyQueues_asrt_ksReadyQueues_head_end)
+   apply (frule invs_pspace_aligned')
+   apply (frule invs_pspace_distinct')
+   apply (frule (2) ksReadyQueues_asrt_ksReadyQueues_head_end_tcb_at')
+   apply (fastforce simp: obj_at'_def projectKOs state_refs_of'_def pred_tcb_at'_def
+                          tcb_bound_refs'_def
+                   dest!: symreftype_inverse')
+  apply (frule ksReadyQueues_asrt_ksReadyQueues_head_end)
+  apply (frule invs_pspace_aligned')
+  apply (frule invs_pspace_distinct')
+  apply (frule (2) ksReadyQueues_asrt_ksReadyQueues_head_end_tcb_at')
+  apply fastforce
+  done
 
 declare Kernel_C.tcb_C_size [simp del]
 
diff --git a/proof/crefine/ARM/Refine_C.thy b/proof/crefine/ARM/Refine_C.thy
index f7cfacf590..5cb531bcc8 100644
--- a/proof/crefine/ARM/Refine_C.thy
+++ b/proof/crefine/ARM/Refine_C.thy
@@ -72,7 +72,7 @@ proof -
          apply (rule allI, rule conseqPre, vcg)
          apply (clarsimp simp: return_def)
         apply (wp schedule_sch_act_wf schedule_invs'
-             | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+             | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
       apply simp
       apply vcg
      apply vcg
@@ -86,7 +86,7 @@ proof -
        apply (rule allI, rule conseqPre, vcg)
        apply (clarsimp simp: return_def)
       apply (wp schedule_sch_act_wf schedule_invs'
-             | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+             | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
    apply (rule_tac Q="\<lambda>rv s. invs' s \<and> (\<forall>x. rv = Some x \<longrightarrow> x \<le> ARM.maxIRQ) \<and> rv \<noteq> Some 0x3FF" in hoare_post_imp)
     apply (clarsimp simp: Kernel_C.maxIRQ_def ARM.maxIRQ_def)
    apply (wp getActiveIRQ_le_maxIRQ getActiveIRQ_neq_Some0xFF | simp)+
@@ -115,14 +115,12 @@ lemma handleUnknownSyscall_ccorres:
          apply (rule allI, rule conseqPre, vcg)
         apply (clarsimp simp: return_def)
        apply (wp schedule_sch_act_wf schedule_invs'
-              | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+              | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
     apply (clarsimp, vcg)
    apply (clarsimp, rule conseqPre, vcg, clarsimp)
   apply clarsimp
   apply (intro impI conjI allI)
-      apply fastforce
-     apply (clarsimp simp: ct_not_ksQ)
-    apply (clarsimp simp add: sch_act_simple_def split: scheduler_action.split)
+    apply fastforce
    apply (rule active_ex_cap')
     apply (erule active_from_running')
    apply (erule invs_iflive')
@@ -172,13 +170,13 @@ lemma handleVMFaultEvent_ccorres:
        apply (rule allI, rule conseqPre, vcg)
        apply (clarsimp simp: return_def)
       apply (wp schedule_sch_act_wf schedule_invs'
-             | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+             | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
      apply (case_tac x, clarsimp, wp)
      apply (clarsimp, wp, simp)
     apply wp
    apply (simp add: guard_is_UNIV_def)
   apply (clarsimp simp: simple_sane_strg[unfolded sch_act_sane_not])
-  by (auto simp: ct_in_state'_def cfault_rel_def is_cap_fault_def ct_not_ksQ
+  by (auto simp: ct_in_state'_def cfault_rel_def is_cap_fault_def
               elim: pred_tcb'_weakenE st_tcb_ex_cap''
               dest: st_tcb_at_idle_thread' rf_sr_ksCurThread)
 
@@ -204,16 +202,14 @@ lemma handleUserLevelFault_ccorres:
         apply (rule allI, rule conseqPre, vcg)
         apply (clarsimp simp: return_def)
        apply (wp schedule_sch_act_wf schedule_invs'
-              | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+              | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
     apply (clarsimp, vcg)
    apply (clarsimp, rule conseqPre, vcg, clarsimp)
   apply clarsimp
   apply (intro impI conjI allI)
-      apply (simp add: ct_in_state'_def)
-      apply (erule pred_tcb'_weakenE)
-      apply simp
-     apply (clarsimp simp: ct_not_ksQ)
-    apply (clarsimp simp add: sch_act_simple_def split: scheduler_action.split)
+    apply (simp add: ct_in_state'_def)
+    apply (erule pred_tcb'_weakenE)
+    apply simp
    apply (rule active_ex_cap')
     apply (erule active_from_running')
    apply (erule invs_iflive')
@@ -398,11 +394,10 @@ lemma handleSyscall_ccorres:
           apply wp[1]
          apply clarsimp
          apply wp
-         apply (rule_tac Q="\<lambda>rv s. ct_in_state' simple' s \<and> sch_act_sane s \<and>
-                            (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))"
+         apply (rule_tac Q="\<lambda>rv s. ct_in_state' simple' s \<and> sch_act_sane s"
                               in hoare_post_imp)
           apply (simp add: ct_in_state'_def)
-         apply (wp handleReply_sane handleReply_ct_not_ksQ)
+         apply (wp handleReply_sane)
         \<comment> \<open>SysYield\<close>
         apply (clarsimp simp: syscall_from_H_def syscall_defs)
         apply (rule ccorres_cond_empty |rule ccorres_cond_univ)+
@@ -428,11 +423,11 @@ lemma handleSyscall_ccorres:
        apply (rule_tac P=\<top> and P'=UNIV in ccorres_from_vcg_throws)
        apply (rule allI, rule conseqPre, vcg)
        apply (clarsimp simp: return_def)
-      apply (wp schedule_invs' schedule_sch_act_wf | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+      apply (wp schedule_invs' schedule_sch_act_wf
+             | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
      apply (simp
           | wpc
           | wp hoare_drop_imp handleReply_sane handleReply_nonz_cap_to_ct schedule_invs'
-               handleReply_ct_not_ksQ[simplified]
           | strengthen ct_active_not_idle'_strengthen invs_valid_objs_strengthen)+
       apply (rule_tac  Q="\<lambda>rv. invs' and ct_active'" in hoare_post_imp, simp)
       apply (wp hy_invs')
@@ -450,7 +445,7 @@ lemma handleSyscall_ccorres:
    apply (frule active_ex_cap')
     apply (clarsimp simp: invs'_def valid_state'_def)
    apply (clarsimp simp: simple_sane_strg ct_in_state'_def st_tcb_at'_def obj_at'_def
-                        isReply_def ct_not_ksQ)
+                        isReply_def)
    apply (rule conjI, fastforce)
    prefer 2
    apply (cut_tac 'b=32 and x=a and n=10 and 'a=10 in ucast_leq_mask)
@@ -539,7 +534,7 @@ lemma handleHypervisorEvent_ccorres:
          apply simp
         apply assumption
        apply (wp schedule_sch_act_wf schedule_invs'
-              | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+              | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
     apply clarsimp+
   done
 
@@ -653,6 +648,7 @@ lemma callKernel_withFastpath_corres_C:
   apply (clarsimp simp: typ_heap_simps' ct_in_state'_def
                         "StrictC'_register_defs" word_sle_def word_sless_def
                         st_tcb_at'_opeq_simp)
+  apply (frule ready_qs_runnable_cross, (fastforce simp: valid_sched_def)+)
   apply (rule conjI, fastforce simp: st_tcb_at'_def)
   apply (auto elim!: pred_tcb'_weakenE cnode_caps_gsCNodes_from_sr[rotated])
   done
@@ -672,12 +668,12 @@ lemma threadSet_all_invs_triv':
     apply (wp thread_set_invs_trivial thread_set_ct_running thread_set_not_state_valid_sched
               threadSet_invs_trivial threadSet_ct_running' hoare_weak_lift_imp
               thread_set_ct_in_state
-           | simp add: tcb_cap_cases_def tcb_arch_ref_def
+           | simp add: tcb_cap_cases_def tcb_arch_ref_def exst_same_def
            | rule threadSet_ct_in_state'
            | wp (once) hoare_vcg_disj_lift)+
   apply clarsimp
   apply (rule exI, rule conjI, assumption)
-  apply (clarsimp simp: invs_def invs'_def cur_tcb_def cur_tcb'_def)
+  apply (clarsimp simp: invs_def valid_state_def valid_pspace_def invs'_def cur_tcb_def cur_tcb'_def)
   apply (simp add: state_relation_def)
   done
 
@@ -887,17 +883,22 @@ lemma dmo_domain_user_mem'[wp]:
   done
 
 lemma do_user_op_corres_C:
-  "corres_underlying rf_sr False False (=) (invs' and ex_abs einvs) \<top>
-                     (doUserOp f tc) (doUserOp_C f tc)"
+  "corres_underlying rf_sr False False (=)
+     (invs' and ksReadyQueues_asrt and ex_abs einvs) \<top>
+     (doUserOp f tc) (doUserOp_C f tc)"
   apply (simp only: doUserOp_C_def doUserOp_def split_def)
   apply (rule corres_guard_imp)
     apply (rule_tac P=\<top> and P'=\<top> and r'="(=)" in corres_split)
        apply (clarsimp simp: simpler_gets_def getCurThread_def
                 corres_underlying_def rf_sr_def cstate_relation_def Let_def)
-      apply (rule_tac P=valid_state' and P'=\<top> and r'="(=)" in corres_split)
+      apply (rule_tac P="valid_state' and ksReadyQueues_asrt"
+                  and P'=\<top> and r'="(=)"
+                   in corres_split)
          apply (clarsimp simp: cstate_to_A_def absKState_def
                                rf_sr_def cstate_to_H_correct ptable_lift_def)
-        apply (rule_tac P=valid_state' and P'=\<top> and r'="(=)" in corres_split)
+        apply (rule_tac P="valid_state' and ksReadyQueues_asrt"
+                    and P'=\<top> and r'="(=)"
+                     in corres_split)
            apply (clarsimp simp: cstate_to_A_def absKState_def
                                  rf_sr_def cstate_to_H_correct ptable_rights_def)
           apply (rule_tac P=pspace_distinct' and P'=\<top> and r'="(=)"
@@ -994,6 +995,9 @@ lemma refinement2_both:
     apply (subst cstate_to_H_correct)
      apply (fastforce simp: full_invs'_def invs'_def)
     apply (clarsimp simp: rf_sr_def)
+    apply (clarsimp simp: lift_state_relation_def full_invs_def)
+    apply (rule ksReadyQueues_asrt_cross)
+    apply (erule state_relation_ready_queues_relation)
    apply (simp add:absKState_def observable_memory_def absExst_def)
    apply (rule MachineTypes.machine_state.equality,simp_all)[1]
    apply (rule ext)
@@ -1020,13 +1024,35 @@ lemma refinement2_both:
    apply (clarsimp simp add: do_user_op_C_def do_user_op_H_def monad_to_transition_def)
    apply (rule rev_mp, rule_tac f="uop" and tc=af in do_user_op_corres_C)
    apply (clarsimp simp: corres_underlying_def invs_def ex_abs_def)
-   apply (fastforce simp: full_invs'_def ex_abs_def)
+   apply (drule bspec)
+    apply fastforce
+   apply clarsimp
+   apply (elim impE)
+    apply (clarsimp simp: full_invs'_def ex_abs_def)
+    apply (intro conjI)
+     apply (rule ksReadyQueues_asrt_cross)
+     apply (erule state_relation_ready_queues_relation)
+    apply (clarsimp simp: lift_state_relation_def full_invs_def)
+    apply (frule state_relation_ready_queues_relation)
+    apply (fastforce simp: ready_queues_relation_def Let_def tcbQueueEmpty_def)
+   apply fastforce
 
   apply (erule_tac P="a \<and> b \<and> c \<and> (\<exists>x. e x)" for a b c d e in disjE)
    apply (clarsimp simp add: do_user_op_C_def do_user_op_H_def monad_to_transition_def)
    apply (rule rev_mp, rule_tac f="uop" and tc=af in do_user_op_corres_C)
    apply (clarsimp simp: corres_underlying_def invs_def ex_abs_def)
-   apply (fastforce simp: full_invs'_def ex_abs_def)
+   apply (drule bspec)
+    apply fastforce
+   apply clarsimp
+   apply (elim impE)
+    apply (clarsimp simp: full_invs'_def ex_abs_def)
+    apply (intro conjI)
+     apply (rule ksReadyQueues_asrt_cross)
+     apply (erule state_relation_ready_queues_relation)
+    apply (clarsimp simp: lift_state_relation_def full_invs_def)
+    apply (frule state_relation_ready_queues_relation)
+    apply (fastforce simp: ready_queues_relation_def Let_def tcbQueueEmpty_def)
+   apply fastforce
 
   apply (clarsimp simp: check_active_irq_C_def check_active_irq_H_def)
   apply (rule rev_mp, rule check_active_irq_corres_C)
diff --git a/proof/crefine/ARM/Retype_C.thy b/proof/crefine/ARM/Retype_C.thy
index 8b52dde04e..d25e6fbb8c 100644
--- a/proof/crefine/ARM/Retype_C.thy
+++ b/proof/crefine/ARM/Retype_C.thy
@@ -2597,7 +2597,6 @@ lemma cnc_tcb_helper:
   and      al: "is_aligned (ctcb_ptr_to_tcb_ptr p) (objBitsKO kotcb)"
   and ptr0: "ctcb_ptr_to_tcb_ptr p \<noteq> 0"
   and ptrlb: "2^ctcb_size_bits \<le> ptr_val p"
-  and vq:  "valid_queues \<sigma>"
   and pal: "pspace_aligned' (\<sigma>\<lparr>ksPSpace := ks\<rparr>)"
   and pno: "pspace_no_overlap' (ctcb_ptr_to_tcb_ptr p) (objBitsKO kotcb) (\<sigma>\<lparr>ksPSpace := ks\<rparr>)"
   and pds: "pspace_distinct' (\<sigma>\<lparr>ksPSpace := ks\<rparr>)"
@@ -2911,21 +2910,20 @@ proof -
     unfolding ctcb_relation_def makeObject_tcb
     apply (simp add: fbtcb minBound_word)
     apply (intro conjI)
-    apply (simp add: cthread_state_relation_def thread_state_lift_def
-                     eval_nat_numeral ThreadState_defs)
-    apply (simp add: ccontext_relation_def carch_tcb_relation_def)
-    apply (rule allI)
-    subgoal for r
-      by (case_tac r;
-          simp add: "StrictC'_register_defs" eval_nat_numeral atcbContext_def atcbContextGet_def
-                    newArchTCB_def newContext_def initContext_def take_bit_Suc
-               del: unsigned_numeral)
-    apply (simp add: thread_state_lift_def eval_nat_numeral atcbContextGet_def)+
-    apply (simp add: Kernel_Config.timeSlice_def)
-    apply (simp add: cfault_rel_def seL4_Fault_lift_def seL4_Fault_get_tag_def Let_def
-                     lookup_fault_lift_def lookup_fault_get_tag_def lookup_fault_invalid_root_def
-                     eval_nat_numeral seL4_Fault_NullFault_def option_to_ptr_def option_to_0_def
-                split: if_split)+
+         apply (simp add: cthread_state_relation_def thread_state_lift_def
+                          eval_nat_numeral ThreadState_Inactive_def)
+        apply (clarsimp simp: ccontext_relation_def carch_tcb_relation_def
+                              newArchTCB_def atcbContextGet_def)
+        apply (case_tac r; simp add: C_register_defs index_foldr_update
+                                     atcbContext_def newArchTCB_def newContext_def
+                                     initContext_def)
+       apply (simp add: thread_state_lift_def index_foldr_update atcbContextGet_def)
+      apply (simp add: Kernel_Config.timeSlice_def)
+     apply (simp add: cfault_rel_def seL4_Fault_lift_def seL4_Fault_get_tag_def Let_def
+                      lookup_fault_lift_def lookup_fault_get_tag_def lookup_fault_invalid_root_def
+                      index_foldr_update seL4_Fault_NullFault_def option_to_ptr_def option_to_0_def
+               split: if_split)+
+    apply (simp add: option_to_ctcb_ptr_def)
     done
 
   have pks: "ks (ctcb_ptr_to_tcb_ptr p) = None"
@@ -2976,15 +2974,6 @@ proof -
     apply (fastforce simp: dom_def)
     done
 
-  hence kstcb: "\<And>qdom prio. ctcb_ptr_to_tcb_ptr p \<notin> set (ksReadyQueues \<sigma> (qdom, prio))" using vq
-    apply (clarsimp simp add: valid_queues_def valid_queues_no_bitmap_def)
-    apply (drule_tac x = qdom in spec)
-    apply (drule_tac x = prio in spec)
-    apply clarsimp
-    apply (drule (1) bspec)
-    apply (simp add: obj_at'_def)
-    done
-
   have ball_subsetE:
     "\<And>P S R. \<lbrakk> \<forall>x \<in> S. P x; R \<subseteq> S \<rbrakk> \<Longrightarrow> \<forall>x \<in> R. P x"
     by blast
@@ -3098,7 +3087,7 @@ proof -
     apply (simp add: cl_cte [simplified] cl_tcb [simplified] cl_rest [simplified] tag_disj_via_td_name)
     apply (clarsimp simp add: cready_queues_relation_def Let_def
                               htd_safe[simplified] kernel_data_refs_domain_eq_rotate)
-    apply (simp add: kstcb tcb_queue_update_other' hrs_htd_update
+    apply (simp add: tcb_queue_update_other' hrs_htd_update
                      ptr_retyp_to_array[simplified] irq[simplified])
     done
 qed
@@ -3978,7 +3967,7 @@ declare replicate_numeral [simp del]
 lemma ccorres_placeNewObject_tcb:
   "ccorresG rf_sr \<Gamma> dc xfdc
    (pspace_aligned' and pspace_distinct' and pspace_no_overlap' regionBase tcbBlockSizeBits
-      and valid_queues and (\<lambda>s. sym_refs (state_refs_of' s))
+      and (\<lambda>s. sym_refs (state_refs_of' s))
       and (\<lambda>s. 2 ^ tcbBlockSizeBits \<le> gsMaxObjectSize s)
       and ret_zero regionBase (2 ^ tcbBlockSizeBits)
       and K (regionBase \<noteq> 0 \<and> range_cover regionBase tcbBlockSizeBits tcbBlockSizeBits 1
@@ -4317,7 +4306,7 @@ qed
 lemma placeNewObject_user_data:
   "ccorresG rf_sr \<Gamma> dc xfdc
   (pspace_aligned' and pspace_distinct' and pspace_no_overlap' regionBase (pageBits+us)
-  and valid_queues and valid_machine_state'
+  and valid_machine_state'
   and ret_zero regionBase (2 ^ (pageBits+us))
   and (\<lambda>s. sym_refs (state_refs_of' s))
   and (\<lambda>s. 2^(pageBits +  us) \<le> gsMaxObjectSize s)
@@ -4439,7 +4428,7 @@ lemma placeNewObject_user_data_device:
   "ccorresG rf_sr \<Gamma> dc xfdc
   (pspace_aligned' and pspace_distinct'
     and ret_zero regionBase (2 ^ (pageBits + us))
-    and pspace_no_overlap' regionBase (pageBits+us) and valid_queues
+    and pspace_no_overlap' regionBase (pageBits+us)
     and (\<lambda>s. sym_refs (state_refs_of' s))
     and (\<lambda>s. 2^(pageBits +  us) \<le> gsMaxObjectSize s)
     and K (regionBase \<noteq> 0 \<and> range_cover regionBase (pageBits + us) (pageBits+us) (Suc 0)
@@ -4694,7 +4683,7 @@ proof -
      apply clarify
      apply (intro conjI)
       apply (clarsimp simp: invs_pspace_aligned' invs_pspace_distinct' invs_valid_global'
-                            APIType_capBits_def invs_queues invs_valid_objs'
+                            APIType_capBits_def invs_valid_objs'
                             invs_urz)
      apply clarsimp
      apply (clarsimp simp: pageBits_def ccap_relation_def APIType_capBits_def
@@ -4827,11 +4816,6 @@ lemma threadSet_domain_ccorres [corres]:
   apply (simp add: map_to_ctes_upd_tcb_no_ctes map_to_tcbs_upd tcb_cte_cases_def)
   apply (simp add: cep_relations_drop_fun_upd
                    cvariable_relation_upd_const ko_at_projectKO_opt)
-  apply (rule conjI)
-   defer
-   apply (erule cready_queues_relation_not_queue_ptrs)
-    apply (rule ext, simp split: if_split)
-   apply (rule ext, simp split: if_split)
   apply (drule ko_at_projectKO_opt)
   apply (erule (2) cmap_relation_upd_relI)
     subgoal by (simp add: ctcb_relation_def)
@@ -4956,7 +4940,6 @@ proof -
                                createObject_c_preconds_def)
          apply (frule invs_pspace_aligned')
          apply (frule invs_pspace_distinct')
-         apply (frule invs_queues)
          apply (frule invs_sym')
          apply (simp add: getObjectSize_def objBits_simps' word_bits_conv apiGetObjectSize_def
                           new_cap_addrs_def projectKO_opt_tcb)
@@ -5007,7 +4990,6 @@ proof -
         apply (clarsimp simp: createObject_hs_preconds_def isFrameType_def)
         apply (frule invs_pspace_aligned')
         apply (frule invs_pspace_distinct')
-        apply (frule invs_queues)
         apply (frule invs_sym')
         apply (auto simp: getObjectSize_def objBits_simps
                           apiGetObjectSize_def
@@ -5046,7 +5028,6 @@ proof -
        apply (clarsimp simp: createObject_hs_preconds_def isFrameType_def)
        apply (frule invs_pspace_aligned')
        apply (frule invs_pspace_distinct')
-       apply (frule invs_queues)
        apply (frule invs_sym')
        apply (auto simp: getObjectSize_def objBits_simps apiGetObjectSize_def
                          ntfnSizeBits_def word_bits_conv
@@ -5085,7 +5066,6 @@ proof -
        apply (clarsimp simp: createObject_hs_preconds_def isFrameType_def)
        apply (frule invs_pspace_aligned')
        apply (frule invs_pspace_distinct')
-       apply (frule invs_queues)
        apply (frule invs_sym')
        apply (frule(1) ghost_assertion_size_logic_no_unat)
        apply (clarsimp simp: getObjectSize_def objBits_simps apiGetObjectSize_def
diff --git a/proof/crefine/ARM/SR_lemmas_C.thy b/proof/crefine/ARM/SR_lemmas_C.thy
index 5fa807eab5..7857a68d4c 100644
--- a/proof/crefine/ARM/SR_lemmas_C.thy
+++ b/proof/crefine/ARM/SR_lemmas_C.thy
@@ -296,11 +296,15 @@ lemma cmdbnode_relation_mdb_node_to_H [simp]:
   unfolding cmdbnode_relation_def mdb_node_to_H_def mdb_node_lift_def cte_lift_def
   by (fastforce split: option.splits)
 
-definition
-  tcb_no_ctes_proj :: "tcb \<Rightarrow> Structures_H.thread_state \<times> word32 \<times> word32 \<times> arch_tcb \<times> bool \<times> word8 \<times> word8 \<times> word8 \<times> nat \<times> fault option \<times> word32 option"
+definition tcb_no_ctes_proj ::
+  "tcb \<Rightarrow> Structures_H.thread_state \<times> machine_word \<times> machine_word \<times> arch_tcb \<times> bool \<times> word8
+          \<times> word8 \<times> word8 \<times> nat \<times> fault option \<times> machine_word option
+          \<times> machine_word option \<times> machine_word option"
   where
-  "tcb_no_ctes_proj t \<equiv> (tcbState t, tcbFaultHandler t, tcbIPCBuffer t, tcbArch t, tcbQueued t,
-                            tcbMCP t, tcbPriority t, tcbDomain t, tcbTimeSlice t, tcbFault t, tcbBoundNotification t)"
+  "tcb_no_ctes_proj t \<equiv>
+     (tcbState t, tcbFaultHandler t, tcbIPCBuffer t, tcbArch t, tcbQueued t,
+      tcbMCP t, tcbPriority t, tcbDomain t, tcbTimeSlice t, tcbFault t, tcbBoundNotification t,
+      tcbSchedNext t, tcbSchedPrev t)"
 
 lemma tcb_cte_cases_proj_eq [simp]:
   "tcb_cte_cases p = Some (getF, setF) \<Longrightarrow>
@@ -1384,9 +1388,9 @@ lemma cmap_relation_cong:
    apply (erule imageI)
    done
 
-lemma ctcb_relation_null_queue_ptrs:
+lemma ctcb_relation_null_ep_ptrs:
   assumes rel: "cmap_relation mp mp' tcb_ptr_to_ctcb_ptr ctcb_relation"
-  and same: "map_option tcb_null_queue_ptrs \<circ> mp'' = map_option tcb_null_queue_ptrs \<circ> mp'"
+  and same: "map_option tcb_null_ep_ptrs \<circ> mp'' = map_option tcb_null_ep_ptrs \<circ> mp'"
   shows "cmap_relation mp mp'' tcb_ptr_to_ctcb_ptr ctcb_relation"
   using rel
   apply (rule iffD1 [OF cmap_relation_cong, OF _ map_option_eq_dom_eq, rotated -1])
@@ -1394,7 +1398,7 @@ lemma ctcb_relation_null_queue_ptrs:
    apply (rule same [symmetric])
   apply (drule compD [OF same])
   apply (case_tac b, case_tac b')
-  apply (simp add: ctcb_relation_def tcb_null_queue_ptrs_def)
+  apply (simp add: ctcb_relation_def tcb_null_ep_ptrs_def)
   done
 
 (* Levity: added (20090419 09:44:27) *)
@@ -2117,6 +2121,14 @@ lemma invs_urz[elim!]:
   "invs' s \<Longrightarrow> untyped_ranges_zero' s"
   by (clarsimp simp: invs'_def valid_state'_def)
 
+lemma rf_sr_ctcb_queue_relation:
+  "\<lbrakk> (s, s') \<in> rf_sr; d \<le> maxDomain; p \<le> maxPriority \<rbrakk>
+  \<Longrightarrow> ctcb_queue_relation (ksReadyQueues s (d, p))
+                          (index (ksReadyQueues_' (globals s')) (cready_queues_index_to_C d p))"
+  unfolding rf_sr_def cstate_relation_def cready_queues_relation_def
+  apply (clarsimp simp: Let_def seL4_MinPrio_def minDom_def maxDom_to_H maxPrio_to_H)
+  done
+
 lemma rf_sr_sched_action_relation:
   "(s, s') \<in> rf_sr
    \<Longrightarrow> cscheduler_action_relation (ksSchedulerAction s) (ksSchedulerAction_' (globals s'))"
@@ -2143,5 +2155,11 @@ lemma physBase_spec:
   apply (simp add: Kernel_Config.physBase_def)
   done
 
+lemma rf_sr_obj_update_helper:
+  "(s, s'\<lparr> globals := globals s' \<lparr> t_hrs_' := t_hrs_' (globals (undefined
+              \<lparr> globals := (undefined \<lparr> t_hrs_' := f (globals s') (t_hrs_' (globals s')) \<rparr>)\<rparr>))\<rparr>\<rparr>) \<in> rf_sr
+          \<Longrightarrow> (s, globals_update (\<lambda>v. t_hrs_'_update (f v) v) s') \<in> rf_sr"
+  by (simp cong: StateSpace.state.fold_congs globals.fold_congs)
+
 end
 end
diff --git a/proof/crefine/ARM/Schedule_C.thy b/proof/crefine/ARM/Schedule_C.thy
index ad4a8c857c..c9a827f206 100644
--- a/proof/crefine/ARM/Schedule_C.thy
+++ b/proof/crefine/ARM/Schedule_C.thy
@@ -6,7 +6,7 @@
  *)
 
 theory Schedule_C
-imports Tcb_C
+imports Tcb_C Detype_C
 begin
 
 (*FIXME: arch_split: move up?*)
@@ -33,18 +33,17 @@ lemma switchToIdleThread_ccorres:
   "ccorres dc xfdc invs_no_cicd' UNIV []
            switchToIdleThread (Call switchToIdleThread_'proc)"
   apply (cinit)
+   apply (rule ccorres_stateAssert)
    apply (rule ccorres_symb_exec_l)
       apply (ctac (no_vcg) add: Arch_switchToIdleThread_ccorres)
        apply (simp add: setCurThread_def)
+       apply (rule ccorres_stateAssert)
        apply (rule_tac P="\<lambda>s. thread = ksIdleThread s" and P'=UNIV in ccorres_from_vcg)
        apply (rule allI, rule conseqPre, vcg)
        apply (clarsimp simp: simpler_modify_def)
        apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
                              carch_state_relation_def cmachine_state_relation_def)
-      apply (simp add: ARM_H.switchToIdleThread_def)
-      apply wp+
-   apply simp
-  apply simp
+      apply (wpsimp simp: ARM_H.switchToIdleThread_def wp: hoare_drop_imps)+
   done
 
 lemma Arch_switchToThread_ccorres:
@@ -64,6 +63,13 @@ lemma Arch_switchToThread_ccorres:
   apply clarsimp
   done
 
+lemma invs_no_cicd'_pspace_aligned':
+  "all_invs_but_ct_idle_or_in_cur_domain' s \<Longrightarrow> pspace_aligned' s"
+  by (simp add: all_invs_but_ct_idle_or_in_cur_domain'_def valid_pspace'_def)
+
+lemma invs_no_cicd'_pspace_distinct':
+  "all_invs_but_ct_idle_or_in_cur_domain' s \<Longrightarrow> pspace_distinct' s"
+  by (simp add: all_invs_but_ct_idle_or_in_cur_domain'_def valid_pspace'_def)
 
 (* FIXME: move *)
 lemma switchToThread_ccorres:
@@ -73,23 +79,28 @@ lemma switchToThread_ccorres:
            hs
            (switchToThread t)
            (Call switchToThread_'proc)"
-  apply (cinit lift: thread_')
+  apply (clarsimp simp: switchToThread_def)
+  apply (rule ccorres_symb_exec_l'[OF _ _ isRunnable_sp]; (solves wpsimp)?)
+  apply (rule ccorres_symb_exec_l'[OF _ _ assert_sp]; (solves wpsimp)?)
+  apply (rule ccorres_stateAssert_fwd)+
+  apply (cinit' lift: thread_')
    apply (ctac (no_vcg) add: Arch_switchToThread_ccorres)
     apply (ctac (no_vcg) add: tcbSchedDequeue_ccorres)
+     apply (simp add: setCurThread_def)
+     apply (rule ccorres_stateAssert)
      apply (rule_tac P=\<top> and P'=UNIV in ccorres_from_vcg)
      apply clarsimp
      apply (rule conseqPre, vcg)
-     apply (clarsimp simp: setCurThread_def simpler_modify_def)
-     apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
-                           carch_state_relation_def cmachine_state_relation_def)
-    apply wp+
-  apply (clarsimp simp: all_invs_but_ct_idle_or_in_cur_domain'_def valid_state'_def)
+     apply (clarsimp simp: setCurThread_def simpler_modify_def rf_sr_def cstate_relation_def
+                           Let_def carch_state_relation_def cmachine_state_relation_def)
+    apply (wpsimp wp: Arch_switchToThread_invs_no_cicd' hoare_drop_imps
+           | strengthen invs_no_cicd'_pspace_aligned' invs_no_cicd'_pspace_distinct')+
   done
 
 lemma activateThread_ccorres:
   "ccorres dc xfdc
            (ct_in_state' activatable' and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)
-                   and valid_queues and valid_objs')
+            and valid_objs' and pspace_aligned' and pspace_distinct')
            UNIV []
            activateThread
            (Call activateThread_'proc)"
@@ -159,6 +170,31 @@ lemma switchToThread_ccorres':
      apply auto
   done
 
+lemma ccorres_pre_getQueue:
+  assumes cc: "\<And>queue. ccorres r xf (P queue) (P' queue) hs (f queue) c"
+  shows   "ccorres r xf (\<lambda>s. P (ksReadyQueues s (d, p)) s \<and> d \<le> maxDomain \<and> p \<le> maxPriority)
+                        {s'. \<forall>queue. (let cqueue = index (ksReadyQueues_' (globals s'))
+                                                         (cready_queues_index_to_C d p) in
+                                      ctcb_queue_relation queue cqueue) \<longrightarrow> s' \<in> P' queue}
+           hs (getQueue d p >>= (\<lambda>queue. f queue)) c"
+  apply (rule ccorres_guard_imp2)
+  apply (rule ccorres_symb_exec_l2)
+     defer
+     defer
+     apply (rule gq_sp)
+    defer
+    apply (rule ccorres_guard_imp)
+    apply (rule cc)
+     apply clarsimp
+     apply assumption
+    apply assumption
+   apply (clarsimp simp: getQueue_def gets_exs_valid)
+  apply clarsimp
+  apply (drule spec, erule mp)
+  apply (erule rf_sr_ctcb_queue_relation)
+   apply (simp add: maxDom_to_H maxPrio_to_H)+
+  done
+
 lemma chooseThread_ccorres:
   "ccorres dc xfdc all_invs_but_ct_idle_or_in_cur_domain' UNIV [] chooseThread (Call chooseThread_'proc)"
 proof -
@@ -174,9 +210,22 @@ proof -
     "\<And>s. invs_no_cicd' s \<Longrightarrow> ksCurDomain s \<le> maxDomain"
     by (simp add: invs_no_cicd'_def)
 
+  have invs_no_cicd'_valid_bitmaps:
+    "\<And>s. invs_no_cicd' s \<Longrightarrow> valid_bitmaps s"
+    by (simp add: invs_no_cicd'_def)
+
+  have invs_no_cicd'_pspace_aligned':
+    "\<And>s. invs_no_cicd' s \<Longrightarrow> pspace_aligned' s"
+    by (simp add: invs_no_cicd'_def valid_pspace'_def)
+
+  have invs_no_cicd'_pspace_distinct':
+    "\<And>s. invs_no_cicd' s \<Longrightarrow> pspace_distinct' s"
+    by (simp add: invs_no_cicd'_def valid_pspace'_def)
+
   show ?thesis
     supply if_split[split del]
     apply (cinit)
+     apply (rule ccorres_stateAssert)+
      apply (simp add: numDomains_sge_1_simp)
      apply (rule_tac xf'=dom_' and r'="\<lambda>rv rv'. rv' = ucast rv" in ccorres_split_nothrow_novcg)
          apply (rule ccorres_from_vcg[where P=\<top> and P'=UNIV])
@@ -209,7 +258,7 @@ proof -
          apply (rule_tac P="curdom \<le> maxDomain" in ccorres_cross_over_guard_no_st)
          apply (rule_tac P="prio \<le> maxPriority" in ccorres_cross_over_guard_no_st)
          apply (rule ccorres_pre_getQueue)
-         apply (rule_tac P="queue \<noteq> []" in ccorres_cross_over_guard_no_st)
+         apply (rule_tac P="\<not> tcbQueueEmpty queue" in ccorres_cross_over_guard_no_st)
          apply (rule ccorres_symb_exec_l)
             apply (rule ccorres_assert)
             apply (rule ccorres_symb_exec_r)
@@ -224,37 +273,40 @@ proof -
              apply (rule conseqPre, vcg)
              apply (rule Collect_mono)
              apply clarsimp
-             apply (strengthen queue_in_range)
              apply assumption
             apply clarsimp
             apply (rule conseqPre, vcg)
             apply clarsimp
            apply (wp isRunnable_wp)+
        apply (clarsimp simp: Let_def guard_is_UNIV_def)
-       apply (drule invs_no_cicd'_queues)
-       apply (case_tac queue, simp)
-       apply (clarsimp simp: tcb_queue_relation'_def cready_queues_index_to_C_def numPriorities_def)
-       apply (clarsimp simp add: maxDom_to_H maxPrio_to_H
-                                 queue_in_range[where qdom=0, simplified, simplified maxPrio_to_H])
-       apply (clarsimp simp: le_maxDomain_eq_less_numDomains unat_trans_ucast_helper )
+       apply (rule conjI)
+        apply (clarsimp simp: le_maxDomain_eq_less_numDomains unat_trans_ucast_helper)
+       apply (intro conjI impI)
+        apply (clarsimp simp: cready_queues_index_to_C_def numPriorities_def ctcb_queue_relation_def
+                              tcbQueueEmpty_def option_to_ctcb_ptr_def)
+       apply (frule_tac qdom=curdom and prio=rv in cready_queues_index_to_C_in_range')
+        apply fastforce
+       apply (clarsimp simp: num_tcb_queues_val word_less_nat_alt cready_queues_index_to_C_def2)
       apply wpsimp
      apply (clarsimp simp: guard_is_UNIV_def le_maxDomain_eq_less_numDomains word_less_nat_alt
                            numDomains_less_numeric_explicit)
-    apply (frule invs_no_cicd'_queues)
+    apply clarsimp
     apply (frule invs_no_cicd'_max_CurDomain)
-    apply (frule invs_no_cicd'_queues)
-    apply (clarsimp simp: valid_queues_def lookupBitmapPriority_le_maxPriority)
+    apply (frule invs_no_cicd'_pspace_aligned')
+    apply (frule invs_no_cicd'_pspace_distinct')
+    apply (frule invs_no_cicd'_valid_bitmaps)
+    apply (frule valid_bitmaps_bitmapQ_no_L1_orphans)
+    apply (frule valid_bitmaps_valid_bitmapQ)
+    apply (clarsimp simp: ready_queue_relation_def ksReadyQueues_asrt_def cong: conj_cong)
     apply (intro conjI impI)
-       apply (fastforce dest: bitmapQ_from_bitmap_lookup simp: valid_bitmapQ_bitmapQ_simp)
-      apply (fastforce dest: lookupBitmapPriority_obj_at'
-                       simp: pred_conj_def obj_at'_def st_tcb_at'_def)
-     apply (fastforce dest: bitmapQ_from_bitmap_lookup simp: valid_bitmapQ_bitmapQ_simp)
-    apply (clarsimp simp: pred_conj_def obj_at'_def st_tcb_at'_def)
-    apply (clarsimp simp: not_less le_maxDomain_eq_less_numDomains)
-    apply (prop_tac "ksCurDomain s = 0")
-     using unsigned_eq_0_iff apply force
-    apply (cut_tac s=s in lookupBitmapPriority_obj_at'; simp?)
-    apply (clarsimp simp: pred_conj_def obj_at'_def st_tcb_at'_def)
+         apply (fastforce intro: lookupBitmapPriority_le_maxPriority)
+        apply (fastforce dest!: bitmapQ_from_bitmap_lookup valid_bitmapQ_bitmapQ_simp)
+       apply (fastforce dest!: lookupBitmapPriority_obj_at'
+                         simp: ready_queue_relation_def ksReadyQueues_asrt_def st_tcb_at'_def obj_at'_def)
+      apply (fastforce dest: lookupBitmapPriority_le_maxPriority)
+     apply (fastforce dest!: bitmapQ_from_bitmap_lookup valid_bitmapQ_bitmapQ_simp)
+    apply (fastforce dest!: lookupBitmapPriority_obj_at'
+                      simp: ready_queue_relation_def ksReadyQueues_asrt_def st_tcb_at'_def obj_at'_def)
     done
 qed
 
@@ -574,7 +626,7 @@ lemma schedule_ccorres:
           apply (wp (once) hoare_drop_imps)
            apply wp
           apply (strengthen strenghten_False_imp[where P="a = ResumeCurrentThread" for a])
-          apply (clarsimp simp: conj_ac invs_queues invs_valid_objs' cong: conj_cong)
+          apply (clarsimp simp: conj_ac invs_valid_objs' cong: conj_cong)
           apply wp
          apply (clarsimp, vcg exspec=tcbSchedEnqueue_modifies)
         apply (clarsimp, vcg exspec=tcbSchedEnqueue_modifies)
@@ -594,9 +646,11 @@ lemma schedule_ccorres:
     apply wp
    apply vcg
 
-  apply (clarsimp simp: tcb_at_invs' rf_sr_ksCurThread if_apply_def2 invs_queues invs_valid_objs')
+  apply (clarsimp simp: tcb_at_invs' rf_sr_ksCurThread if_apply_def2 invs_valid_objs')
   apply (frule invs_sch_act_wf')
   apply (frule tcb_at_invs')
+  apply (frule invs_pspace_aligned')
+  apply (frule invs_pspace_distinct')
   apply (rule conjI)
    apply (clarsimp dest!: rf_sr_cscheduler_relation simp: cscheduler_action_relation_def)
   apply (rule conjI; clarsimp)
@@ -645,11 +699,7 @@ lemma threadSet_timeSlice_ccorres [corres]:
                    map_to_tcbs_upd)
   apply (simp add: cep_relations_drop_fun_upd cvariable_relation_upd_const
                    ko_at_projectKO_opt)
-  apply (rule conjI)
    defer
-   apply (erule cready_queues_relation_not_queue_ptrs)
-    apply (rule ext, simp split: if_split)
-   apply (rule ext, simp split: if_split)
   apply (drule ko_at_projectKO_opt)
   apply (erule (2) cmap_relation_upd_relI)
     apply (simp add: ctcb_relation_def)
@@ -693,7 +743,7 @@ lemma timerTick_ccorres:
                apply simp
                apply (ctac (no_vcg) add: tcbSchedAppend_ccorres)
                 apply (ctac add: rescheduleRequired_ccorres)
-               apply (wp weak_sch_act_wf_lift_linear threadSet_valid_queues
+               apply (wp weak_sch_act_wf_lift_linear
                          threadSet_pred_tcb_at_state tcbSchedAppend_valid_objs' threadSet_valid_objs' threadSet_tcbDomain_triv
                     | clarsimp simp: st_tcb_at'_def o_def split: if_splits)+
              apply (vcg exspec=tcbSchedDequeue_modifies)
diff --git a/proof/crefine/ARM/StateRelation_C.thy b/proof/crefine/ARM/StateRelation_C.thy
index 1f68d18a5b..da94c204a4 100644
--- a/proof/crefine/ARM/StateRelation_C.thy
+++ b/proof/crefine/ARM/StateRelation_C.thy
@@ -20,8 +20,7 @@ definition
 definition
   "option_to_ptr \<equiv> Ptr o option_to_0"
 
-(* used for bound ntfn/tcb *)
-definition
+definition option_to_ctcb_ptr :: "machine_word option \<Rightarrow> tcb_C ptr" where
   "option_to_ctcb_ptr x \<equiv> case x of None \<Rightarrow> NULL | Some t \<Rightarrow> tcb_ptr_to_ctcb_ptr t"
 
 
@@ -344,7 +343,9 @@ where
      \<and> tcbTimeSlice atcb    = unat (tcbTimeSlice_C ctcb)
      \<and> cfault_rel (tcbFault atcb) (seL4_Fault_lift (tcbFault_C ctcb))
                   (lookup_fault_lift (tcbLookupFailure_C ctcb))
-     \<and> option_to_ptr (tcbBoundNotification atcb) = tcbBoundNotification_C ctcb"
+     \<and> option_to_ptr (tcbBoundNotification atcb) = tcbBoundNotification_C ctcb
+     \<and> option_to_ctcb_ptr (tcbSchedPrev atcb) = tcbSchedPrev_C ctcb
+     \<and> option_to_ctcb_ptr (tcbSchedNext atcb) = tcbSchedNext_C ctcb"
 
 abbreviation
   "ep_queue_relation' \<equiv> tcb_queue_relation' tcbEPNext_C tcbEPPrev_C"
@@ -567,17 +568,17 @@ definition
 where
   "cready_queues_index_to_C qdom prio \<equiv> (unat qdom) * numPriorities + (unat prio)"
 
-definition cready_queues_relation ::
-  "tcb_C typ_heap \<Rightarrow> (tcb_queue_C[num_tcb_queues]) \<Rightarrow> (domain \<times> priority \<Rightarrow> ready_queue) \<Rightarrow> bool"
-where
-  "cready_queues_relation h_tcb queues aqueues \<equiv>
-     \<forall>qdom prio. ((qdom \<ge> ucast minDom \<and> qdom \<le> ucast maxDom \<and>
-                  prio \<ge> ucast minPrio \<and> prio \<le> ucast maxPrio) \<longrightarrow>
-       (let cqueue = index queues (cready_queues_index_to_C qdom prio) in
-            sched_queue_relation' h_tcb (aqueues (qdom, prio)) (head_C cqueue) (end_C cqueue)))
-        \<and> (\<not> (qdom \<ge> ucast minDom \<and> qdom \<le> ucast maxDom \<and>
-                  prio \<ge> ucast minPrio \<and> prio \<le> ucast maxPrio) \<longrightarrow> aqueues (qdom, prio) = [])"
+definition ctcb_queue_relation :: "tcb_queue \<Rightarrow> tcb_queue_C \<Rightarrow> bool" where
+   "ctcb_queue_relation aqueue cqueue \<equiv>
+      head_C cqueue = option_to_ctcb_ptr (tcbQueueHead aqueue)
+      \<and> end_C cqueue = option_to_ctcb_ptr (tcbQueueEnd aqueue)"
 
+definition cready_queues_relation ::
+  "(domain \<times> priority \<Rightarrow> ready_queue) \<Rightarrow> (tcb_queue_C[num_tcb_queues]) \<Rightarrow>  bool"
+  where
+  "cready_queues_relation aqueues cqueues \<equiv>
+     \<forall>d p. d \<le> maxDomain \<and> p \<le> maxPriority
+           \<longrightarrow> ctcb_queue_relation (aqueues (d, p)) (index cqueues (cready_queues_index_to_C d p))"
 
 abbreviation
   "cte_array_relation astate cstate
@@ -715,9 +716,7 @@ where
   "cstate_relation astate cstate \<equiv>
      let cheap = t_hrs_' cstate in
        cpspace_relation (ksPSpace astate) (underlying_memory (ksMachineState astate)) cheap \<and>
-       cready_queues_relation (clift cheap)
-                             (ksReadyQueues_' cstate)
-                             (ksReadyQueues astate) \<and>
+       cready_queues_relation (ksReadyQueues astate) (ksReadyQueues_' cstate) \<and>
        zero_ranges_are_zero (gsUntypedZeroRanges astate) cheap \<and>
        cbitmap_L1_relation (ksReadyQueuesL1Bitmap_' cstate) (ksReadyQueuesL1Bitmap astate) \<and>
        cbitmap_L2_relation (ksReadyQueuesL2Bitmap_' cstate) (ksReadyQueuesL2Bitmap astate) \<and>
diff --git a/proof/crefine/ARM/SyscallArgs_C.thy b/proof/crefine/ARM/SyscallArgs_C.thy
index 59b471f7a0..716eafd867 100644
--- a/proof/crefine/ARM/SyscallArgs_C.thy
+++ b/proof/crefine/ARM/SyscallArgs_C.thy
@@ -48,9 +48,7 @@ lemma replyOnRestart_invs'[wp]:
   including no_pre
   apply (simp add: replyOnRestart_def)
   apply (wp setThreadState_nonqueued_state_update rfk_invs' hoare_weak_lift_imp)
-  apply (rule hoare_vcg_all_lift)
-  apply (wp setThreadState_nonqueued_state_update rfk_invs' hoare_vcg_all_lift rfk_ksQ)
-   apply (rule hoare_strengthen_post, rule gts_sp')
+  apply (rule hoare_strengthen_post, rule gts_sp')
   apply (clarsimp simp: pred_tcb_at')
   apply (auto elim!: pred_tcb'_weakenE st_tcb_ex_cap''
                dest: st_tcb_at_idle_thread')
diff --git a/proof/crefine/ARM/Syscall_C.thy b/proof/crefine/ARM/Syscall_C.thy
index 94d8afeedb..31431e2787 100644
--- a/proof/crefine/ARM/Syscall_C.thy
+++ b/proof/crefine/ARM/Syscall_C.thy
@@ -43,8 +43,7 @@ lemma cap_cases_one_on_true_sum:
 lemma performInvocation_Endpoint_ccorres:
   "ccorres (K (K \<bottom>) \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
        (invs' and st_tcb_at' simple' thread and ep_at' epptr
-              and sch_act_sane and (\<lambda>s. thread = ksCurThread s
-              \<and> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))))
+              and sch_act_sane and (\<lambda>s. thread = ksCurThread s))
        (UNIV \<inter> {s. block_' s = from_bool blocking}
              \<inter> {s. call_' s = from_bool do_call}
              \<inter> {s. badge_' s = badge}
@@ -117,7 +116,6 @@ lemma decodeInvocation_ccorres:
               and (\<lambda>s. \<forall>v \<in> set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s)
               and (\<lambda>s. \<forall>v \<in> set extraCaps. s \<turnstile>' fst v \<and> cte_at' (snd v) s)
               and (\<lambda>s. \<forall>v \<in> set extraCaps. \<forall>y \<in> zobj_refs' (fst v). ex_nonz_cap_to' y s)
-              and (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))
               and sysargs_rel args buffer)
        (UNIV \<inter> {s. call_' s = from_bool isCall}
              \<inter> {s. block_' s = from_bool isBlocking}
@@ -194,7 +192,7 @@ lemma decodeInvocation_ccorres:
       apply simp
       apply (rule hoare_use_eq[where f=ksCurThread])
        apply (wp sts_invs_minor' sts_st_tcb_at'_cases
-                 setThreadState_ct' hoare_vcg_all_lift sts_ksQ')+
+                 setThreadState_ct' hoare_vcg_all_lift)+
      apply simp
      apply (vcg exspec=setThreadState_modifies)
     apply vcg
@@ -461,7 +459,7 @@ lemma wordFromMessageInfo_spec:
 
 lemma handleDoubleFault_ccorres:
   "ccorres dc xfdc (invs' and  tcb_at' tptr and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and
-        sch_act_not tptr and (\<lambda>s. \<forall>p. tptr \<notin> set (ksReadyQueues s p)))
+        sch_act_not tptr)
       (UNIV \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr tptr})
       [] (handleDoubleFault tptr ex1 ex2)
          (Call handleDoubleFault_'proc)"
@@ -539,8 +537,7 @@ lemma hrs_mem_update_use_hrs_mem:
 
 lemma sendFaultIPC_ccorres:
   "ccorres  (cfault_rel2 \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
-      (invs' and st_tcb_at' simple' tptr and sch_act_not tptr and
-       (\<lambda>s. \<forall>p. tptr \<notin> set (ksReadyQueues s p)))
+      (invs' and st_tcb_at' simple' tptr and sch_act_not tptr)
       (UNIV \<inter> {s. (cfault_rel (Some fault) (seL4_Fault_lift(current_fault_' (globals s)))
                        (lookup_fault_lift(current_lookup_fault_' (globals s))))}
             \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr tptr})
@@ -619,8 +616,8 @@ lemma sendFaultIPC_ccorres:
               apply (ctac (no_vcg) add: sendIPC_ccorres)
                apply (ctac (no_vcg) add: ccorres_return_CE [unfolded returnOk_def comp_def])
               apply wp
-             apply (wp threadSet_pred_tcb_no_state threadSet_invs_trivial threadSet_typ_at_lifts
-                    | simp)+
+             apply (wpsimp wp: threadSet_invs_trivial)
+             apply (wpsimp wp: threadSet_pred_tcb_no_state threadSet_typ_at_lifts)
 
             apply (clarsimp simp: guard_is_UNIV_def)
             apply (subgoal_tac "capEPBadge epcap && mask 28 = capEPBadge epcap")
@@ -655,8 +652,7 @@ lemma sendFaultIPC_ccorres:
          apply vcg
         apply (clarsimp simp: inQ_def)
         apply (rule_tac Q="\<lambda>a b. invs' b \<and> st_tcb_at' simple' tptr b
-                                 \<and> sch_act_not tptr b \<and> valid_cap' a b
-                                 \<and> (\<forall>p. tptr \<notin> set (ksReadyQueues b p))"
+                                 \<and> sch_act_not tptr b \<and> valid_cap' a b"
                  and E="\<lambda> _. \<top>"
                  in hoare_post_impErr)
           apply (wp)
@@ -677,8 +673,7 @@ lemma sendFaultIPC_ccorres:
   done
 
 lemma handleFault_ccorres:
-  "ccorres dc xfdc (invs' and st_tcb_at' simple' t and
-        sch_act_not t and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p)))
+  "ccorres dc xfdc (invs' and st_tcb_at' simple' t and sch_act_not t)
       (UNIV \<inter> {s. (cfault_rel (Some flt) (seL4_Fault_lift(current_fault_' (globals s)))
                        (lookup_fault_lift(current_lookup_fault_' (globals s))) )}
             \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr t})
@@ -753,8 +748,7 @@ lemma getMessageInfo_msgLength':
 lemma handleInvocation_ccorres:
   "ccorres (K dc \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
        (invs' and (\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and
-        ct_active' and sch_act_simple and
-        (\<lambda>s. \<forall>x. ksCurThread s \<notin> set (ksReadyQueues s x)))
+        ct_active' and sch_act_simple)
        (UNIV \<inter> {s. isCall_' s = from_bool isCall}
              \<inter> {s. isBlocking_' s = from_bool isBlocking}) []
        (handleInvocation isCall isBlocking) (Call handleInvocation_'proc)"
@@ -883,7 +877,7 @@ lemma handleInvocation_ccorres:
                      apply (wp hoare_split_bind_case_sumE hoare_drop_imps
                                setThreadState_nonqueued_state_update
                                ct_in_state'_set setThreadState_st_tcb
-                               hoare_vcg_all_lift sts_ksQ'
+                               hoare_vcg_all_lift
                                  | wpc | wps)+
                     apply auto[1]
                    apply clarsimp
@@ -1140,8 +1134,7 @@ lemma handleRecv_ccorres:
   notes rf_sr_upd_safe[simp del]
   shows
   "ccorres dc xfdc
-       (\<lambda>s. invs' s \<and> st_tcb_at' simple' (ksCurThread s) s
-               \<and> sch_act_sane s \<and> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)))
+       (\<lambda>s. invs' s \<and> st_tcb_at' simple' (ksCurThread s) s \<and> sch_act_sane s)
        {s. isBlocking_' s = from_bool isBlocking}
        []
        (handleRecv isBlocking)
@@ -1205,7 +1198,7 @@ lemma handleRecv_ccorres:
             apply (rule_tac P="\<lambda>s. ksCurThread s = thread" in ccorres_cross_over_guard)
             apply (ctac add: receiveIPC_ccorres)
 
-           apply (wp deleteCallerCap_ksQ_ct' hoare_vcg_all_lift)
+           apply (wp hoare_vcg_all_lift)
           apply (rule conseqPost[where Q'=UNIV and A'="{}"], vcg exspec=deleteCallerCap_modifies)
            apply (clarsimp dest!: rf_sr_ksCurThread)
           apply simp
@@ -1328,13 +1321,11 @@ lemma handleRecv_ccorres:
       apply clarsimp
       apply (rename_tac thread epCPtr)
         apply (rule_tac Q'="(\<lambda>rv s. invs' s \<and> st_tcb_at' simple' thread s
-               \<and> sch_act_sane s \<and> (\<forall>p. thread \<notin> set (ksReadyQueues s p)) \<and> thread = ksCurThread s
+               \<and> sch_act_sane s \<and> thread = ksCurThread s
                \<and> valid_cap' rv s)" in hoare_post_imp_R[rotated])
-         apply (clarsimp simp: sch_act_sane_def)
-         apply (auto dest!: obj_at_valid_objs'[OF _ invs_valid_objs']
-                      simp: projectKOs valid_obj'_def,
-                auto simp: pred_tcb_at'_def obj_at'_def objBits_simps projectKOs ct_in_state'_def)[1]
-         apply wp
+       apply (intro conjI impI allI; clarsimp simp: sch_act_sane_def)
+       apply (fastforce dest: obj_at_valid_objs'[OF _ invs_valid_objs'] ko_at_valid_ntfn')
+      apply wp
      apply clarsimp
      apply (vcg exspec=isStopped_modifies exspec=lookupCap_modifies)
 
@@ -1383,7 +1374,7 @@ lemma handleYield_ccorres:
        apply (ctac add: rescheduleRequired_ccorres)
       apply (wp weak_sch_act_wf_lift_linear tcbSchedAppend_valid_objs')
      apply (vcg exspec= tcbSchedAppend_modifies)
-    apply (wp weak_sch_act_wf_lift_linear tcbSchedDequeue_valid_queues)
+    apply (wp weak_sch_act_wf_lift_linear)
    apply (vcg exspec= tcbSchedDequeue_modifies)
   apply (clarsimp simp: tcb_at_invs' invs_valid_objs'
                         valid_objs'_maxPriority valid_objs'_maxDomain)
diff --git a/proof/crefine/ARM/TcbAcc_C.thy b/proof/crefine/ARM/TcbAcc_C.thy
index 8b5e2a2234..29de58180a 100644
--- a/proof/crefine/ARM/TcbAcc_C.thy
+++ b/proof/crefine/ARM/TcbAcc_C.thy
@@ -203,6 +203,27 @@ lemma sanitiseRegister_spec:
              split: register.split)
   done
 
+lemma ccorres_pre_getObject_tcb:
+  assumes cc: "\<And>rv. ccorres r xf (P rv) (P' rv) hs (f rv) c"
+  shows   "ccorres r xf
+                  (\<lambda>s. (\<forall>tcb. ko_at' tcb p s \<longrightarrow> P tcb s))
+                  {s. \<forall> tcb tcb'. cslift s (tcb_ptr_to_ctcb_ptr p) = Some tcb' \<and> ctcb_relation tcb tcb'
+                           \<longrightarrow> s \<in> P' tcb}
+                          hs (getObject p >>= (\<lambda>rv :: tcb. f rv)) c"
+  apply (rule ccorres_guard_imp2)
+   apply (rule ccorres_symb_exec_l)
+      apply (rule ccorres_guard_imp2)
+       apply (rule cc)
+      apply (rule conjI)
+       apply (rule_tac Q="ko_at' rv p s" in conjunct1)
+       apply assumption
+      apply assumption
+     apply (wpsimp wp: empty_fail_getObject getTCB_wp)+
+    apply (erule cmap_relationE1[OF cmap_relation_tcb],
+           erule ko_at_projectKO_opt)
+  apply simp
+  done
+
 end
 
 end
diff --git a/proof/crefine/ARM/TcbQueue_C.thy b/proof/crefine/ARM/TcbQueue_C.thy
index e14fa45ae9..6bbacbab10 100644
--- a/proof/crefine/ARM/TcbQueue_C.thy
+++ b/proof/crefine/ARM/TcbQueue_C.thy
@@ -844,49 +844,6 @@ lemma tcb_queue_relation'_prev_mask:
   shows "ptr_val (getPrev tcb) && ~~ mask bits = ptr_val (getPrev tcb)"
   by (rule tcb_queue_relation_prev_mask [OF tcb_queue_relation'_queue_rel], fact+)
 
-
-lemma cready_queues_relation_null_queue_ptrs:
-  assumes rel: "cready_queues_relation mp cq aq"
-  and same: "option_map tcb_null_ep_ptrs \<circ> mp' = option_map tcb_null_ep_ptrs \<circ> mp"
-  shows "cready_queues_relation mp' cq aq"
-  using rel
-  apply (clarsimp simp: cready_queues_relation_def Let_def all_conj_distrib)
-  apply (drule spec, drule spec, drule mp, (erule conjI)+, assumption)
-  apply (clarsimp simp: tcb_queue_relation'_def)
-  apply (erule iffD2 [OF tcb_queue_relation_only_next_prev, rotated -1])
-   apply (rule ext)
-   apply (case_tac "mp' x")
-    apply (frule compD [OF same])
-    apply simp
-   apply (frule compD [OF same])
-   apply (clarsimp simp: tcb_null_ep_ptrs_def)
-   apply (case_tac z, case_tac a)
-   apply simp
-  \<comment> \<open>clag\<close>
-  apply (rule ext)
-  apply (case_tac "mp' x")
-   apply (frule compD [OF same])
-   apply simp
-  apply (frule compD [OF same])
-  apply (clarsimp simp: tcb_null_ep_ptrs_def)
-  apply (case_tac z, case_tac a)
-  apply simp
-  done
-
-lemma cready_queues_relation_not_queue_ptrs:
-  assumes rel: "cready_queues_relation mp cq aq"
-  and same: "option_map tcbSchedNext_C \<circ> mp' = option_map tcbSchedNext_C \<circ> mp"
-  "option_map tcbSchedPrev_C \<circ> mp' = option_map tcbSchedPrev_C \<circ> mp"
-  shows "cready_queues_relation mp' cq aq"
-  using rel
-  apply (clarsimp simp: cready_queues_relation_def tcb_queue_relation'_def Let_def all_conj_distrib)
-  apply (drule spec, drule spec, drule mp, (erule conjI)+, assumption)
-  apply clarsimp
-  apply (erule iffD2 [OF tcb_queue_relation_only_next_prev, rotated -1])
-   apply (rule same)
-  apply (rule same)
-  done
-
 lemma ntfn_ep_disjoint:
   assumes  srs: "sym_refs (state_refs_of' s)"
   and     epat: "ko_at' ep epptr s"
@@ -1054,8 +1011,6 @@ lemma rf_sr_tcb_update_no_queue:
     (tcb_ptr_to_ctcb_ptr thread) ctcb) (t_hrs_' (globals s'));
   tcbEPNext_C ctcb = tcbEPNext_C (the (cslift s' (tcb_ptr_to_ctcb_ptr thread)));
   tcbEPPrev_C ctcb = tcbEPPrev_C (the (cslift s' (tcb_ptr_to_ctcb_ptr thread)));
-  tcbSchedNext_C ctcb = tcbSchedNext_C (the (cslift s' (tcb_ptr_to_ctcb_ptr thread)));
-  tcbSchedPrev_C ctcb = tcbSchedPrev_C (the (cslift s' (tcb_ptr_to_ctcb_ptr thread)));
   (\<forall>x\<in>ran tcb_cte_cases. (\<lambda>(getF, setF). getF tcb' = getF tcb) x);
   ctcb_relation tcb' ctcb
   \<rbrakk>
@@ -1069,31 +1024,22 @@ lemma rf_sr_tcb_update_no_queue:
   apply (clarsimp simp: map_comp_update projectKO_opt_tcb cvariable_relation_upd_const
                         typ_heap_simps')
   apply (intro conjI)
-       subgoal by (clarsimp simp: cmap_relation_def map_comp_update projectKO_opts_defs inj_eq)
-      apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-      apply simp
-      apply (rule cendpoint_relation_upd_tcb_no_queues, assumption+)
-       subgoal by (clarsimp intro!: ext)
-      subgoal by (clarsimp intro!: ext)
+      subgoal by (clarsimp simp: cmap_relation_def map_comp_update projectKO_opts_defs inj_eq)
      apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
      apply simp
-     apply (rule cnotification_relation_upd_tcb_no_queues, assumption+)
+     apply (rule cendpoint_relation_upd_tcb_no_queues, assumption+)
       subgoal by (clarsimp intro!: ext)
      subgoal by (clarsimp intro!: ext)
-    apply (erule cready_queues_relation_not_queue_ptrs)
+    apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+    apply simp
+    apply (rule cnotification_relation_upd_tcb_no_queues, assumption+)
      subgoal by (clarsimp intro!: ext)
     subgoal by (clarsimp intro!: ext)
    subgoal by (simp add: carch_state_relation_def typ_heap_simps')
   by (simp add: cmachine_state_relation_def)
 
-lemma rf_sr_tcb_update_no_queue_helper:
-  "(s, s'\<lparr> globals := globals s' \<lparr> t_hrs_' := t_hrs_' (globals (undefined
-              \<lparr> globals := (undefined \<lparr> t_hrs_' := f (globals s') (t_hrs_' (globals s')) \<rparr>)\<rparr>))\<rparr>\<rparr>) \<in> rf_sr
-          \<Longrightarrow> (s, globals_update (\<lambda>v. t_hrs_'_update (f v) v) s') \<in> rf_sr"
-  by (simp cong: StateSpace.state.fold_congs globals.fold_congs)
-
-lemmas rf_sr_tcb_update_no_queue2
-    = rf_sr_tcb_update_no_queue_helper [OF rf_sr_tcb_update_no_queue, simplified]
+lemmas rf_sr_tcb_update_no_queue2 =
+  rf_sr_obj_update_helper[OF rf_sr_tcb_update_no_queue, simplified]
 
 lemma tcb_queue_relation_not_in_q:
   "ctcb_ptr_to_tcb_ptr x \<notin> set xs \<Longrightarrow>
@@ -1122,31 +1068,24 @@ lemma rf_sr_tcb_update_not_in_queue:
   prefer 2
    apply (auto simp: obj_at'_def ko_wp_at'_def)[1]
   apply (intro conjI)
-       subgoal by (clarsimp simp: cmap_relation_def map_comp_update projectKO_opts_defs inj_eq)
-      apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-      apply clarsimp
-      apply (subgoal_tac "thread \<notin> (fst ` ep_q_refs_of' a)")
-       apply (clarsimp simp: cendpoint_relation_def Let_def split: Structures_H.endpoint.split)
-       subgoal by (intro conjI impI allI, simp_all add: image_def tcb_queue_relation_not_in_q)[1]
-      apply (drule(1) map_to_ko_atI')
-      apply (drule sym_refs_ko_atD', clarsimp+)
-      subgoal by blast
+      subgoal by (clarsimp simp: cmap_relation_def map_comp_update projectKO_opts_defs inj_eq)
      apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
      apply clarsimp
-     apply (subgoal_tac "thread \<notin> (fst ` ntfn_q_refs_of' (ntfnObj a))")
-      apply (clarsimp simp: cnotification_relation_def Let_def
-                     split: ntfn.splits)
-      subgoal by (simp add: image_def tcb_queue_relation_not_in_q)[1]
+     apply (subgoal_tac "thread \<notin> (fst ` ep_q_refs_of' a)")
+      apply (clarsimp simp: cendpoint_relation_def Let_def split: Structures_H.endpoint.split)
+      subgoal by (intro conjI impI allI, simp_all add: image_def tcb_queue_relation_not_in_q)[1]
      apply (drule(1) map_to_ko_atI')
      apply (drule sym_refs_ko_atD', clarsimp+)
      subgoal by blast
-    apply (simp add: cready_queues_relation_def, erule allEI)
-    apply (clarsimp simp: Let_def)
-    apply (subst tcb_queue_relation_not_in_q)
-     apply clarsimp
-     apply (drule valid_queues_obj_at'D, clarsimp)
-     apply (clarsimp simp: obj_at'_def projectKOs inQ_def)
-    subgoal by simp
+    apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+    apply clarsimp
+    apply (subgoal_tac "thread \<notin> (fst ` ntfn_q_refs_of' (ntfnObj a))")
+     apply (clarsimp simp: cnotification_relation_def Let_def
+                    split: ntfn.splits)
+     subgoal by (simp add: image_def tcb_queue_relation_not_in_q)[1]
+    apply (drule(1) map_to_ko_atI')
+    apply (drule sym_refs_ko_atD', clarsimp+)
+    subgoal by blast
    subgoal by (simp add: carch_state_relation_def carch_globals_def
                          typ_heap_simps')
   by (simp add: cmachine_state_relation_def)
diff --git a/proof/crefine/ARM/Tcb_C.thy b/proof/crefine/ARM/Tcb_C.thy
index 091e0f0967..ca08f2af4a 100644
--- a/proof/crefine/ARM/Tcb_C.thy
+++ b/proof/crefine/ARM/Tcb_C.thy
@@ -59,8 +59,6 @@ lemma doMachineOp_sched:
   done
 
 context begin interpretation Arch . (*FIXME: arch_split*)
-crunch queues[wp]: setupReplyMaster "valid_queues"
-  (simp: crunch_simps wp: crunch_wps)
 
 crunch curThread [wp]: restart "\<lambda>s. P (ksCurThread s)"
   (wp: crunch_wps simp: crunch_simps)
@@ -353,9 +351,10 @@ lemma ccorres_abstract_known:
 
 lemma setPriority_ccorres:
   "ccorres dc xfdc
-      (\<lambda>s. tcb_at' t s \<and> Invariants_H.valid_queues s \<and>  ksCurDomain s \<le> maxDomain \<and>
-           valid_queues' s \<and> valid_objs' s \<and> weak_sch_act_wf (ksSchedulerAction s) s \<and> (priority \<le> maxPriority))
-      (UNIV \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr t} \<inter> {s. prio_' s = ucast priority})
+      (\<lambda>s. tcb_at' t s \<and> ksCurDomain s \<le> maxDomain \<and>
+           valid_objs' s \<and> weak_sch_act_wf (ksSchedulerAction s) s \<and> (priority \<le> maxPriority) \<and>
+           pspace_aligned' s \<and> pspace_distinct' s)
+      ({s. tptr_' s = tcb_ptr_to_ctcb_ptr t} \<inter> {s. prio_' s = ucast priority})
       [] (setPriority t priority) (Call setPriority_'proc)"
   apply (cinit lift: tptr_' prio_')
    apply (ctac(no_vcg) add: tcbSchedDequeue_ccorres)
@@ -378,7 +377,7 @@ lemma setPriority_ccorres:
         apply (ctac add: possibleSwitchTo_ccorres)
        apply (rule ccorres_return_Skip')
       apply (wp isRunnable_wp)
-     apply (wpsimp wp: hoare_drop_imps threadSet_valid_queues threadSet_valid_objs'
+     apply (wpsimp wp: hoare_drop_imps threadSet_valid_objs'
                        weak_sch_act_wf_lift_linear threadSet_pred_tcb_at_state
                        threadSet_tcbDomain_triv
                  simp: st_tcb_at'_def o_def split: if_splits)
@@ -387,18 +386,13 @@ lemma setPriority_ccorres:
                  where Q="\<lambda>rv s.
                           obj_at' (\<lambda>_. True) t s \<and>
                           priority \<le> maxPriority \<and>
-                          Invariants_H.valid_queues s \<and>
                           ksCurDomain s \<le> maxDomain \<and>
                           valid_objs' s \<and>
-                          valid_queues' s \<and>
                           weak_sch_act_wf (ksSchedulerAction s) s \<and>
-                          (\<forall>d p. \<not> t \<in> set (ksReadyQueues s (d, p)))"])
-    apply (wp weak_sch_act_wf_lift_linear tcbSchedDequeue_valid_queues tcbSchedDequeue_nonq)
+                          pspace_aligned' s \<and> pspace_distinct' s"])
+    apply (wp weak_sch_act_wf_lift_linear valid_tcb'_def)
    apply (clarsimp simp: valid_tcb'_tcbPriority_update)
   apply clarsimp
-  apply (frule (1) valid_objs'_maxDomain[where t=t])
-  apply (frule (1) valid_objs'_maxPriority[where t=t])
-  apply simp
   done
 
 lemma setMCPriority_ccorres:
@@ -613,12 +607,12 @@ lemma invokeTCB_ThreadControl_ccorres:
                         apply (clarsimp simp: guard_is_UNIV_def Collect_const_mem)
                        apply (rule hoare_strengthen_post[
                                     where Q= "\<lambda>rv s.
-                                              Invariants_H.valid_queues s \<and>
                                               valid_objs' s \<and>
                                               weak_sch_act_wf (ksSchedulerAction s) s \<and>
                                               ((\<exists>a b. priority = Some (a, b)) \<longrightarrow>
                                                    tcb_at' target s \<and> ksCurDomain s \<le> maxDomain \<and>
-                                                   valid_queues' s \<and>  fst (the priority) \<le> maxPriority)"])
+                                                   fst (the priority) \<le> maxPriority) \<and>
+                                              pspace_aligned' s \<and> pspace_distinct' s"])
                         apply (strengthen sch_act_wf_weak)
                         apply (wp hoare_weak_lift_imp)
                        apply (clarsimp split: if_splits)
@@ -703,12 +697,12 @@ lemma invokeTCB_ThreadControl_ccorres:
                apply (clarsimp simp: guard_is_UNIV_def Collect_const_mem)
               apply (simp cong: conj_cong)
               apply (rule hoare_strengthen_post[
-                            where Q="\<lambda>a b. (Invariants_H.valid_queues b \<and>
-                                       valid_objs' b \<and>
+                            where Q="\<lambda>a b. (valid_objs' b \<and>
                                        sch_act_wf (ksSchedulerAction b) b \<and>
+                                       pspace_aligned' b \<and> pspace_distinct' b \<and>
                                        ((\<exists>a b. priority = Some (a, b)) \<longrightarrow>
                                           tcb_at'  target b \<and>
-                                          ksCurDomain b \<le> maxDomain \<and> valid_queues' b \<and>
+                                          ksCurDomain b \<le> maxDomain \<and>
                                           fst (the priority) \<le> maxPriority)) \<and>
                                        ((case snd (the buf)
                                            of None \<Rightarrow> 0
@@ -731,15 +725,15 @@ lemma invokeTCB_ThreadControl_ccorres:
                prefer 2
                apply fastforce
               apply (strengthen cte_is_derived_capMasterCap_strg
-                                invs_queues invs_weak_sch_act_wf invs_sch_act_wf'
+                                invs_weak_sch_act_wf invs_sch_act_wf'
                                 invs_valid_objs' invs_mdb' invs_pspace_aligned',
                             simp add: o_def)
               apply (rule_tac P="is_aligned (fst (the buf)) msg_align_bits"
                        in hoare_gen_asm)
               apply (wp threadSet_ipcbuffer_trivial hoare_weak_lift_imp
                      | simp
-                     | strengthen invs_sch_act_wf' invs_valid_objs' invs_weak_sch_act_wf  invs_queues
-                                  invs_valid_queues' | wp hoare_drop_imps)+
+                     | strengthen invs_sch_act_wf' invs_valid_objs' invs_weak_sch_act_wf
+                     | wp hoare_drop_imps)+
              (* \<not> P *)
              apply (clarsimp simp: guard_is_UNIV_def Collect_const_mem
                                    option_to_0_def
@@ -749,7 +743,7 @@ lemma invokeTCB_ThreadControl_ccorres:
              apply (rule ccorres_return_C_errorE, simp+)[1]
             apply vcg
            apply (simp add: conj_comms cong: conj_cong)
-           apply (strengthen invs_ksCurDomain_maxDomain')
+           apply (strengthen invs_ksCurDomain_maxDomain' invs_pspace_distinct')
            apply (wp hoare_vcg_const_imp_lift_R cteDelete_invs')
           apply simp
           apply (rule ccorres_split_nothrow_novcg_dc)
@@ -766,8 +760,7 @@ lemma invokeTCB_ThreadControl_ccorres:
          apply (rule conjI)
           apply (clarsimp simp: case_option_If2 if_n_0_0 objBits_simps' valid_cap'_def
                                 capAligned_def word_bits_conv obj_at'_def projectKOs)
-         apply (clarsimp simp: invs_valid_objs' invs_valid_queues'
-                               Invariants_H.invs_queues invs_ksCurDomain_maxDomain')
+         apply (fastforce simp: invs_valid_objs' invs_ksCurDomain_maxDomain')
         apply (rule ccorres_Cond_rhs_Seq)
          apply (rule ccorres_rhs_assoc)+
          apply csymbr
@@ -997,7 +990,7 @@ lemma restart_ccorres:
         apply (ctac(no_vcg) add: tcbSchedEnqueue_ccorres)
          apply (ctac add: possibleSwitchTo_ccorres)
         apply (wp weak_sch_act_wf_lift)[1]
-       apply (wp sts_valid_queues setThreadState_st_tcb)[1]
+       apply (wp sts_valid_objs' setThreadState_st_tcb)[1]
       apply (simp add: valid_tcb_state'_def)
       apply wp
       apply (wp (once) sch_act_wf_lift, (wp tcb_in_cur_domain'_lift)+)
@@ -1593,7 +1586,7 @@ lemma invokeTCB_WriteRegisters_ccorres[where S=UNIV]:
   apply (clarsimp simp: frame_gp_registers_convs word_less_nat_alt
                         sysargs_rel_def n_frameRegisters_def n_msgRegisters_def
                   split: if_split_asm)
-  apply (simp add: invs_weak_sch_act_wf invs_valid_objs' invs_queues)
+  apply (simp add: invs_weak_sch_act_wf invs_valid_objs')
   apply (fastforce dest!: global'_no_ex_cap simp: invs'_def valid_state'_def)
   done
 
@@ -3098,7 +3091,8 @@ lemma decodeTCBConfigure_ccorres:
    apply (rule conjI, fastforce)
    apply (drule interpret_excaps_eq)
    apply (clarsimp simp: cte_wp_at_ctes_of valid_tcb_state'_def numeral_eqs le_ucast_ucast_le
-                         tcb_at_invs' invs_valid_objs' invs_queues invs_sch_act_wf'
+                         tcb_at_invs' invs_valid_objs' invs_sch_act_wf'
+                         invs_pspace_aligned' invs_pspace_distinct'
                          ct_in_state'_def pred_tcb_at'_def obj_at'_def tcb_st_refs_of'_def)
    apply (erule disjE; simp add: objBits_defs mask_def)
   apply (clarsimp simp: idButNot_def interpret_excaps_test_null
@@ -4359,9 +4353,9 @@ lemma invokeTCB_SetTLSBase_ccorres:
        apply (rule ccorres_return_CE, simp+)[1]
       apply (wpsimp wp: hoare_drop_imp simp: guard_is_UNIV_def)+
    apply vcg
-  apply (clarsimp simp: tlsBaseRegister_def ARM.tlsBaseRegister_def
-                        invs_weak_sch_act_wf invs_queues TLS_BASE_def TPIDRURW_def
-                 split: if_split)
+  apply (fastforce simp: tlsBaseRegister_def ARM.tlsBaseRegister_def
+                         invs_weak_sch_act_wf TLS_BASE_def TPIDRURW_def
+                  split: if_split)
   done
 
 lemma decodeSetTLSBase_ccorres:
diff --git a/proof/crefine/ARM/Wellformed_C.thy b/proof/crefine/ARM/Wellformed_C.thy
index 4e964d3559..3ff73b7118 100644
--- a/proof/crefine/ARM/Wellformed_C.thy
+++ b/proof/crefine/ARM/Wellformed_C.thy
@@ -139,10 +139,6 @@ where
 abbreviation
   "ep_queue_relation \<equiv> tcb_queue_relation tcbEPNext_C tcbEPPrev_C"
 
-abbreviation
-  "sched_queue_relation \<equiv> tcb_queue_relation tcbSchedNext_C tcbSchedPrev_C"
-
-
 definition
 wordSizeCase :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" where
 "wordSizeCase a b \<equiv> (if bitSize (undefined::word32) = 32
diff --git a/proof/crefine/ARM_HYP/ADT_C.thy b/proof/crefine/ARM_HYP/ADT_C.thy
index 9044dc136f..6a0395b0bf 100644
--- a/proof/crefine/ARM_HYP/ADT_C.thy
+++ b/proof/crefine/ARM_HYP/ADT_C.thy
@@ -114,11 +114,6 @@ lemma setTCBContext_C_corres:
   apply (simp add: map_to_ctes_upd_tcb_no_ctes map_to_tcbs_upd tcb_cte_cases_def
                    cvariable_relation_upd_const ko_at_projectKO_opt)
   apply (simp add: cep_relations_drop_fun_upd)
-  apply (rule conjI)
-   defer
-   apply (erule cready_queues_relation_not_queue_ptrs)
-    apply (rule ext, simp split: if_split)
-   apply (rule ext, simp split: if_split)
   apply (drule ko_at_projectKO_opt)
   apply (erule (2) cmap_relation_upd_relI)
     apply (simp add: ctcb_relation_def carch_tcb_relation_def)
@@ -661,25 +656,50 @@ lemma tcb_queue_rel'_unique:
   apply (erule(2) tcb_queue_rel_unique)
   done
 
-definition
-  cready_queues_to_H
-  :: "(tcb_C ptr \<rightharpoonup> tcb_C) \<Rightarrow> (tcb_queue_C[num_tcb_queues]) \<Rightarrow> word8 \<times> word8 \<Rightarrow> word32 list"
+definition tcb_queue_C_to_tcb_queue :: "tcb_queue_C \<Rightarrow> tcb_queue" where
+  "tcb_queue_C_to_tcb_queue q \<equiv>
+     TcbQueue (if head_C q = NULL then None else Some (ctcb_ptr_to_tcb_ptr (head_C q)))
+              (if end_C q = NULL then None else Some (ctcb_ptr_to_tcb_ptr (end_C q)))"
+
+definition cready_queues_to_H ::
+  "tcb_queue_C[num_tcb_queues] \<Rightarrow> (domain \<times> priority \<Rightarrow> ready_queue)"
   where
-  "cready_queues_to_H h_tcb cs \<equiv> \<lambda>(qdom, prio). if ucast minDom \<le> qdom \<and> qdom \<le> ucast maxDom
-              \<and> ucast seL4_MinPrio \<le> prio \<and> prio \<le> ucast seL4_MaxPrio
-   then THE aq. let cqueue = index cs (cready_queues_index_to_C qdom prio)
-    in sched_queue_relation' h_tcb aq (head_C cqueue) (StateRelation_C.end_C cqueue)
-   else []"
+  "cready_queues_to_H cs \<equiv>
+     \<lambda>(qdom, prio).
+       if qdom \<le> maxDomain \<and> prio \<le> maxPriority
+       then let cqueue = index cs (cready_queues_index_to_C qdom prio)
+             in tcb_queue_C_to_tcb_queue cqueue
+       else TcbQueue None None"
 
 lemma cready_queues_to_H_correct:
-  "cready_queues_relation (clift s) cs as \<Longrightarrow>
-   cready_queues_to_H (clift s) cs = as"
-  apply (clarsimp simp: cready_queues_to_H_def cready_queues_relation_def
-                   fun_eq_iff)
-  apply (rule the_equality)
-   apply simp
-  apply (clarsimp simp: Let_def)
-  apply (rule_tac hp="clift s" in tcb_queue_rel'_unique, simp_all add: lift_t_NULL)
+  "\<lbrakk>cready_queues_relation (ksReadyQueues s) (ksReadyQueues_' ch);
+    no_0_obj' s; ksReadyQueues_asrt s; pspace_aligned' s; pspace_distinct' s\<rbrakk>
+   \<Longrightarrow> cready_queues_to_H (ksReadyQueues_' ch) = ksReadyQueues s"
+  apply (clarsimp simp: cready_queues_to_H_def cready_queues_relation_def Let_def)
+  apply (clarsimp simp: fun_eq_iff)
+  apply (rename_tac d p)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply (clarsimp simp: ready_queue_relation_def ksReadyQueues_asrt_def)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply clarsimp
+  apply (frule (3) obj_at'_tcbQueueHead_ksReadyQueues)
+  apply (frule (3) obj_at'_tcbQueueEnd_ksReadyQueues)
+  apply (frule tcbQueueHead_iff_tcbQueueEnd)
+  apply (rule conjI)
+   apply (clarsimp simp: tcb_queue_C_to_tcb_queue_def ctcb_queue_relation_def option_to_ctcb_ptr_def)
+   apply (case_tac "tcbQueueHead (ksReadyQueues s (d, p)) = None")
+    apply (clarsimp simp: tcb_queue.expand)
+   apply clarsimp
+   apply (rename_tac queue_head queue_end)
+   apply (prop_tac "tcb_at' queue_head s", fastforce simp: tcbQueueEmpty_def obj_at'_def)
+   apply (prop_tac "tcb_at' queue_end s", fastforce simp: tcbQueueEmpty_def obj_at'_def)
+   apply (drule kernel.tcb_at_not_NULL)+
+   apply (fastforce simp: tcb_queue.expand kernel.ctcb_ptr_to_ctcb_ptr)
+  apply (clarsimp simp: tcbQueueEmpty_def ctcb_queue_relation_def option_to_ctcb_ptr_def
+                 split: option.splits;
+         metis tcb_queue.exhaust_sel word_not_le)
   done
 
 (* showing that cpspace_relation is actually unique >>>*)
@@ -816,17 +836,20 @@ lemma cthread_state_rel_imp_eq:
   apply (cases y, simp_all add: ThreadState_defs)+
   done
 
-lemma ksPSpace_valid_objs_tcbBoundNotification_nonzero:
-  "\<exists>s. ksPSpace s = ah \<and> no_0_obj' s \<and> valid_objs' s
-     \<Longrightarrow> map_to_tcbs ah p = Some tcb \<Longrightarrow> tcbBoundNotification tcb \<noteq> Some 0"
+lemma map_to_tcbs_Some_refs_nonzero:
+  "\<lbrakk>map_to_tcbs (ksPSpace s) p = Some tcb; no_0_obj' s; valid_objs' s\<rbrakk>
+   \<Longrightarrow> tcbBoundNotification tcb \<noteq> Some 0
+       \<and> tcbSchedPrev tcb \<noteq> Some 0
+       \<and> tcbSchedNext tcb \<noteq> Some 0"
+  supply word_neq_0_conv[simp del]
   apply (clarsimp simp: map_comp_def split: option.splits)
-  apply (erule(1) valid_objsE')
-  apply (clarsimp simp: projectKOs valid_obj'_def valid_tcb'_def)
+  apply (erule (1) valid_objsE')
+  apply (fastforce simp: projectKOs valid_obj'_def valid_tcb'_def)
   done
 
 lemma ksPSpace_valid_objs_atcbVCPUPtr_nonzero:
-  "\<exists>s. ksPSpace s = ah \<and> no_0_obj' s \<and> valid_objs' s
-     \<Longrightarrow> map_to_tcbs ah p = Some tcb \<Longrightarrow> atcbVCPUPtr (tcbArch tcb) \<noteq> Some 0"
+  "\<lbrakk>no_0_obj' s; valid_objs' s; map_to_tcbs (ksPSpace s) p = Some tcb\<rbrakk>
+   \<Longrightarrow> atcbVCPUPtr (tcbArch tcb) \<noteq> Some 0"
   apply (clarsimp simp: map_comp_def split: option.splits)
   apply (erule(1) valid_objsE')
   apply (clarsimp simp: projectKOs valid_obj'_def valid_tcb'_def valid_arch_tcb'_def)
@@ -851,36 +874,77 @@ lemma carch_tcb_relation_imp_eq:
   apply (case_tac vcpuptr2 ; simp)
   done
 
+lemma tcb_ptr_to_ctcb_ptr_inj:
+  "tcb_ptr_to_ctcb_ptr x = tcb_ptr_to_ctcb_ptr y \<Longrightarrow> x = y"
+  by (auto simp: tcb_ptr_to_ctcb_ptr_def ctcb_offset_def)
+
+lemma
+  assumes "pspace_aligned' as" "pspace_distinct' as" "valid_tcb' atcb as"
+  shows tcb_at'_tcbBoundNotification:
+    "bound (tcbBoundNotification atcb) \<longrightarrow> ntfn_at' (the (tcbBoundNotification atcb)) as"
+  and tcb_at'_tcbSchedPrev:
+    "tcbSchedPrev atcb \<noteq> None \<longrightarrow> tcb_at' (the (tcbSchedPrev atcb)) as"
+  and tcb_at'_tcbSchedNext:
+    "tcbSchedNext atcb \<noteq> None \<longrightarrow> tcb_at' (the (tcbSchedNext atcb)) as"
+  using assms
+  by (clarsimp simp: valid_tcb'_def obj_at'_def)+
+
 lemma cpspace_tcb_relation_unique:
-  assumes tcbs: "cpspace_tcb_relation ah ch" "cpspace_tcb_relation ah' ch"
-      and   vs: "\<exists>s. ksPSpace s = ah \<and> no_0_obj' s \<and> valid_objs' s"
-      and   vs': "\<exists>s. ksPSpace s = ah' \<and> no_0_obj' s \<and> valid_objs' s"
-  assumes ctes: " \<forall>tcb tcb'. (\<exists>p. map_to_tcbs ah p = Some tcb \<and>
-                                  map_to_tcbs ah' p = Some tcb') \<longrightarrow>
-                  (\<forall>x\<in>ran tcb_cte_cases. fst x tcb' = fst x tcb)"
-  shows "map_to_tcbs ah' = map_to_tcbs ah"
+  assumes tcbs: "cpspace_tcb_relation (ksPSpace as) ch" "cpspace_tcb_relation (ksPSpace as') ch"
+  assumes   vs: "no_0_obj' as" "valid_objs' as"
+  assumes  vs': "no_0_obj' as'" "valid_objs' as'"
+  assumes   ad: "pspace_aligned' as" "pspace_distinct' as"
+  assumes  ad': "pspace_aligned' as'" "pspace_distinct' as'"
+  assumes ctes: "\<forall>tcb tcb'. (\<exists>p. map_to_tcbs (ksPSpace as) p = Some tcb \<and>
+                                 map_to_tcbs (ksPSpace as') p = Some tcb') \<longrightarrow>
+                 (\<forall>x\<in>ran tcb_cte_cases. fst x tcb' = fst x tcb)"
+  shows "map_to_tcbs (ksPSpace as') = map_to_tcbs (ksPSpace as)"
   using tcbs(2) tcbs(1)
   apply (clarsimp simp add: cmap_relation_def)
   apply (drule inj_image_inv[OF inj_tcb_ptr_to_ctcb_ptr])+
   apply (simp add: tcb_ptr_to_ctcb_ptr_def[abs_def] ctcb_offset_def)
   apply (rule ext)
-  apply (case_tac "x:dom (map_to_tcbs ah)")
+  apply (case_tac "x \<in> dom (map_to_tcbs (ksPSpace as))")
    apply (drule bspec, assumption)+
    apply (simp add: dom_def Collect_eq, drule_tac x=x in spec)
    apply clarsimp
    apply (rename_tac p x y)
    apply (cut_tac ctes)
    apply (drule_tac x=x in spec, drule_tac x=y in spec, erule impE, fastforce)
-   apply (frule ksPSpace_valid_objs_tcbBoundNotification_nonzero[OF vs])
-   apply (frule ksPSpace_valid_objs_tcbBoundNotification_nonzero[OF vs'])
+   apply (frule map_to_tcbs_Some_refs_nonzero[OF _ vs])
+   apply (frule map_to_tcbs_Some_refs_nonzero[OF _ vs'])
    apply (frule ksPSpace_valid_objs_atcbVCPUPtr_nonzero[OF vs])
    apply (frule ksPSpace_valid_objs_atcbVCPUPtr_nonzero[OF vs'])
+   apply (rename_tac atcb atcb')
+   apply (prop_tac "valid_tcb' atcb as")
+    apply (fastforce intro: vs ad map_to_ko_atI tcb_ko_at_valid_objs_valid_tcb')
+   apply (prop_tac "valid_tcb' atcb' as'")
+    apply (fastforce intro: vs' ad' map_to_ko_atI tcb_ko_at_valid_objs_valid_tcb')
+   apply (frule tcb_at'_tcbSchedPrev[OF ad])
+   apply (frule tcb_at'_tcbSchedPrev[OF ad'])
+   apply (frule tcb_at'_tcbSchedNext[OF ad])
+   apply (frule tcb_at'_tcbSchedNext[OF ad'])
    apply (thin_tac "map_to_tcbs x y = Some z" for x y z)+
-   apply (case_tac x, case_tac y, case_tac "the (clift ch (tcb_Ptr (p+0x100)))")
+   apply (case_tac "the (clift ch (tcb_Ptr (p + 2 ^ ctcb_size_bits)))")
    apply (clarsimp simp: ctcb_relation_def ran_tcb_cte_cases)
-   apply (clarsimp simp: option_to_ptr_def option_to_0_def split: option.splits)
-   apply (auto simp: cfault_rel_imp_eq cthread_state_rel_imp_eq carch_tcb_relation_imp_eq
-                     ccontext_relation_imp_eq up_ucast_inj_eq ctcb_size_bits_def)
+   apply (clarsimp simp: option_to_ctcb_ptr_def option_to_ptr_def option_to_0_def)
+   apply (rule tcb.expand)
+   apply clarsimp
+   apply (intro conjI)
+        apply (simp add: cthread_state_rel_imp_eq)
+       apply (simp add: cfault_rel_imp_eq)
+      apply (case_tac "tcbBoundNotification atcb'", case_tac "tcbBoundNotification atcb"; clarsimp)
+      apply (clarsimp split: option.splits)
+     apply (case_tac "tcbSchedPrev atcb'"; case_tac "tcbSchedPrev atcb"; clarsimp)
+       apply (force dest!: kernel.tcb_at_not_NULL)
+      apply (force dest!: kernel.tcb_at_not_NULL)
+     apply (force simp: tcb_ptr_to_ctcb_ptr_inj)
+    apply (case_tac "tcbSchedNext atcb'"; case_tac "tcbSchedNext atcb"; clarsimp)
+      apply (force dest!: kernel.tcb_at_not_NULL)
+     apply (force dest!: kernel.tcb_at_not_NULL)
+    apply (force simp: tcb_ptr_to_ctcb_ptr_inj)
+   apply (force simp: carch_tcb_relation_imp_eq)
+  apply (force simp: carch_tcb_relation_def )
   done
 
 lemma tcb_queue_rel_clift_unique:
@@ -911,10 +975,6 @@ lemma ksPSpace_valid_pspace_ntfnBoundTCB_nonzero:
   apply (clarsimp simp: projectKOs valid_obj'_def valid_ntfn'_def)
   done
 
-lemma tcb_ptr_to_ctcb_ptr_inj:
-  "tcb_ptr_to_ctcb_ptr x = tcb_ptr_to_ctcb_ptr y \<Longrightarrow> x = y"
-  by (auto simp: tcb_ptr_to_ctcb_ptr_def ctcb_offset_def)
-
 lemma cpspace_ntfn_relation_unique:
   assumes ntfns: "cpspace_ntfn_relation ah ch" "cpspace_ntfn_relation ah' ch"
       and   vs: "\<exists>s. ksPSpace s = ah \<and> valid_pspace' s"
@@ -1258,8 +1318,8 @@ proof -
                        OF valid_objs'_imp_wf_asid_pool'[OF valid_objs]
                           valid_objs'_imp_wf_asid_pool'[OF valid_objs']])
     apply (drule (1) cpspace_tcb_relation_unique)
-       apply (fastforce intro: no_0_objs no_0_objs' valid_objs valid_objs')
-      apply (fastforce intro: no_0_objs no_0_objs' valid_objs valid_objs')
+             apply (fastforce intro: no_0_objs no_0_objs' valid_objs valid_objs'
+                                     aligned aligned' distinct distinct')+
      apply (intro allI impI,elim exE conjE)
      apply (rule_tac p=p in map_to_ctes_tcb_ctes, assumption)
       apply (frule (1) map_to_ko_atI[OF _ aligned distinct])
@@ -1478,7 +1538,7 @@ where
     ksDomSchedule = cDomSchedule_to_H kernel_all_global_addresses.ksDomSchedule,
     ksCurDomain = ucast (ksCurDomain_' s),
     ksDomainTime = ksDomainTime_' s,
-    ksReadyQueues = cready_queues_to_H (clift (t_hrs_' s)) (ksReadyQueues_' s),
+    ksReadyQueues = cready_queues_to_H (ksReadyQueues_' s),
     ksReadyQueuesL1Bitmap = cbitmap_L1_to_H (ksReadyQueuesL1Bitmap_' s),
     ksReadyQueuesL2Bitmap = cbitmap_L2_to_H (ksReadyQueuesL2Bitmap_' s),
     ksCurThread = ctcb_ptr_to_tcb_ptr (ksCurThread_' s),
@@ -1497,16 +1557,16 @@ lemma trivial_eq_conj: "B = C \<Longrightarrow> (A \<and> B) = (A \<and> C)"
 lemma (in kernel_m) cstate_to_H_correct:
   assumes valid: "valid_state' as"
   assumes cstate_rel: "cstate_relation as cs"
+  assumes rdyqs: "ksReadyQueues_asrt as"
   shows "cstate_to_H cs = as \<lparr>ksMachineState:=  observable_memory (ksMachineState as) (user_mem' as)\<rparr>"
   apply (subgoal_tac "cstate_to_machine_H cs = observable_memory (ksMachineState as) (user_mem' as)")
    apply (rule kernel_state.equality, simp_all add: cstate_to_H_def)
-                      apply (rule cstate_to_pspace_H_correct)
+                    apply (rule cstate_to_pspace_H_correct)
                      using valid
                      apply (simp add: valid_state'_def)
                     using cstate_rel valid
                     apply (clarsimp simp: cstate_relation_def cpspace_relation_def Let_def
-                      observable_memory_def valid_state'_def
-                      valid_pspace'_def)
+                                          observable_memory_def valid_state'_def valid_pspace'_def)
                    using cstate_rel
                    apply (clarsimp simp: cstate_relation_def cpspace_relation_def Let_def prod_eq_iff)
                   using cstate_rel
@@ -1530,8 +1590,13 @@ lemma (in kernel_m) cstate_to_H_correct:
             using cstate_rel
             apply (clarsimp simp: cstate_relation_def Let_def)
            apply (rule cready_queues_to_H_correct)
-           using cstate_rel
-           apply (clarsimp simp: cstate_relation_def Let_def)
+               using cstate_rel rdyqs
+               apply (fastforce intro!: cready_queues_to_H_correct
+                                  simp: cstate_relation_def Let_def)
+              using valid apply (fastforce simp: valid_state'_def)
+             using rdyqs apply fastforce
+            using valid apply (fastforce simp: valid_state'_def)
+           using valid apply (fastforce simp: valid_state'_def)
           using cstate_rel
           apply (clarsimp simp: cstate_relation_def Let_def)
           using cstate_rel
diff --git a/proof/crefine/ARM_HYP/ArchMove_C.thy b/proof/crefine/ARM_HYP/ArchMove_C.thy
index 573715c6f8..0211f89ddf 100644
--- a/proof/crefine/ARM_HYP/ArchMove_C.thy
+++ b/proof/crefine/ARM_HYP/ArchMove_C.thy
@@ -408,12 +408,6 @@ lemma ko_at'_tcb_vcpu_not_NULL:
   by (fastforce simp: valid_tcb'_def valid_arch_tcb'_def word_gt_0 typ_at'_no_0_objD
                 dest: valid_objs_valid_tcb')
 
-
-(* FIXME move *)
-lemma setVMRoot_valid_queues':
-  "\<lbrace> valid_queues' \<rbrace> setVMRoot a \<lbrace> \<lambda>_. valid_queues' \<rbrace>"
-  by (rule valid_queues_lift'; wp)
-
 lemma vcpuEnable_valid_pspace' [wp]:
   "\<lbrace> valid_pspace' \<rbrace> vcpuEnable a \<lbrace>\<lambda>_. valid_pspace' \<rbrace>"
   by (wpsimp simp: valid_pspace'_def valid_mdb'_def)
@@ -443,8 +437,6 @@ crunch ko_at'2[wp]: doMachineOp "\<lambda>s. P (ko_at' p t s)"
 crunch pred_tcb_at'2[wp]: doMachineOp "\<lambda>s. P (pred_tcb_at' a b p s)"
   (simp: crunch_simps)
 
-crunch valid_queues'[wp]: readVCPUReg "\<lambda>s. valid_queues s"
-
 crunch valid_objs'[wp]: readVCPUReg "\<lambda>s. valid_objs' s"
 
 crunch sch_act_wf'[wp]: readVCPUReg "\<lambda>s. P (sch_act_wf (ksSchedulerAction s) s)"
diff --git a/proof/crefine/ARM_HYP/Arch_C.thy b/proof/crefine/ARM_HYP/Arch_C.thy
index c792bc031a..7eceede15b 100644
--- a/proof/crefine/ARM_HYP/Arch_C.thy
+++ b/proof/crefine/ARM_HYP/Arch_C.thy
@@ -2230,7 +2230,7 @@ lemma performPageGetAddress_ccorres:
    apply clarsimp
    apply (rule conseqPre, vcg)
    apply clarsimp
-  apply (clarsimp simp: invs_no_0_obj' tcb_at_invs' invs_queues invs_valid_objs' invs_sch_act_wf'
+  apply (clarsimp simp: invs_no_0_obj' tcb_at_invs' invs_valid_objs' invs_sch_act_wf'
                         rf_sr_ksCurThread msgRegisters_unfold
                         seL4_MessageInfo_lift_def message_info_to_H_def mask_def)
   apply (cases isCall)
@@ -3503,8 +3503,8 @@ lemma decodeARMPageDirectoryInvocation_ccorres:
                 st' \<noteq> Structures_H.thread_state.Inactive \<and> st' \<noteq> Structures_H.thread_state.IdleThreadState)
                 thread and (\<lambda>s. thread \<noteq> ksIdleThread s
                    \<and> (obj_at' tcbQueued thread s \<longrightarrow> st_tcb_at' runnable' thread s))"]])
-            apply (clarsimp simp: invs_valid_objs' invs_sch_act_wf'
-              valid_tcb_state'_def invs_queues)
+            apply (clarsimp simp: invs_valid_objs' invs_sch_act_wf' invs_pspace_distinct'
+                                  invs_pspace_aligned' valid_tcb_state'_def)
 
            \<comment> \<open>cache flush constraints\<close>
            subgoal for _ _ _ _ _ _ sz p
@@ -4233,9 +4233,12 @@ lemma decodeARMMMUInvocation_ccorres:
     apply (clarsimp simp: ex_cte_cap_wp_to'_def cte_wp_at_ctes_of
                           invs_sch_act_wf' dest!: isCapDs(1))
     apply (intro conjI)
-            apply (simp add: Invariants_H.invs_queues)
-           apply (simp add: valid_tcb_state'_def)
-          apply (fastforce elim!: pred_tcb'_weakenE dest!:st_tcb_at_idle_thread')
+             apply (simp add: valid_tcb_state'_def)
+            apply (fastforce elim!: pred_tcb'_weakenE dest!:st_tcb_at_idle_thread')
+           apply fastforce
+          apply (clarsimp simp: st_tcb_at'_def obj_at'_def)
+          apply (rename_tac obj)
+          apply (case_tac "tcbState obj", (simp add: runnable'_def)+)[1]
          apply (clarsimp simp: st_tcb_at'_def obj_at'_def)
          apply (rename_tac obj)
          apply (case_tac "tcbState obj", (simp add: runnable'_def)+)[1]
@@ -4421,6 +4424,9 @@ lemma readVCPUReg_ccorres:
   apply fastforce
   done
 
+crunches readVCPUReg
+  for pspace_aligned'[wp]: pspace_aligned'
+  and pspace_distinct'[wp]: pspace_distinct'
 
 lemma invokeVCPUReadReg_ccorres: (* styled after invokeTCB_ReadRegisters_ccorres *)
   notes Collect_const[simp del]
@@ -4509,7 +4515,8 @@ lemma invokeVCPUReadReg_ccorres: (* styled after invokeTCB_ReadRegisters_ccorres
    apply clarsimp
    apply (rule conseqPre, vcg)
    apply clarsimp
-  apply (clarsimp simp: invs_no_0_obj' tcb_at_invs' invs_queues invs_valid_objs' invs_sch_act_wf'
+  apply (clarsimp simp: invs_no_0_obj' tcb_at_invs' invs_valid_objs' invs_sch_act_wf'
+                        invs_pspace_aligned' invs_pspace_distinct'
                         rf_sr_ksCurThread msgRegisters_unfold ThreadState_defs
                         seL4_MessageInfo_lift_def message_info_to_H_def mask_def)
   apply (cases isCall; clarsimp)
@@ -4603,7 +4610,7 @@ lemma decodeVCPUWriteReg_ccorres:
    apply (vcg exspec=getSyscallArg_modifies)
 
   apply (clarsimp simp: word_less_nat_alt word_le_nat_alt conj_commute
-                        invs_no_0_obj' tcb_at_invs' invs_queues invs_valid_objs' invs_sch_act_wf'
+                        invs_no_0_obj' tcb_at_invs' invs_valid_objs' invs_sch_act_wf'
                         rf_sr_ksCurThread msgRegisters_unfold
                         valid_tcb_state'_def ThreadState_defs mask_def)
   apply (rule conjI; clarsimp) \<comment> \<open>not enough args\<close>
@@ -4846,7 +4853,7 @@ lemma decodeVCPUInjectIRQ_ccorres:
   apply (vcg exspec=getSyscallArg_modifies)
 
   apply (clarsimp simp: word_less_nat_alt word_le_nat_alt conj_commute
-                        invs_no_0_obj' tcb_at_invs' invs_queues invs_valid_objs' invs_sch_act_wf'
+                        invs_no_0_obj' tcb_at_invs' invs_valid_objs' invs_sch_act_wf'
                         rf_sr_ksCurThread msgRegisters_unfold
                         valid_tcb_state'_def ThreadState_defs mask_def)
 
@@ -4953,7 +4960,7 @@ lemma decodeVCPUReadReg_ccorres:
    apply (vcg exspec=getSyscallArg_modifies)
 
   apply (clarsimp simp: word_le_nat_alt conj_commute
-                        invs_no_0_obj' tcb_at_invs' invs_queues invs_valid_objs' invs_sch_act_wf'
+                        invs_no_0_obj' tcb_at_invs' invs_valid_objs' invs_sch_act_wf'
                         rf_sr_ksCurThread msgRegisters_unfold
                         valid_tcb_state'_def ThreadState_defs mask_def)
 
@@ -5057,7 +5064,8 @@ lemma decodeVCPUSetTCB_ccorres:
    apply vcg
 
   apply (clarsimp simp: word_less_nat_alt word_le_nat_alt conj_commute
-                        invs_no_0_obj' tcb_at_invs' invs_queues invs_valid_objs' invs_sch_act_wf'
+                        invs_no_0_obj' tcb_at_invs' invs_valid_objs' invs_sch_act_wf'
+                        invs_pspace_aligned' invs_pspace_distinct'
                         rf_sr_ksCurThread msgRegisters_unfold
                         valid_tcb_state'_def ThreadState_defs mask_def)
   apply (clarsimp simp: idButNot_def interpret_excaps_test_null
@@ -5208,7 +5216,7 @@ proof -
      (* Haskell side *)
      apply (clarsimp simp: excaps_in_mem_def slotcap_in_mem_def isCap_simps ctes_of_cte_at)
      apply (clarsimp simp: word_le_nat_alt conj_commute
-                           invs_no_0_obj' tcb_at_invs' invs_queues invs_valid_objs' invs_sch_act_wf'
+                           invs_no_0_obj' tcb_at_invs' invs_valid_objs' invs_sch_act_wf'
                            rf_sr_ksCurThread msgRegisters_unfold
                            valid_tcb_state'_def mask_def
                            valid_cap'_def ct_in_state'_def sysargs_rel_to_n st_tcb_at'_def comp_def
@@ -5216,7 +5224,7 @@ proof -
      apply (fastforce elim: obj_at'_weakenE)
     (* C side *)
     apply (clarsimp simp: word_le_nat_alt conj_commute
-                          invs_no_0_obj' tcb_at_invs' invs_queues invs_valid_objs' invs_sch_act_wf'
+                          invs_no_0_obj' tcb_at_invs' invs_valid_objs' invs_sch_act_wf'
                           rf_sr_ksCurThread msgRegisters_unfold
                           valid_tcb_state'_def ThreadState_defs Kernel_C.maxIRQ_def
                           and_mask_eq_iff_le_mask capVCPUPtr_eq)
diff --git a/proof/crefine/ARM_HYP/Detype_C.thy b/proof/crefine/ARM_HYP/Detype_C.thy
index 1d6349e303..a2634411f7 100644
--- a/proof/crefine/ARM_HYP/Detype_C.thy
+++ b/proof/crefine/ARM_HYP/Detype_C.thy
@@ -1675,35 +1675,11 @@ proof -
     done
 
   moreover
-  from invs have "valid_queues s" ..
-  hence "\<And>p. \<forall>t \<in> set (ksReadyQueues s p). tcb_at' t s \<and> ko_wp_at' live' t s"
-    apply (clarsimp simp: valid_queues_def valid_queues_no_bitmap_def)
-    apply (drule spec, drule spec)
-    apply clarsimp
-    apply (drule (1) bspec)
-    apply (rule conjI)
-    apply (erule obj_at'_weakenE)
-    apply simp
-    apply (simp add: obj_at'_real_def)
-    apply (erule ko_wp_at'_weakenE)
-    apply (clarsimp simp: live'_def projectKOs inQ_def)
-    done
-  hence tat: "\<And>p. \<forall>t \<in> set (ksReadyQueues s p). tcb_at' t s"
-    and  tlive: "\<And>p. \<forall>t \<in> set (ksReadyQueues s p). ko_wp_at' live' t s"
-    by auto
   from sr have
-    "cready_queues_relation (clift ?th_s)
-        (ksReadyQueues_' (globals s')) (ksReadyQueues s)"
+    "cready_queues_relation (ksReadyQueues s) (ksReadyQueues_' (globals s'))"
     unfolding cready_queues_relation_def rf_sr_def cstate_relation_def
               cpspace_relation_def
     apply (clarsimp simp: Let_def all_conj_distrib)
-    apply (drule spec, drule spec, drule mp)
-    apply fastforce
-    apply ((subst lift_t_typ_region_bytes, rule cm_disj_tcb, assumption+,
-      simp_all add: objBits_simps archObjSize_def pageBits_def projectKOs)[1])+
-      \<comment> \<open>waiting ...\<close>
-    apply (simp add: tcb_queue_relation_live_restrict
-                     [OF D.valid_untyped tat tlive rl])
     done
 
   moreover
diff --git a/proof/crefine/ARM_HYP/Fastpath_C.thy b/proof/crefine/ARM_HYP/Fastpath_C.thy
index 117979ae1a..546ec82a90 100644
--- a/proof/crefine/ARM_HYP/Fastpath_C.thy
+++ b/proof/crefine/ARM_HYP/Fastpath_C.thy
@@ -39,11 +39,10 @@ lemma getEndpoint_obj_at':
 lemmas setEndpoint_obj_at_tcb' = setEndpoint_obj_at'_tcb
 
 lemma tcbSchedEnqueue_tcbContext[wp]:
-  "\<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>
-     tcbSchedEnqueue t'
-   \<lbrace>\<lambda>rv. obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
-  apply (rule tcbSchedEnqueue_obj_at_unchangedT[OF all_tcbI])
-  apply simp
+  "tcbSchedEnqueue t' \<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
+  apply (simp add: tcbSchedEnqueue_def tcbQueuePrepend_def unless_when)
+  apply (wp threadSet_obj_at' hoare_drop_imps threadGet_wp
+         | simp split: if_split)+
   done
 
 lemma setCTE_tcbContext:
@@ -55,20 +54,16 @@ lemma setCTE_tcbContext:
   done
 
 lemma setThreadState_tcbContext:
- "\<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>
-    setThreadState a b
-  \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
-  apply (rule setThreadState_obj_at_unchanged)
-  apply (clarsimp simp: atcbContext_def)+
-  done
+ "setThreadState a b \<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
+  unfolding setThreadState_def rescheduleRequired_def tcbSchedEnqueue_def
+            tcbQueuePrepend_def rescheduleRequired_def
+  by (wp threadSet_obj_at' hoare_drop_imps threadGet_wp | wpc
+         | simp split: if_split)+
 
 lemma setBoundNotification_tcbContext:
- "\<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>
-    setBoundNotification a b
-  \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
-  apply (rule setBoundNotification_obj_at_unchanged)
-  apply (clarsimp simp: atcbContext_def)+
-  done
+ "setBoundNotification a b \<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
+  unfolding setBoundNotification_def
+  by wpsimp
 
 declare comp_apply [simp del]
 crunch tcbContext[wp]: deleteCallerCap "obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t"
@@ -626,14 +621,15 @@ lemmas stored_hw_asid_get_ccorres_split
 
 lemma dmo_clearExMonitor_setCurThread_swap:
   "(do _ \<leftarrow> doMachineOp ARM_HYP.clearExMonitor;
-               setCurThread thread
-            od)
+       setCurThread thread
+    od)
     = (do _ \<leftarrow> setCurThread thread;
-            doMachineOp ARM_HYP.clearExMonitor od)"
-  apply (simp add: setCurThread_def doMachineOp_def split_def)
-  apply (rule oblivious_modify_swap[symmetric])
-  apply (intro oblivious_bind,
-         simp_all add: select_f_oblivious)
+          doMachineOp ARM_HYP.clearExMonitor
+       od)"
+  apply (clarsimp simp: ARM_HYP.clearExMonitor_def)
+  apply (simp add: doMachineOp_modify)
+  apply (rule oblivious_modify_swap)
+  apply (fastforce intro: oblivious_bind simp: setCurThread_def idleThreadNotQueued_def)
   done
 
 lemma pd_at_asid_inj':
@@ -771,15 +767,17 @@ lemma switchToThread_fp_ccorres:
          apply (simp add: storeWordUser_def bind_assoc case_option_If2 split_def del: Collect_const)
          apply (simp only: dmo_clearExMonitor_setCurThread_swap)
          apply (rule ccorres_split_nothrow_novcg_dc)
+            apply (clarsimp simp: setCurThread_def)
+            apply (rule ccorres_stateAssert)
             apply (rule ccorres_from_vcg[where P=\<top> and P'=UNIV])
             apply (rule allI, rule conseqPre, vcg)
             apply (clarsimp simp del: rf_sr_upd_safe)
-            apply (clarsimp simp: setCurThread_def simpler_modify_def rf_sr_def cstate_relation_def
+            apply (clarsimp simp: simpler_modify_def rf_sr_def cstate_relation_def
                                   Let_def carch_state_relation_def cmachine_state_relation_def)
            apply (ctac add: clearExMonitor_fp_ccorres)
           apply wp
          apply (simp add: guard_is_UNIV_def)
-        apply (wpsimp wp: dmo_contextSwitch_HWASID_atcbVCPUPtr_cases_helper hoare_vcg_all_lift
+        apply (wpsimp wp: hoare_drop_imps dmo_contextSwitch_HWASID_atcbVCPUPtr_cases_helper hoare_vcg_all_lift
                           hoare_vcg_imp_lift)
        apply (rule conseqPre, vcg, simp, rule subset_refl)
       apply (rule conseqPre, vcg, clarsimp)
@@ -1245,8 +1243,8 @@ lemma fastpath_dequeue_ccorres:
   apply (rule conjI)
    apply (clarsimp simp: cpspace_relation_def update_ep_map_tos
                          update_tcb_map_tos typ_heap_simps')
-   apply (rule conjI, erule ctcb_relation_null_queue_ptrs)
-    apply (rule ext, simp add: tcb_null_queue_ptrs_def
+   apply (rule conjI, erule ctcb_relation_null_ep_ptrs)
+    apply (rule ext, simp add: tcb_null_ep_ptrs_def
                         split: if_split)
    apply (rule conjI)
     apply (rule cpspace_relation_ep_update_ep, assumption+)
@@ -1262,8 +1260,6 @@ lemma fastpath_dequeue_ccorres:
   apply (simp add: carch_state_relation_def typ_heap_simps'
                    cmachine_state_relation_def h_t_valid_clift_Some_iff
                    update_ep_map_tos)
-  apply (erule cready_queues_relation_null_queue_ptrs)
-  apply (rule ext, simp add: tcb_null_ep_ptrs_def split: if_split)
   done
 
 lemma st_tcb_at_not_in_ep_queue:
@@ -1401,8 +1397,8 @@ lemma fastpath_enqueue_ccorres:
    apply (rule conjI)
     apply (clarsimp simp: cpspace_relation_def update_ep_map_tos
                           typ_heap_simps')
-    apply (rule conjI, erule ctcb_relation_null_queue_ptrs)
-     apply (rule ext, simp add: tcb_null_queue_ptrs_def
+    apply (rule conjI, erule ctcb_relation_null_ep_ptrs)
+     apply (rule ext, simp add: tcb_null_ep_ptrs_def
                          split: if_split)
     apply (rule conjI)
      apply (rule_tac S="tcb_ptr_to_ctcb_ptr ` set (ksCurThread \<sigma> # list)"
@@ -1441,8 +1437,6 @@ lemma fastpath_enqueue_ccorres:
            auto dest!: map_to_ko_atI)[1]
    apply (simp add: carch_state_relation_def typ_heap_simps' update_ep_map_tos
                     cmachine_state_relation_def h_t_valid_clift_Some_iff)
-   apply (erule cready_queues_relation_null_queue_ptrs)
-   apply (rule ext, simp add: tcb_null_ep_ptrs_def split: if_split)
   apply (clarsimp simp: typ_heap_simps' EPState_Recv_def mask_def
                         is_aligned_weaken[OF is_aligned_tcb_ptr_to_ctcb_ptr])
   apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def)
@@ -1450,8 +1444,8 @@ lemma fastpath_enqueue_ccorres:
   apply (rule conjI)
    apply (clarsimp simp: cpspace_relation_def update_ep_map_tos
                          typ_heap_simps' ct_in_state'_def)
-   apply (rule conjI, erule ctcb_relation_null_queue_ptrs)
-    apply (rule ext, simp add: tcb_null_queue_ptrs_def
+   apply (rule conjI, erule ctcb_relation_null_ep_ptrs)
+    apply (rule ext, simp add: tcb_null_ep_ptrs_def
                         split: if_split)
    apply (rule conjI)
     apply (rule_tac S="{tcb_ptr_to_ctcb_ptr (ksCurThread \<sigma>)}"
@@ -1471,8 +1465,6 @@ lemma fastpath_enqueue_ccorres:
           assumption+, auto dest!: map_to_ko_atI)[1]
   apply (simp add: carch_state_relation_def typ_heap_simps' update_ep_map_tos
                    cmachine_state_relation_def h_t_valid_clift_Some_iff)
-  apply (erule cready_queues_relation_null_queue_ptrs)
-  apply (rule ext, simp add: tcb_null_ep_ptrs_def split: if_split)
   done
 
 lemma setCTE_rf_sr:
@@ -2105,9 +2097,6 @@ proof -
                            apply (erule cmap_relation_updI, erule ko_at_projectKO_opt)
                             apply (simp add: ctcb_relation_def cthread_state_relation_def)
                            apply simp
-                          apply (rule conjI, erule cready_queues_relation_not_queue_ptrs)
-                            apply (rule ext, simp split: if_split add: typ_heap_simps')
-                           apply (rule ext, simp split: if_split add: typ_heap_simps')
                           apply (simp add: carch_state_relation_def cmachine_state_relation_def
                                            typ_heap_simps' map_comp_update projectKO_opt_tcb
                                            cvariable_relation_upd_const ko_at_projectKO_opt)
@@ -2232,9 +2221,6 @@ proof -
                                        apply (erule cmap_relation_updI, erule ko_at_projectKO_opt)
                                         apply (simp add: ctcb_relation_def cthread_state_relation_def)
                                        apply simp
-                                      apply (rule conjI, erule cready_queues_relation_not_queue_ptrs)
-                                        apply (rule ext, simp split: if_split)
-                                       apply (rule ext, simp split: if_split)
                                       apply (simp add: carch_state_relation_def cmachine_state_relation_def
                                                        typ_heap_simps' map_comp_update projectKO_opt_tcb
                                                        cvariable_relation_upd_const ko_at_projectKO_opt)
@@ -2424,7 +2410,7 @@ proof -
    apply (rule conjI) (* isReceive on queued tcb state *)
     apply (fastforce simp: st_tcb_at_tcbs_of isBlockedOnReceive_def isReceive_def)
    apply clarsimp
-   apply (rule conjI, fastforce dest!: invs_queues simp: valid_queues_def)
+   apply (rule conjI, fastforce dest!: simp: valid_queues_def)
    apply (frule invs_mdb', clarsimp simp: valid_mdb'_def valid_mdb_ctes_def)
    apply (case_tac xb, clarsimp, drule(1) nullcapsD')
    apply (clarsimp simp: pde_stored_asid_def to_bool_def
@@ -2913,9 +2899,6 @@ lemma fastpath_reply_recv_ccorres:
                                            ThreadState_defs)
                           apply (clarsimp simp: ccap_relation_ep_helpers)
                          apply simp
-                        apply (rule conjI, erule cready_queues_relation_not_queue_ptrs)
-                          apply (rule ext, simp split: if_split)
-                         apply (rule ext, simp split: if_split)
                         apply (simp add: carch_state_relation_def cmachine_state_relation_def
                                          typ_heap_simps' map_comp_update projectKO_opt_tcb
                                          cvariable_relation_upd_const ko_at_projectKO_opt)
@@ -2992,9 +2975,6 @@ lemma fastpath_reply_recv_ccorres:
                                      apply (erule cmap_relation_updI, erule ko_at_projectKO_opt)
                                       apply (simp add: ctcb_relation_def cthread_state_relation_def)
                                      apply simp
-                                    apply (rule conjI, erule cready_queues_relation_not_queue_ptrs)
-                                      apply (rule ext, simp split: if_split)
-                                     apply (rule ext, simp split: if_split)
                                     apply (simp add: carch_state_relation_def cmachine_state_relation_def
                                                      typ_heap_simps' map_comp_update projectKO_opt_tcb
                                                      cvariable_relation_upd_const ko_at_projectKO_opt)
@@ -3115,8 +3095,6 @@ lemma fastpath_reply_recv_ccorres:
      apply (clarsimp simp: ct_in_state'_def obj_at_tcbs_of word_sle_def)
      apply (clarsimp simp add: invs_ksCurDomain_maxDomain')
      apply (rule conjI, fastforce)
-     apply (frule invs_queues)
-     apply (simp add: valid_queues_def)
      apply (frule tcbs_of_aligned')
       apply (simp add:invs_pspace_aligned')
      apply (frule tcbs_of_cte_wp_at_caller)
@@ -3146,6 +3124,11 @@ lemma fastpath_reply_recv_ccorres:
                            invs_valid_pde_mappings' obj_at_tcbs_of
                     dest!: isValidVTableRootD)
      apply (frule invs_mdb')
+     apply (frule invs_valid_objs')
+     apply (frule invs_valid_bitmaps)
+     apply (frule valid_bitmaps_bitmapQ_no_L1_orphans)
+     apply (frule invs_pspace_aligned')
+     apply (frule invs_pspace_distinct')
 
      apply (clarsimp simp: cte_wp_at_ctes_of tcbSlots cte_level_bits_def
                            makeObject_cte isValidVTableRoot_def
@@ -3153,10 +3136,10 @@ lemma fastpath_reply_recv_ccorres:
                            pde_stored_asid_def to_bool_def
                            valid_mdb'_def valid_tcb_state'_def
                            word_le_nat_alt[symmetric] length_msgRegisters)
-     apply (frule ko_at_valid_ep', fastforce)
      apply (rule conjI)
-      subgoal (* dest thread domain \<le> maxDomain *)
-       by (drule (1) tcbs_of_valid_tcb'[OF invs_valid_objs'], solves \<open>clarsimp simp: valid_tcb'_def\<close>)
+      apply (fastforce dest: tcbs_of_valid_tcb' simp: valid_tcb'_def opt_map_def
+                      split: option.splits)
+     apply (frule ko_at_valid_ep', fastforce)
      apply clarsimp
      apply (safe del: notI disjE)[1]
        apply (simp add: isSendEP_def valid_ep'_def tcb_at_invs'
diff --git a/proof/crefine/ARM_HYP/Fastpath_Equiv.thy b/proof/crefine/ARM_HYP/Fastpath_Equiv.thy
index 826695fab6..c42fcbc9fc 100644
--- a/proof/crefine/ARM_HYP/Fastpath_Equiv.thy
+++ b/proof/crefine/ARM_HYP/Fastpath_Equiv.thy
@@ -31,13 +31,9 @@ lemma getEndpoint_obj_at':
 
 lemmas setEndpoint_obj_at_tcb' = setEndpoint_obj_at'_tcb
 
-lemma tcbSchedEnqueue_tcbContext[wp]:
-  "\<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>
-     tcbSchedEnqueue t'
-   \<lbrace>\<lambda>rv. obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
-  apply (rule tcbSchedEnqueue_obj_at_unchangedT[OF all_tcbI])
-  apply simp
-  done
+crunches tcbSchedEnqueue
+  for tcbContext[wp]: "obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t"
+  (simp: tcbQueuePrepend_def)
 
 lemma setCTE_tcbContext:
   "\<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>
@@ -50,19 +46,17 @@ lemma setCTE_tcbContext:
 context begin interpretation Arch . (*FIXME: arch_split*)
 
 lemma setThreadState_tcbContext:
- "\<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>
-    setThreadState a b
-  \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
-  apply (rule setThreadState_obj_at_unchanged)
-  apply (clarsimp simp: atcbContext_def)+
+ "setThreadState st tptr \<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
+  unfolding setThreadState_def rescheduleRequired_def
+  apply (wpsimp wp: threadSet_wp hoare_drop_imps)
+  apply (fastforce simp: obj_at'_def objBits_simps projectKOs  atcbContext_def ps_clear_upd)
   done
 
 lemma setBoundNotification_tcbContext:
- "\<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>
-    setBoundNotification a b
-  \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
-  apply (rule setBoundNotification_obj_at_unchanged)
-  apply (clarsimp simp: atcbContext_def)+
+ "setBoundNotification ntfnPtr tptr \<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
+  unfolding setBoundNotification_def
+  apply (wpsimp wp: threadSet_wp hoare_drop_imps)
+  apply (fastforce simp: obj_at'_def objBits_simps projectKOs)
   done
 
 declare comp_apply [simp del]
@@ -127,13 +121,15 @@ lemma of_bl_from_bool:
 
 lemma dmo_clearExMonitor_setCurThread_swap:
   "(do _ \<leftarrow> doMachineOp ARM_HYP.clearExMonitor;
-               setCurThread thread
-            od)
+       setCurThread thread
+    od)
     = (do _ \<leftarrow> setCurThread thread;
-            doMachineOp ARM_HYP.clearExMonitor od)"
-  apply (simp add: setCurThread_def doMachineOp_def split_def)
-  apply (rule oblivious_modify_swap[symmetric])
-  apply (intro oblivious_bind, simp_all)
+          doMachineOp ARM_HYP.clearExMonitor
+       od)"
+  apply (clarsimp simp: ARM_HYP.clearExMonitor_def)
+  apply (simp add: doMachineOp_modify)
+  apply (rule oblivious_modify_swap)
+  apply (fastforce intro: oblivious_bind simp: setCurThread_def idleThreadNotQueued_def)
   done
 
 lemma pd_at_asid_inj':
@@ -508,11 +504,39 @@ lemma setThreadState_runnable_bitmap_inv:
 crunches curDomain
   for (no_fail) no_fail[intro!, wp, simp]
 
+lemma setThreadState_tcbDomain_tcbPriority_obj_at'[wp]:
+  "setThreadState ts t \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb) (tcbPriority tcb)) t'\<rbrace>"
+  unfolding setThreadState_def rescheduleRequired_def tcbSchedEnqueue_def tcbQueuePrepend_def
+  apply (wpsimp wp: threadSet_wp hoare_drop_imps threadGet_wp simp: setQueue_def bitmap_fun_defs)
+  apply (fastforce simp: obj_at'_def st_tcb_at'_def objBits_simps projectKOs)
+  done
+
+lemma setThreadState_tcbQueued_obj_at'[wp]:
+  "setThreadState ts t \<lbrace>obj_at' (\<lambda>tcb. P (tcbQueued tcb)) t'\<rbrace>"
+  unfolding setThreadState_def rescheduleRequired_def tcbSchedEnqueue_def tcbQueuePrepend_def
+  apply (wpsimp wp: threadSet_wp hoare_drop_imps threadGet_wp simp: setQueue_def bitmap_fun_defs)
+  apply (fastforce simp: obj_at'_def st_tcb_at'_def objBits_simps projectKOs)
+  done
+
+lemma setThreadState_tcbFault_obj_at'[wp]:
+  "setThreadState ts t \<lbrace>obj_at' (\<lambda>tcb. P (tcbFault tcb)) t'\<rbrace>"
+  unfolding setThreadState_def rescheduleRequired_def tcbSchedEnqueue_def tcbQueuePrepend_def
+  apply (wpsimp wp: threadSet_wp hoare_drop_imps threadGet_wp simp: setQueue_def bitmap_fun_defs)
+  apply (fastforce simp: obj_at'_def st_tcb_at'_def objBits_simps projectKOs)
+  done
+
+lemma setThreadState_tcbArch_obj_at'[wp]:
+  "setThreadState ts t \<lbrace>obj_at' (\<lambda>tcb. P (tcbArch tcb)) t'\<rbrace>"
+  unfolding setThreadState_def rescheduleRequired_def tcbSchedEnqueue_def tcbQueuePrepend_def
+  apply (wpsimp wp: threadSet_wp hoare_drop_imps threadGet_wp simp: setQueue_def bitmap_fun_defs)
+  apply (fastforce simp: obj_at'_def st_tcb_at'_def objBits_simps projectKOs)
+  done
+
 lemma fastpath_callKernel_SysCall_corres:
   "monadic_rewrite True False
          (invs' and ct_in_state' ((=) Running)
                 and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)
-                and (\<lambda>s. ksDomainTime s \<noteq> 0))
+                and (\<lambda>s. ksDomainTime s \<noteq> 0) and ready_qs_runnable)
      (callKernel (SyscallEvent SysCall)) (fastpaths SysCall)"
   supply if_cong[cong] option.case_cong[cong] if_split[split del]
   supply empty_fail_getMRs[wp] (* FIXME *)
@@ -669,22 +693,18 @@ lemma fastpath_callKernel_SysCall_corres:
                            apply wp[1]
                           apply (simp cong: if_cong HOL.conj_cong add: if_bool_simps)
                           apply (simp_all only:)[5]
-                          apply ((wp setThreadState_oa_queued[of _ "\<lambda>a _ _. \<not> a"]
-                                     setThreadState_obj_at_unchanged
-                                     asUser_obj_at_unchanged mapM_x_wp'
+                          apply ((wp asUser_obj_at_unchanged mapM_x_wp'
                                      sts_st_tcb_at'_cases
                                      setThreadState_no_sch_change
                                      setEndpoint_obj_at_tcb'
                                      fastpathBestSwitchCandidate_lift[where f="setThreadState f t" for f t]
-                                     setThreadState_oa_queued
                                      fastpathBestSwitchCandidate_lift[where f="asUser t f" for f t]
                                      fastpathBestSwitchCandidate_lift[where f="setEndpoint a b" for a b]
                                      lookupBitmapPriority_lift
                                      setThreadState_runnable_bitmap_inv
                                      getEndpoint_obj_at'
-                                   | simp add: setMessageInfo_def
+                                   | simp add: setMessageInfo_def obj_at'_conj
                                    | wp (once) hoare_vcg_disj_lift)+)
-
                    apply (simp add: setThreadState_runnable_simp
                                     getThreadCallerSlot_def getThreadReplySlot_def
                                     locateSlot_conv bind_assoc)
@@ -794,8 +814,6 @@ lemma fastpath_callKernel_SysCall_corres:
    prefer 2
    apply normalise_obj_at'
   apply clarsimp
-  apply (frule_tac t="blockedThread" in valid_queues_not_runnable_not_queued, assumption)
-  subgoal by (fastforce simp: st_tcb_at'_def elim: obj_at'_weakenE)
   apply (subgoal_tac "fastpathBestSwitchCandidate blockedThread s")
    prefer 2
    apply (rule_tac ttcb=tcbb and ctcb=tcb in fastpathBestSwitchCandidateI)
@@ -804,6 +822,9 @@ lemma fastpath_callKernel_SysCall_corres:
   apply (clarsimp simp: st_tcb_at'_def obj_at'_def objBits_simps projectKOs valid_mdb'_def
                         valid_mdb_ctes_def inj_case_bool
                  split: bool.split)+
+  apply (clarsimp simp: ready_qs_runnable_def)
+  apply (drule_tac x=blockedThread in spec)
+  apply (clarsimp simp: obj_at'_def projectKOs st_tcb_at'_def objBits_simps)
   done
 
 lemma capability_case_Null_ReplyCap:
@@ -960,14 +981,16 @@ crunch tcbContext[wp]: possibleSwitchTo "obj_at' (\<lambda>tcb. P ( (atcbContext
 crunch only_cnode_caps[wp]: doFaultTransfer "\<lambda>s. P (only_cnode_caps (ctes_of s))"
   (wp: crunch_wps simp: crunch_simps)
 
+(* FIXME: monadic_rewrite_l does not work with stateAssert here *)
 lemma tcbSchedDequeue_rewrite_not_queued:
   "monadic_rewrite True False (tcb_at' t and obj_at' (Not \<circ> tcbQueued) t)
      (tcbSchedDequeue t) (return ())"
-  apply (simp add: tcbSchedDequeue_def when_def)
-  apply (monadic_rewrite_l monadic_rewrite_if_l_False \<open>wp threadGet_const\<close>)
-   apply (monadic_rewrite_symb_exec_l, rule monadic_rewrite_refl)
-   apply wp+
-  apply clarsimp
+  apply (simp add: tcbSchedDequeue_def)
+  apply wp_pre
+  apply monadic_rewrite_symb_exec_l
+    apply (monadic_rewrite_symb_exec_l_known False, simp)
+     apply (rule monadic_rewrite_refl)
+    apply (wpsimp wp: threadGet_const)+
   done
 
 lemma schedule_known_rewrite:
@@ -1006,7 +1029,7 @@ lemma schedule_known_rewrite:
                             \<open>wpsimp wp: Arch_switchToThread_obj_at_pre\<close>)
    (* remove no-ops *)
    apply simp
-   apply (repeat 9 \<open>rule monadic_rewrite_symb_exec_l\<close>) (* until switchToThread *)
+   apply (repeat 13 \<open>rule monadic_rewrite_symb_exec_l\<close>) (* until switchToThread *)
                               apply (rule monadic_rewrite_refl)
                              apply (wpsimp simp: isHighestPrio_def')+
   apply (clarsimp simp: ct_in_state'_def not_pred_tcb_at'_strengthen
@@ -1268,18 +1291,12 @@ crunches setThreadState, emptySlot, asUser
   (wp: obj_at_setObject2 crunch_wps
    simp: crunch_simps updateObject_default_def in_monad)
 
-lemma st_tcb_at_is_Reply_imp_not_tcbQueued: "\<And>s t.\<lbrakk> invs' s; st_tcb_at' isReply t s\<rbrakk> \<Longrightarrow> obj_at' (\<lambda>a. \<not> tcbQueued a) t s"
-  apply (clarsimp simp: invs'_def valid_state'_def valid_queues_def st_tcb_at'_def valid_queues_no_bitmap_def)
-  apply (rule all_prio_not_inQ_not_tcbQueued)
-  apply (clarsimp simp: obj_at'_def)
-  apply (erule_tac x="d" in allE)
-  apply (erule_tac x="p" in allE)
-  apply (erule conjE)
-  apply (erule_tac x="t" in ballE)
-   apply (clarsimp simp: obj_at'_def runnable'_def isReply_def)
-   apply (case_tac "tcbState obj")
-          apply ((clarsimp simp: inQ_def)+)[8]
-  apply (clarsimp simp: valid_queues'_def obj_at'_def)
+lemma st_tcb_at_is_Reply_imp_not_tcbQueued:
+  "\<And>s t. \<lbrakk> ready_qs_runnable s; st_tcb_at' isReply t s\<rbrakk>  \<Longrightarrow> obj_at' (\<lambda>tcb. \<not> tcbQueued tcb) t s"
+  apply (clarsimp simp: ready_qs_runnable_def)
+  apply (drule_tac x=t in spec)
+  apply (clarsimp simp: st_tcb_at'_def obj_at'_def isReply_def)
+  apply (case_tac "tcbState obj"; clarsimp)
   done
 
 lemma valid_objs_ntfn_at_tcbBoundNotification:
@@ -1335,7 +1352,7 @@ lemma tcbSchedEnqueue_tcbIPCBuffer:
   "\<lbrace>obj_at' (\<lambda>tcb. P (tcbIPCBuffer tcb)) t\<rbrace>
   tcbSchedEnqueue t'
   \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P (tcbIPCBuffer tcb)) t\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_when)
+  apply (simp add: tcbSchedEnqueue_def tcbQueuePrepend_def unless_when)
   apply (wp threadSet_obj_at' hoare_drop_imps threadGet_wp
         |simp split: if_split)+
   done
@@ -1361,10 +1378,20 @@ crunch obj_at'_tcbIPCBuffer[wp]: emptySlot "obj_at' (\<lambda>tcb. P (tcbIPCBuff
 crunches getBoundNotification
   for (no_fail) no_fail[intro!, wp, simp]
 
+lemma threadSet_tcb_at'[wp]:
+  "threadSet f t' \<lbrace>\<lambda>s. P (tcb_at' addr s)\<rbrace>"
+  apply (wpsimp wp: threadSet_wp)
+  apply (erule rsubst[where P=P])
+  by (clarsimp simp: obj_at'_def projectKOs ps_clear_upd objBits_simps)
+
+crunches rescheduleRequired, tcbSchedDequeue, setThreadState, setBoundNotification
+  for tcb''[wp]: "\<lambda>s. P (tcb_at' addr s)"
+  (wp: crunch_wps)
+
 lemma fastpath_callKernel_SysReplyRecv_corres:
   "monadic_rewrite True False
      (invs' and ct_in_state' ((=) Running) and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)
-         and cnode_caps_gsCNodes')
+         and cnode_caps_gsCNodes' and ready_qs_runnable)
      (callKernel (SyscallEvent SysReplyRecv)) (fastpaths SysReplyRecv)"
   including classic_wp_pre
   supply if_cong[cong] option.case_cong[cong]
@@ -1494,8 +1521,7 @@ lemma fastpath_callKernel_SysReplyRecv_corres:
                                             and thread=thread in possibleSwitchTo_rewrite))
                            | rule cteDeleteOne_replycap_rewrite
                            | rule monadic_rewrite_bind monadic_rewrite_refl
-                           | wp assert_inv mapM_x_wp'
-                                setThreadState_obj_at_unchanged
+                           | wp assert_inv mapM_x_wp' sts_valid_objs'
                                 asUser_obj_at_unchanged
                                 hoare_strengthen_post[OF _ obj_at_conj'[simplified atomize_conjL], rotated]
                                  lookupBitmapPriority_lift
@@ -1561,8 +1587,8 @@ lemma fastpath_callKernel_SysReplyRecv_corres:
                                | wps)+)[3]
                     apply (simp cong: rev_conj_cong)
                     apply (wpsimp wp: setThreadState_tcbContext[simplified comp_apply]
-                                      setThreadState_oa_queued user_getreg_rv
-                                      setThreadState_no_sch_change setThreadState_obj_at_unchanged
+                                      user_getreg_rv
+                                      setThreadState_no_sch_change sts_valid_objs'
                                       sts_st_tcb_at'_cases sts_bound_tcb_at'
                                       fastpathBestSwitchCandidate_lift[where f="setThreadState s t" for s t]
                                       hoare_weak_lift_imp hoare_vcg_all_lift hoare_vcg_imp_lift
@@ -1570,8 +1596,7 @@ lemma fastpath_callKernel_SysReplyRecv_corres:
                                       hoare_vcg_ex_lift
                           | wps)+
                            apply (strengthen imp_consequent[where Q="tcb_at' t s" for t s])
-                           apply ((wp setThreadState_oa_queued user_getreg_rv setThreadState_no_sch_change
-                                      setThreadState_obj_at_unchanged
+                           apply ((wp user_getreg_rv setThreadState_no_sch_change
                                       sts_st_tcb_at'_cases sts_bound_tcb_at'
                                       emptySlot_obj_at'_not_queued emptySlot_obj_at_ep
                                       emptySlot_tcbContext[simplified comp_apply]
@@ -1748,7 +1773,9 @@ lemma fastpath_callKernel_SysReplyRecv_corres:
   apply (clarsimp simp: obj_at_tcbs_of tcbSlots
                         cte_level_bits_def)
   apply (frule(1) st_tcb_at_is_Reply_imp_not_tcbQueued)
-  apply (auto simp: obj_at_tcbs_of tcbSlots
+  apply (frule invs_pspace_aligned')
+  apply (frule invs_pspace_distinct')
+  apply (auto simp: obj_at_tcbs_of tcbSlots projectKOs
                         cte_level_bits_def)
   done
 
diff --git a/proof/crefine/ARM_HYP/Finalise_C.thy b/proof/crefine/ARM_HYP/Finalise_C.thy
index 8795ff253e..aa8408d67c 100644
--- a/proof/crefine/ARM_HYP/Finalise_C.thy
+++ b/proof/crefine/ARM_HYP/Finalise_C.thy
@@ -17,6 +17,108 @@ declare if_split [split del]
 definition
   "option_map2 f m = option_map f \<circ> m"
 
+definition ksReadyQueues_head_end_2 :: "(domain \<times> priority \<Rightarrow> ready_queue) \<Rightarrow> bool" where
+  "ksReadyQueues_head_end_2 qs \<equiv>
+     \<forall>d p. tcbQueueHead (qs (d, p)) \<noteq> None \<longleftrightarrow> tcbQueueEnd (qs (d, p)) \<noteq> None"
+
+abbreviation "ksReadyQueues_head_end s \<equiv> ksReadyQueues_head_end_2 (ksReadyQueues s)"
+
+lemmas ksReadyQueues_head_end_def = ksReadyQueues_head_end_2_def
+
+lemma ksReadyQueues_asrt_ksReadyQueues_head_end:
+  "ksReadyQueues_asrt s \<Longrightarrow> ksReadyQueues_head_end s"
+  by (fastforce dest: tcbQueueHead_iff_tcbQueueEnd
+                simp: ready_queue_relation_def ksReadyQueues_asrt_def ksReadyQueues_head_end_def)
+
+lemma tcbSchedEnqueue_ksReadyQueues_head_end[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>ksReadyQueues_head_end\<rbrace>"
+  unfolding tcbSchedEnqueue_def tcbQueuePrepend_def setQueue_def
+  apply (wpsimp wp: threadSet_wp threadGet_wp simp: bitmap_fun_defs)
+  apply (clarsimp simp: tcbQueueEmpty_def obj_at'_def ksReadyQueues_head_end_def split: if_splits)
+  done
+
+lemma ksReadyQueues_head_end_ksSchedulerAction_update[simp]:
+  "ksReadyQueues_head_end (s\<lparr>ksSchedulerAction := ChooseNewThread\<rparr>) = ksReadyQueues_head_end s"
+  by (simp add: ksReadyQueues_head_end_def)
+
+crunches rescheduleRequired
+  for ksReadyQueues_head_end[wp]: ksReadyQueues_head_end
+
+lemma setThreadState_ksReadyQueues_head_end[wp]:
+  "setThreadState ts tcbPtr \<lbrace>ksReadyQueues_head_end\<rbrace>"
+  unfolding setThreadState_def
+  by (wpsimp wp: threadSet_wp threadGet_wp simp: bitmap_fun_defs)
+
+definition ksReadyQueues_head_end_tcb_at'_2 ::
+  "(domain \<times> priority \<Rightarrow> ready_queue) \<Rightarrow> (obj_ref \<rightharpoonup> tcb) \<Rightarrow> bool" where
+  "ksReadyQueues_head_end_tcb_at'_2 qs tcbs \<equiv>
+     \<forall>d p. (\<forall>head. tcbQueueHead (qs (d, p)) = Some head \<longrightarrow> tcbs head \<noteq> None)
+           \<and> (\<forall>end. tcbQueueEnd (qs (d, p)) = Some end \<longrightarrow> tcbs end \<noteq> None)"
+
+abbreviation "ksReadyQueues_head_end_tcb_at' s \<equiv>
+  ksReadyQueues_head_end_tcb_at'_2 (ksReadyQueues s) (tcbs_of' s)"
+
+lemmas ksReadyQueues_head_end_tcb_at'_def = ksReadyQueues_head_end_tcb_at'_2_def
+
+lemma ksReadyQueues_asrt_ksReadyQueues_head_end_tcb_at':
+  "\<lbrakk>ksReadyQueues_asrt s; pspace_aligned' s; pspace_distinct' s\<rbrakk>
+   \<Longrightarrow> ksReadyQueues_head_end_tcb_at' s"
+  apply (clarsimp simp: ready_queue_relation_def ksReadyQueues_asrt_def
+                        ksReadyQueues_head_end_tcb_at'_def)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply (clarsimp simp: list_queue_relation_def)
+  apply (intro conjI impI allI)
+   apply (case_tac "ts = []", clarsimp)
+   apply (fastforce dest!: heap_path_head hd_in_set
+                     simp: opt_pred_def  tcbQueueEmpty_def split: option.splits)
+  apply (fastforce simp: queue_end_valid_def opt_pred_def tcbQueueEmpty_def
+                  split: option.splits)
+  done
+
+lemma tcbSchedEnqueue_ksReadyQueues_head_end_tcb_at'[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>ksReadyQueues_head_end_tcb_at'\<rbrace>"
+  unfolding tcbSchedEnqueue_def tcbQueuePrepend_def setQueue_def
+  apply (wpsimp wp: threadSet_wp threadGet_wp simp: bitmap_fun_defs)
+  apply (clarsimp simp: ksReadyQueues_head_end_tcb_at'_def split: if_splits)
+  done
+
+lemma ksReadyQueues_head_end_tcb_at'_ksSchedulerAction_update[simp]:
+  "ksReadyQueues_head_end_tcb_at' (s\<lparr>ksSchedulerAction := ChooseNewThread\<rparr>)
+   = ksReadyQueues_head_end_tcb_at' s"
+  by (simp add: ksReadyQueues_head_end_tcb_at'_def)
+
+crunches rescheduleRequired
+  for ksReadyQueues_head_end_tcb_at'[wp]: ksReadyQueues_head_end_tcb_at'
+
+lemma setThreadState_ksReadyQueues_head_end_tcb_at'[wp]:
+  "setThreadState ts tcbPtr \<lbrace>ksReadyQueues_head_end_tcb_at'\<rbrace>"
+  unfolding setThreadState_def
+  apply (wpsimp wp: threadSet_wp)
+  apply (fastforce simp: ksReadyQueues_head_end_tcb_at'_def split: if_splits)
+  done
+
+lemma head_end_ksReadyQueues_':
+  "\<lbrakk> (s, s') \<in> rf_sr; ksReadyQueues_head_end s; ksReadyQueues_head_end_tcb_at' s;
+     pspace_aligned' s; pspace_distinct' s;
+     d \<le> maxDomain; p \<le> maxPriority \<rbrakk>
+   \<Longrightarrow> head_C (index (ksReadyQueues_' (globals s')) (cready_queues_index_to_C d p)) = NULL
+       \<longleftrightarrow> end_C (index (ksReadyQueues_' (globals s')) (cready_queues_index_to_C d p)) = NULL"
+  apply (frule (2) rf_sr_ctcb_queue_relation[where d=d and p=p])
+  apply (clarsimp simp: ksReadyQueues_head_end_def)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply (clarsimp simp: ksReadyQueues_head_end_tcb_at'_def)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply (clarsimp simp: ctcb_queue_relation_def option_to_ctcb_ptr_def split: option.splits)
+  apply (rename_tac "end" head end_tcb head_tcb)
+  apply (prop_tac "tcb_at' head s \<and> tcb_at' end s")
+   apply (fastforce intro!: aligned'_distinct'_ko_wp_at'I
+                      simp: obj_at'_real_def opt_map_def split: option.splits)
+  apply (fastforce dest: tcb_at_not_NULL)
+  done
+
 lemma tcbSchedEnqueue_cslift_spec:
   "\<forall>s. \<Gamma>\<turnstile>\<^bsub>/UNIV\<^esub> \<lbrace>s. \<exists>d v. option_map2 tcbPriority_C (cslift s) \<acute>tcb = Some v
                        \<and> unat v \<le> numPriorities
@@ -28,7 +130,9 @@ lemma tcbSchedEnqueue_cslift_spec:
                                            \<noteq> None
                              \<and> option_map2 tcbDomain_C (cslift s)
                                    (head_C (index \<acute>ksReadyQueues (unat (d*0x100 + v))))
-                                           \<noteq> None)\<rbrace>
+                                           \<noteq> None)
+                       \<and> (head_C (index \<acute>ksReadyQueues (unat (d * 0x100 + v))) \<noteq> NULL
+                          \<longleftrightarrow> end_C (index \<acute>ksReadyQueues (unat (d * 0x100 + v))) \<noteq> NULL)\<rbrace>
        Call tcbSchedEnqueue_'proc
       {s'. option_map2 tcbEPNext_C (cslift s') = option_map2 tcbEPNext_C (cslift s)
            \<and> option_map2 tcbEPPrev_C (cslift s') = option_map2 tcbEPPrev_C (cslift s)
@@ -45,8 +149,8 @@ lemma tcbSchedEnqueue_cslift_spec:
   apply (rule conjI)
    apply (clarsimp simp: typ_heap_simps cong: if_cong)
    apply (simp split: if_split)
-  apply (clarsimp simp: typ_heap_simps if_Some_helper cong: if_cong)
-  by (simp split: if_split)
+  by (auto simp: typ_heap_simps' if_Some_helper numPriorities_def
+           cong: if_cong split: if_splits)
 
 lemma setThreadState_cslift_spec:
   "\<forall>s. \<Gamma>\<turnstile>\<^bsub>/UNIV\<^esub> \<lbrace>s. s \<Turnstile>\<^sub>c \<acute>tptr \<and> (\<forall>x. ksSchedulerAction_' (globals s) = tcb_Ptr x
@@ -141,8 +245,9 @@ lemma ctcb_relation_tcbPriority_maxPriority_numPriorities:
   done
 
 lemma tcbSchedEnqueue_cslift_precond_discharge:
-  "\<lbrakk> (s, s') \<in> rf_sr; obj_at' (P :: tcb \<Rightarrow> bool) x s;
-        valid_queues s; valid_objs' s \<rbrakk> \<Longrightarrow>
+  "\<lbrakk> (s, s') \<in> rf_sr; obj_at' (P :: tcb \<Rightarrow> bool) x s; valid_objs' s ;
+     ksReadyQueues_head_end s; ksReadyQueues_head_end_tcb_at' s;
+     pspace_aligned' s; pspace_distinct' s\<rbrakk> \<Longrightarrow>
    (\<exists>d v. option_map2 tcbPriority_C (cslift s') (tcb_ptr_to_ctcb_ptr x) = Some v
         \<and> unat v < numPriorities
         \<and> option_map2 tcbDomain_C (cslift s') (tcb_ptr_to_ctcb_ptr x) = Some d
@@ -153,31 +258,49 @@ lemma tcbSchedEnqueue_cslift_precond_discharge:
                                     \<noteq> None
                   \<and> option_map2 tcbDomain_C (cslift s')
                      (head_C (index (ksReadyQueues_' (globals s')) (unat (d*0x100 + v))))
-                                    \<noteq> None))"
+                                    \<noteq> None)
+        \<and> (head_C (index (ksReadyQueues_' (globals s')) (unat (d * 0x100 + v))) \<noteq> NULL
+           \<longleftrightarrow> end_C (index (ksReadyQueues_' (globals s')) (unat (d * 0x100 + v))) \<noteq> NULL))"
   apply (drule(1) obj_at_cslift_tcb)
   apply (clarsimp simp: typ_heap_simps' option_map2_def)
+  apply (rename_tac tcb tcb')
   apply (frule_tac t=x in valid_objs'_maxPriority, fastforce simp: obj_at'_def)
   apply (frule_tac t=x in valid_objs'_maxDomain, fastforce simp: obj_at'_def)
   apply (drule_tac P="\<lambda>tcb. tcbPriority tcb \<le> maxPriority" in obj_at_ko_at2', simp)
   apply (drule_tac P="\<lambda>tcb. tcbDomain tcb \<le> maxDomain" in obj_at_ko_at2', simp)
   apply (simp add: ctcb_relation_tcbDomain_maxDomain_numDomains
                    ctcb_relation_tcbPriority_maxPriority_numPriorities)
-  apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko"
-              in rf_sr_sched_queue_relation)
+  apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb" in rf_sr_ctcb_queue_relation)
     apply (simp add: maxDom_to_H maxPrio_to_H)+
+  apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb" in head_end_ksReadyQueues_', fastforce+)
   apply (simp add: cready_queues_index_to_C_def2 numPriorities_def le_maxDomain_eq_less_numDomains)
   apply (clarsimp simp: ctcb_relation_def)
-  apply (frule arg_cong[where f=unat], subst(asm) unat_ucast_8_32)
-  apply (frule tcb_queue'_head_end_NULL)
-   apply (erule conjunct1[OF valid_queues_valid_q])
-  apply (frule(1) tcb_queue_relation_qhead_valid')
-   apply (simp add: valid_queues_valid_q)
-  apply (clarsimp simp: h_t_valid_clift_Some_iff)
+  apply (frule arg_cong[where f=unat], subst(asm) unat_ucast_up_simp, simp)
+  apply (frule (3) head_end_ksReadyQueues_', fastforce+)
+  apply (clarsimp simp: ksReadyQueues_head_end_def)
+  apply (drule_tac x="tcbDomain tcb" in spec)
+  apply (drule_tac x="tcbPriority tcb" in spec)
+  apply (prop_tac "\<not> tcbQueueEmpty ((ksReadyQueues s (tcbDomain tcb, tcbPriority tcb)))")
+   apply (clarsimp simp: tcbQueueEmpty_def ctcb_queue_relation_def option_to_ctcb_ptr_def
+                  split: option.splits)
+  apply (clarsimp simp: ksReadyQueues_head_end_tcb_at'_def)
+  apply (drule_tac x="tcbDomain tcb" in spec)
+  apply (drule_tac x="tcbPriority tcb" in spec)
+  apply clarsimp
+  apply (clarsimp simp: tcbQueueEmpty_def)
+  apply (rename_tac head "end" head_tcb end_tcb)
+  apply (prop_tac "tcb_at' head s")
+   apply (fastforce intro: aligned'_distinct'_ko_wp_at'I
+                     simp: obj_at'_real_def opt_map_def split: option.splits)
+  apply (frule_tac thread=head in obj_at_cslift_tcb)
+   apply fastforce
+  apply (clarsimp dest: obj_at_cslift_tcb simp: ctcb_queue_relation_def option_to_ctcb_ptr_def)
   done
 
 lemma cancel_all_ccorres_helper:
   "ccorres dc xfdc
-      (\<lambda>s. valid_objs' s \<and> valid_queues s
+      (\<lambda>s. valid_objs' s \<and> pspace_aligned' s \<and> pspace_distinct' s
+             \<and> ksReadyQueues_head_end s \<and> ksReadyQueues_head_end_tcb_at' s
              \<and> (\<forall>t\<in>set ts. tcb_at' t s \<and> t \<noteq> 0)
              \<and> sch_act_wf (ksSchedulerAction s) s)
       {s'. \<exists>p. ep_queue_relation (cslift s') ts
@@ -232,11 +355,11 @@ next
            apply (erule cmap_relationE1 [OF cmap_relation_tcb])
             apply (erule ko_at_projectKO_opt)
            apply (fastforce intro: typ_heap_simps)
-          apply (wp sts_running_valid_queues | simp)+
+          apply (wp sts_valid_objs' | simp)+
         apply (rule ceqv_refl)
        apply (rule "Cons.hyps")
       apply (wp sts_valid_objs' sts_sch_act sch_act_wf_lift hoare_vcg_const_Ball_lift
-                sts_running_valid_queues sts_st_tcb' setThreadState_oa_queued | simp)+
+                sts_st_tcb' | simp)+
 
      apply (vcg exspec=setThreadState_cslift_spec exspec=tcbSchedEnqueue_cslift_spec)
     apply (clarsimp simp: tcb_at_not_NULL Collect_const_mem valid_tcb_state'_def
@@ -250,16 +373,13 @@ next
                            st_tcb_at'_def
                     split: scheduler_action.split_asm)
      apply (rename_tac word)
-     apply (frule_tac x=word in tcbSchedEnqueue_cslift_precond_discharge)
-        apply simp
-       apply clarsimp
-      apply clarsimp
-     apply clarsimp
+     apply (frule_tac x=word in tcbSchedEnqueue_cslift_precond_discharge; clarsimp?)
+     apply simp
     apply clarsimp
     apply (rule conjI)
      apply (frule(3) tcbSchedEnqueue_cslift_precond_discharge)
      apply clarsimp
-    apply clarsimp
+    apply clarsimp+
     apply (subst ep_queue_relation_shift, fastforce)
     apply (drule_tac x="tcb_ptr_to_ctcb_ptr thread"
                 in fun_cong)+
@@ -268,11 +388,17 @@ next
     done
 qed
 
+crunches setEndpoint, setNotification
+  for ksReadyQueues_head_end[wp]: ksReadyQueues_head_end
+  and ksReadyQueues_head_end_tcb_at'[wp]: ksReadyQueues_head_end_tcb_at'
+  (simp: updateObject_default_def)
+
 lemma cancelAllIPC_ccorres:
   "ccorres dc xfdc
-   (invs') (UNIV \<inter> {s. epptr_' s = Ptr epptr}) []
+   invs' (UNIV \<inter> {s. epptr_' s = Ptr epptr}) []
    (cancelAllIPC epptr) (Call cancelAllIPC_'proc)"
   apply (cinit lift: epptr_')
+   apply (rule ccorres_stateAssert)
    apply (rule ccorres_symb_exec_l [OF _ getEndpoint_inv _ empty_fail_getEndpoint])
     apply (rule_tac xf'=ret__unsigned_'
                 and val="case ep of IdleEP \<Rightarrow> scast EPState_Idle
@@ -287,7 +413,7 @@ lemma cancelAllIPC_ccorres:
        apply (simp add: cendpoint_relation_def Let_def
                  split: endpoint.split_asm)
       apply ceqv
-     apply (rule_tac A="invs' and ko_at' ep epptr"
+     apply (rule_tac A="invs' and ksReadyQueues_asrt and ko_at' ep epptr"
               in ccorres_guard_imp2[where A'=UNIV])
       apply wpc
         apply (rename_tac list)
@@ -327,12 +453,11 @@ lemma cancelAllIPC_ccorres:
              apply ceqv
             apply (ctac add: rescheduleRequired_ccorres)
            apply (wp weak_sch_act_wf_lift_linear
-                     cancelAllIPC_mapM_x_valid_queues
                   | simp)+
               apply (rule mapM_x_wp', wp)+
              apply (wp sts_st_tcb')
              apply (clarsimp split: if_split)
-            apply (rule mapM_x_wp', wp)+
+            apply (rule mapM_x_wp', wp sts_valid_objs')+
            apply (clarsimp simp: valid_tcb_state'_def)
           apply (simp add: guard_is_UNIV_def)
          apply (wp set_ep_valid_objs' hoare_vcg_const_Ball_lift
@@ -374,22 +499,26 @@ lemma cancelAllIPC_ccorres:
             apply (rule cancel_all_ccorres_helper)
            apply ceqv
           apply (ctac add: rescheduleRequired_ccorres)
-         apply (wp cancelAllIPC_mapM_x_valid_queues)
-         apply (wp mapM_x_wp' weak_sch_act_wf_lift_linear
+         apply (wp mapM_x_wp' weak_sch_act_wf_lift_linear sts_valid_objs'
                    sts_st_tcb' | clarsimp simp: valid_tcb_state'_def split: if_split)+
         apply (simp add: guard_is_UNIV_def)
        apply (wp set_ep_valid_objs' hoare_vcg_const_Ball_lift
                  weak_sch_act_wf_lift_linear)
       apply vcg
-     apply (clarsimp simp: valid_ep'_def invs_valid_objs' invs_queues)
+     apply (clarsimp simp: valid_ep'_def invs_valid_objs')
      apply (rule cmap_relationE1[OF cmap_relation_ep], assumption)
       apply (erule ko_at_projectKO_opt)
      apply (frule obj_at_valid_objs', clarsimp+)
-     apply (clarsimp simp: projectKOs valid_obj'_def valid_ep'_def)
-     subgoal by (auto simp: typ_heap_simps cendpoint_relation_def
-                       Let_def tcb_queue_relation'_def
-                       invs_valid_objs' valid_objs'_maxDomain valid_objs'_maxPriority
-               intro!: obj_at_conj')
+     apply (clarsimp simp: valid_obj'_def valid_ep'_def)
+     apply (frule invs_pspace_aligned')
+     apply (frule invs_pspace_distinct')
+     apply (frule ksReadyQueues_asrt_ksReadyQueues_head_end)
+     apply (frule (2) ksReadyQueues_asrt_ksReadyQueues_head_end_tcb_at')
+     subgoal
+       by (auto simp: typ_heap_simps cendpoint_relation_def
+                      Let_def tcb_queue_relation'_def projectKOs
+                      invs_valid_objs' valid_objs'_maxDomain valid_objs'_maxPriority
+              intro!: obj_at_conj')
     apply (clarsimp simp: guard_is_UNIV_def)
    apply (wp getEndpoint_wp)
   apply clarsimp
@@ -397,9 +526,10 @@ lemma cancelAllIPC_ccorres:
 
 lemma cancelAllSignals_ccorres:
   "ccorres dc xfdc
-   (invs') (UNIV \<inter> {s. ntfnPtr_' s = Ptr ntfnptr}) []
+   invs' (UNIV \<inter> {s. ntfnPtr_' s = Ptr ntfnptr}) []
    (cancelAllSignals ntfnptr) (Call cancelAllSignals_'proc)"
   apply (cinit lift: ntfnPtr_')
+   apply (rule ccorres_stateAssert)
    apply (rule ccorres_symb_exec_l [OF _ get_ntfn_inv' _ empty_fail_getNotification])
     apply (rule_tac xf'=ret__unsigned_'
                 and val="case ntfnObj ntfn of IdleNtfn \<Rightarrow> scast NtfnState_Idle
@@ -414,7 +544,7 @@ lemma cancelAllSignals_ccorres:
        apply (simp add: cnotification_relation_def Let_def
                  split: ntfn.split_asm)
       apply ceqv
-     apply (rule_tac A="invs' and ko_at' ntfn ntfnptr"
+     apply (rule_tac A="invs' and ksReadyQueues_asrt and ko_at' ntfn ntfnptr"
               in ccorres_guard_imp2[where A'=UNIV])
       apply wpc
         apply (simp add: notification_state_defs ccorres_cond_iffs)
@@ -453,8 +583,7 @@ lemma cancelAllSignals_ccorres:
             apply (rule cancel_all_ccorres_helper)
            apply ceqv
           apply (ctac add: rescheduleRequired_ccorres)
-         apply (wp cancelAllIPC_mapM_x_valid_queues)
-         apply (wp mapM_x_wp' weak_sch_act_wf_lift_linear
+         apply (wp mapM_x_wp' weak_sch_act_wf_lift_linear sts_valid_objs'
                    sts_st_tcb' | clarsimp simp: valid_tcb_state'_def split: if_split)+
         apply (simp add: guard_is_UNIV_def)
        apply (wp set_ntfn_valid_objs' hoare_vcg_const_Ball_lift
@@ -464,11 +593,16 @@ lemma cancelAllSignals_ccorres:
      apply (rule cmap_relationE1[OF cmap_relation_ntfn], assumption)
       apply (erule ko_at_projectKO_opt)
      apply (frule obj_at_valid_objs', clarsimp+)
-     apply (clarsimp simp add: valid_obj'_def valid_ntfn'_def projectKOs)
-     subgoal by (auto simp: typ_heap_simps cnotification_relation_def
-                       Let_def tcb_queue_relation'_def
-                       invs_valid_objs' valid_objs'_maxDomain valid_objs'_maxPriority
-               intro!: obj_at_conj')
+     apply (clarsimp simp add: valid_obj'_def valid_ntfn'_def)
+     apply (frule invs_pspace_aligned')
+     apply (frule invs_pspace_distinct')
+     apply (frule ksReadyQueues_asrt_ksReadyQueues_head_end)
+     apply (frule (2) ksReadyQueues_asrt_ksReadyQueues_head_end_tcb_at')
+     subgoal
+       by (auto simp: typ_heap_simps cnotification_relation_def
+                      Let_def tcb_queue_relation'_def projectKOs
+                      invs_valid_objs' valid_objs'_maxDomain valid_objs'_maxPriority
+              intro!: obj_at_conj')
     apply (clarsimp simp: guard_is_UNIV_def)
    apply (wp getNotification_wp)
   apply clarsimp
@@ -549,16 +683,16 @@ lemma tcb_queue_relation2_cong:
 
 context kernel_m begin
 
-lemma setThreadState_ccorres_valid_queues'_simple:
-  "ccorres dc xfdc (\<lambda>s. tcb_at' thread s \<and> valid_queues' s \<and> \<not> runnable' st \<and> sch_act_simple s)
+lemma setThreadState_ccorres_simple:
+  "ccorres dc xfdc (\<lambda>s. tcb_at' thread s \<and> \<not> runnable' st \<and> sch_act_simple s)
    ({s'. (\<forall>cl fl. cthread_state_relation_lifted st (cl\<lparr>tsType_CL := ts_' s' && mask 4\<rparr>, fl))}
     \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr thread}) []
          (setThreadState st thread) (Call setThreadState_'proc)"
   apply (cinit lift: tptr_' cong add: call_ignore_cong)
     apply (ctac (no_vcg) add: threadSet_tcbState_simple_corres)
    apply (ctac add: scheduleTCB_ccorres_valid_queues'_simple)
-  apply (wp threadSet_valid_queues'_and_not_runnable')
-  apply (clarsimp simp: weak_sch_act_wf_def valid_queues'_def)
+  apply (wp threadSet_tcbState_st_tcb_at')
+  apply (fastforce simp: weak_sch_act_wf_def)
   done
 
 lemma updateRestartPC_ccorres:
@@ -574,9 +708,7 @@ lemma updateRestartPC_ccorres:
   done
 
 crunches updateRestartPC
-  for valid_queues'[wp]: valid_queues'
-  and sch_act_simple[wp]: sch_act_simple
-  and valid_queues[wp]: Invariants_H.valid_queues
+  for sch_act_simple[wp]: sch_act_simple
   and valid_objs'[wp]: valid_objs'
   and tcb_at'[wp]: "tcb_at' p"
 
@@ -620,21 +752,12 @@ lemma suspend_ccorres:
           apply (ctac (no_vcg) add: updateRestartPC_ccorres)
          apply (rule ccorres_return_Skip)
         apply ceqv
-       apply (ctac(no_vcg) add: setThreadState_ccorres_valid_queues'_simple)
-        apply (ctac add: tcbSchedDequeue_ccorres')
-       apply (rule_tac Q="\<lambda>_.
-                        (\<lambda>s. \<forall>t' d p. (t' \<in> set (ksReadyQueues s (d, p)) \<longrightarrow>
-                              obj_at' (\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d
-                                                           \<and> tcbPriority tcb = p) t' s \<and>
-                (t' \<noteq> thread \<longrightarrow> st_tcb_at' runnable' t' s)) \<and>
-                distinct (ksReadyQueues s (d, p))) and valid_queues' and valid_objs' and tcb_at' thread"
-              in hoare_post_imp)
+       apply (ctac(no_vcg) add: setThreadState_ccorres_simple)
+        apply (ctac add: tcbSchedDequeue_ccorres)
+       apply (rule_tac Q="\<lambda>_. valid_objs' and tcb_at' thread and pspace_aligned' and pspace_distinct'"
+                    in hoare_post_imp)
         apply clarsimp
-        apply (drule_tac x="t" in spec)
-        apply (drule_tac x=d in spec)
-        apply (drule_tac x=p in spec)
-        apply (clarsimp elim!: obj_at'_weakenE simp: inQ_def)
-       apply (wp sts_valid_queues_partial)[1]
+       apply (wp sts_valid_objs')[1]
       apply clarsimp
       apply (wpsimp simp: valid_tcb_state'_def)
      apply clarsimp
@@ -643,15 +766,13 @@ lemma suspend_ccorres:
     apply clarsimp
     apply (rule conseqPre, vcg)
     apply (rule subset_refl)
-  apply (rule hoare_strengthen_post)
+   apply (rule hoare_strengthen_post)
     apply (rule hoare_vcg_conj_lift)
      apply (rule hoare_vcg_conj_lift)
       apply (rule cancelIPC_sch_act_simple)
      apply (rule cancelIPC_tcb_at'[where t=thread])
     apply (rule delete_one_conc_fr.cancelIPC_invs)
-   apply (fastforce simp: invs_valid_queues' invs_queues invs_valid_objs'
-                          valid_tcb_state'_def)
-  apply clarsimp
+   apply (fastforce simp: invs_valid_objs' valid_tcb_state'_def)
   apply (auto simp: ThreadState_defs)
   done
 
@@ -1724,23 +1845,6 @@ lemma ep_queue_relation_shift2:
   apply (clarsimp split: option.split_asm)
   done
 
-lemma sched_queue_relation_shift:
-  "(option_map2 tcbSchedNext_C (f (cslift s))
-         = option_map2 tcbSchedNext_C (cslift s)
-    \<and> option_map2 tcbSchedPrev_C (f (cslift s))
-         = option_map2 tcbSchedPrev_C (cslift s))
-     \<Longrightarrow>  sched_queue_relation (f (cslift s)) ts qPrev qHead
-          =  sched_queue_relation (cslift s) ts qPrev qHead"
-  apply clarsimp
-  apply (induct ts arbitrary: qPrev qHead)
-   apply simp
-  apply simp
-  apply (simp add: option_map2_def fun_eq_iff
-                   map_option_case)
-  apply (drule_tac x=qHead in spec)+
-  apply (clarsimp split: option.split_asm)
-  done
-
 lemma cendpoint_relation_udpate_arch:
   "\<lbrakk> cslift x p = Some tcb ; cendpoint_relation (cslift x) v v' \<rbrakk>
     \<Longrightarrow> cendpoint_relation ((cslift x)(p \<mapsto> tcbArch_C_update f tcb)) v v'"
@@ -1787,10 +1891,7 @@ lemma archThreadSet_tcbVCPU_Basic_ccorres:
      apply clarsimp
     apply (rule cmap_relation_rel_upd[OF _ cendpoint_relation_udpate_arch], simp+)
     apply (rule cmap_relation_rel_upd[OF _ cnotification_relation_udpate_arch], simp+)
-      apply (clarsimp simp add: cready_queues_relation_def Let_def tcb_queue_relation'_def)
-   apply (subst sched_queue_relation_shift; simp add: fun_eq_iff)
-   apply (safe ; case_tac "xa = tcb_ptr_to_ctcb_ptr tptr" ; clarsimp simp: option_map2_def map_option_case)
-    apply (clarsimp simp: cvariable_relation_upd_const)
+  apply (clarsimp simp: cvariable_relation_upd_const)
   done
 
 lemma setObject_vcpuTCB_updated_Basic_ccorres:
diff --git a/proof/crefine/ARM_HYP/Interrupt_C.thy b/proof/crefine/ARM_HYP/Interrupt_C.thy
index 5adca7f4ad..1befc2efcc 100644
--- a/proof/crefine/ARM_HYP/Interrupt_C.thy
+++ b/proof/crefine/ARM_HYP/Interrupt_C.thy
@@ -257,7 +257,7 @@ lemma decodeIRQHandlerInvocation_ccorres:
     apply (simp add: syscall_error_to_H_cases)
    apply simp
   apply (clarsimp simp: Collect_const_mem tcb_at_invs')
-  apply (clarsimp simp: invs_queues invs_valid_objs'
+  apply (clarsimp simp: invs_valid_objs'
                         ct_in_state'_def
                         ccap_rights_relation_def
                         mask_def[where n=4] ThreadState_defs)
@@ -273,7 +273,7 @@ lemma decodeIRQHandlerInvocation_ccorres:
                     excaps_map_def excaps_in_mem_def word_less_nat_alt hd_conv_nth
                     slotcap_in_mem_def valid_tcb_state'_def
              dest!: interpret_excaps_eq split: bool.splits)+
-     apply (auto dest: st_tcb_at_idle_thread' ctes_of_valid')[4]
+     apply (auto dest: st_tcb_at_idle_thread' ctes_of_valid')[6]
     apply (drule ctes_of_valid')
      apply fastforce
     apply (clarsimp simp add:valid_cap_simps' ARM_HYP.maxIRQ_def)
diff --git a/proof/crefine/ARM_HYP/Invoke_C.thy b/proof/crefine/ARM_HYP/Invoke_C.thy
index 53a670fcc8..76797adaa9 100644
--- a/proof/crefine/ARM_HYP/Invoke_C.thy
+++ b/proof/crefine/ARM_HYP/Invoke_C.thy
@@ -79,15 +79,14 @@ lemma setDomain_ccorres:
                             and (\<lambda>s. curThread = ksCurThread s)"
               in hoare_strengthen_post)
       apply (wp threadSet_all_invs_but_sch_extra)
-     apply (clarsimp simp: valid_pspace_valid_objs' st_tcb_at_def[symmetric]
-                           sch_act_simple_def st_tcb_at'_def weak_sch_act_wf_def
-                    split: if_splits)
+     apply (fastforce simp: valid_pspace_valid_objs' st_tcb_at_def[symmetric]
+                            sch_act_simple_def st_tcb_at'_def weak_sch_act_wf_def
+                     split: if_splits)
     apply (simp add: guard_is_UNIV_def)
-   apply (rule_tac Q="\<lambda>_. invs' and tcb_at' t and sch_act_simple
-                          and (\<lambda>s. curThread = ksCurThread s \<and> (\<forall>p. t \<notin> set (ksReadyQueues s p)))"
+   apply (rule_tac Q="\<lambda>_. invs' and tcb_at' t and sch_act_simple and (\<lambda>s. curThread = ksCurThread s)"
             in hoare_strengthen_post)
     apply (wp weak_sch_act_wf_lift_linear tcbSchedDequeue_not_queued
-              tcbSchedDequeue_not_in_queue hoare_vcg_imp_lift hoare_vcg_all_lift)
+              hoare_vcg_imp_lift hoare_vcg_all_lift)
    apply (clarsimp simp: invs'_def valid_pspace'_def valid_state'_def)
   apply (fastforce simp: valid_tcb'_def tcb_cte_cases_def
                          invs'_def valid_state'_def valid_pspace'_def)
@@ -195,8 +194,8 @@ lemma decodeDomainInvocation_ccorres:
    apply clarsimp
    apply (vcg exspec=getSyscallArg_modifies)
 
-  apply (clarsimp simp: valid_tcb_state'_def invs_valid_queues' invs_valid_objs'
-                        invs_queues invs_sch_act_wf' ct_in_state'_def pred_tcb_at'
+  apply (clarsimp simp: valid_tcb_state'_def invs_valid_objs'
+                        invs_sch_act_wf' ct_in_state'_def pred_tcb_at'
                         rf_sr_ksCurThread word_sle_def word_sless_def sysargs_rel_to_n
                         mask_eq_iff_w2p mask_eq_iff_w2p word_size ThreadState_defs)
   apply (rule conjI)
@@ -206,7 +205,7 @@ lemma decodeDomainInvocation_ccorres:
    apply (drule_tac x="extraCaps ! 0" and P="\<lambda>v. valid_cap' (fst v) s" in bspec)
     apply (clarsimp simp: nth_mem interpret_excaps_test_null excaps_map_def)
    apply (clarsimp simp: valid_cap_simps' pred_tcb'_weakenE active_runnable')
-   apply (rule conjI)
+   apply (intro conjI; fastforce?)
     apply (fastforce simp: tcb_st_refs_of'_def elim:pred_tcb'_weakenE)
    apply (simp add: word_le_nat_alt unat_ucast unat_numDomains_to_H le_maxDomain_eq_less_numDomains)
   apply (clarsimp simp: ccap_relation_def cap_to_H_simps cap_thread_cap_lift)
@@ -768,15 +767,15 @@ lemma decodeCNodeInvocation_ccorres:
                               apply simp
                               apply (wp injection_wp_E[OF refl])
                               apply (rule hoare_post_imp_R)
-                               apply (rule_tac Q'="\<lambda>rv. valid_pspace' and valid_queues
+                               apply (rule_tac Q'="\<lambda>rv. valid_pspace'
                                                     and valid_cap' rv and valid_objs'
                                                          and tcb_at' thread and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)"
                                            in hoare_vcg_R_conj)
                                 apply (rule deriveCap_Null_helper[OF deriveCap_derived])
                                apply wp
                               apply (clarsimp simp: cte_wp_at_ctes_of)
-                              apply (simp add: is_derived'_def badge_derived'_def
-                                               valid_tcb_state'_def)
+                              apply (fastforce simp: is_derived'_def badge_derived'_def
+                                                     valid_tcb_state'_def)
                              apply (simp add: Collect_const_mem all_ex_eq_helper)
                              apply (vcg exspec=deriveCap_modifies)
                             apply wp
@@ -844,14 +843,14 @@ lemma decodeCNodeInvocation_ccorres:
                                   apply (simp add: conj_comms valid_tcb_state'_def)
                                   apply (wp injection_wp_E[OF refl])
                                   apply (rule hoare_post_imp_R)
-                                   apply (rule_tac Q'="\<lambda>rv. valid_pspace' and valid_queues
+                                   apply (rule_tac Q'="\<lambda>rv. valid_pspace'
                                                         and valid_cap' rv and valid_objs'
                                                              and tcb_at' thread and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)"
                                                in hoare_vcg_R_conj)
                                     apply (rule deriveCap_Null_helper [OF deriveCap_derived])
                                    apply wp
                                   apply (clarsimp simp: cte_wp_at_ctes_of)
-                                  apply (simp add: is_derived'_def badge_derived'_def)
+                                  apply (fastforce simp: is_derived'_def badge_derived'_def)
                                  apply (simp add: Collect_const_mem all_ex_eq_helper)
                                  apply (vcg exspec=deriveCap_modifies)
                                 apply (simp add: Collect_const_mem)
@@ -959,12 +958,14 @@ lemma decodeCNodeInvocation_ccorres:
                      apply (rule_tac Q'="\<lambda>a b. cte_wp_at' (\<lambda>x. True) a b \<and> invs' b \<and>
                        tcb_at' thread b  \<and> sch_act_wf (ksSchedulerAction b) b \<and> valid_tcb_state' Restart b
                        \<and> Q2 b" for Q2 in  hoare_post_imp_R)
-                       prefer 2
-                       apply (clarsimp simp:cte_wp_at_ctes_of)
-                       apply (drule ctes_of_valid')
-                         apply (erule invs_valid_objs')
-                        apply (clarsimp simp:valid_updateCapDataI invs_queues invs_valid_objs' invs_valid_pspace')
-                       apply (assumption)
+                      prefer 2
+                      apply (clarsimp simp:cte_wp_at_ctes_of)
+                      apply (drule ctes_of_valid')
+                       apply (erule invs_valid_objs')
+                      apply (frule invs_pspace_aligned')
+                      apply (frule invs_pspace_distinct')
+                      apply (clarsimp simp:valid_updateCapDataI invs_valid_objs' invs_valid_pspace')
+                      apply assumption
                      apply (wp hoare_vcg_all_lift_R injection_wp_E[OF refl]
                                lsfco_cte_at' hoare_vcg_const_imp_lift_R
                            )+
@@ -1359,7 +1360,7 @@ lemma decodeCNodeInvocation_ccorres:
    apply simp
    apply (vcg exspec=getSyscallArg_modifies)
   apply (clarsimp simp: valid_tcb_state'_def invs_valid_objs' invs_valid_pspace'
-                        ct_in_state'_def pred_tcb_at' invs_queues
+                        ct_in_state'_def pred_tcb_at'
                         cur_tcb'_def word_sle_def word_sless_def
                         unat_lt2p[where 'a=32, folded word_bits_def])
   apply (rule conjI)
@@ -1391,9 +1392,6 @@ end
 
 context begin interpretation Arch . (*FIXME: arch_split*)
 
-crunch valid_queues[wp]: insertNewCap "valid_queues"
-  (wp: crunch_wps)
-
 lemmas setCTE_def3 = setCTE_def2[THEN eq_reflection]
 
 lemma setCTE_sch_act_wf[wp]:
@@ -3310,8 +3308,7 @@ lemma decodeUntypedInvocation_ccorres_helper:
                             | Some n \<Rightarrow> args ! 4 + args ! 5 - 1 < 2 ^ n)
                       and sch_act_simple and ct_active'" in hoare_post_imp_R)
                    prefer 2
-                   apply (clarsimp simp: invs_valid_objs' invs_mdb'
-                                         invs_queues ct_in_state'_def pred_tcb_at')
+                   apply (clarsimp simp: invs_valid_objs' invs_mdb' ct_in_state'_def pred_tcb_at')
                    apply (subgoal_tac "ksCurThread s \<noteq> ksIdleThread sa")
                     prefer 2
                     apply clarsimp
diff --git a/proof/crefine/ARM_HYP/IpcCancel_C.thy b/proof/crefine/ARM_HYP/IpcCancel_C.thy
index c9b6048513..78d4b3fe8b 100644
--- a/proof/crefine/ARM_HYP/IpcCancel_C.thy
+++ b/proof/crefine/ARM_HYP/IpcCancel_C.thy
@@ -15,12 +15,12 @@ begin
 declare ctcb_size_bits_ge_4[simp]
 
 lemma cready_queues_index_to_C_in_range':
-  assumes prems: "qdom \<le> ucast maxDom" "prio \<le> ucast maxPrio"
+  assumes prems: "qdom \<le> maxDomain" "prio \<le> maxPriority"
   shows "cready_queues_index_to_C qdom prio < num_tcb_queues"
 proof -
   have P: "unat prio < numPriorities"
     using prems
-    by (simp add: numPriorities_def seL4_MaxPrio_def Suc_le_lessD unat_le_helper)
+    by (simp add: numPriorities_def Suc_le_lessD unat_le_helper maxDomain_def maxPriority_def)
   have Q: "unat qdom < numDomains"
     using prems
     by (simp add: maxDom_to_H le_maxDomain_eq_less_numDomains word_le_nat_alt)
@@ -34,56 +34,18 @@ lemmas cready_queues_index_to_C_in_range =
 
 lemma cready_queues_index_to_C_inj:
   "\<lbrakk> cready_queues_index_to_C qdom prio = cready_queues_index_to_C qdom' prio';
-     prio \<le> ucast maxPrio; prio' \<le> ucast maxPrio \<rbrakk> \<Longrightarrow> prio = prio' \<and> qdom = qdom'"
+     prio \<le> maxPriority; prio' \<le> maxPriority \<rbrakk> \<Longrightarrow> prio = prio' \<and> qdom = qdom'"
   apply (rule context_conjI)
-  apply (auto simp: cready_queues_index_to_C_def numPriorities_def
+  apply (auto simp: cready_queues_index_to_C_def numPriorities_def maxPriority_def
                     seL4_MaxPrio_def word_le_nat_alt dest: arg_cong[where f="\<lambda>x. x mod 256"])
   done
 
 lemma cready_queues_index_to_C_distinct:
-  "\<lbrakk> qdom = qdom' \<longrightarrow> prio \<noteq> prio'; prio \<le> ucast maxPrio; prio' \<le> ucast maxPrio \<rbrakk>
+  "\<lbrakk> qdom = qdom' \<longrightarrow> prio \<noteq> prio'; prio \<le> maxPriority; prio' \<le> maxPriority \<rbrakk>
    \<Longrightarrow> cready_queues_index_to_C qdom prio \<noteq> cready_queues_index_to_C qdom' prio'"
   apply (auto simp: cready_queues_index_to_C_inj)
   done
 
-lemma cstate_relation_ksReadyQueues_update:
-  "\<lbrakk> cstate_relation hs cs; arr = ksReadyQueues_' cs;
-     sched_queue_relation' (clift (t_hrs_' cs)) v (head_C v') (end_C v');
-     qdom \<le> ucast maxDom; prio \<le> ucast maxPrio \<rbrakk>
-    \<Longrightarrow> cstate_relation (ksReadyQueues_update (\<lambda>qs. qs ((qdom, prio) := v)) hs)
-                        (ksReadyQueues_'_update (\<lambda>_. Arrays.update arr
-                                                        (cready_queues_index_to_C qdom prio) v') cs)"
-  apply (clarsimp simp: cstate_relation_def Let_def
-                        cmachine_state_relation_def
-                        carch_state_relation_def carch_globals_def
-                        cready_queues_relation_def seL4_MinPrio_def minDom_def)
-  apply (frule cready_queues_index_to_C_in_range, assumption)
-  apply clarsimp
-  apply (frule_tac qdom=qdoma and prio=prioa in cready_queues_index_to_C_in_range, assumption)
-  apply (frule cready_queues_index_to_C_distinct, assumption+)
-  apply clarsimp
-  done
-
-lemma cmap_relation_drop_fun_upd:
-  "\<lbrakk> cm x = Some v; \<And>v''. rel v'' v = rel v'' v' \<rbrakk>
-      \<Longrightarrow> cmap_relation am (cm (x \<mapsto> v')) f rel
-            = cmap_relation am cm f rel"
-  apply (simp add: cmap_relation_def)
-  apply (rule conj_cong[OF refl])
-  apply (rule ball_cong[OF refl])
-  apply (auto split: if_split)
-  done
-
-lemma valid_queuesD':
-  "\<lbrakk> obj_at' (inQ d p) t s; valid_queues' s \<rbrakk>
-        \<Longrightarrow> t \<in> set (ksReadyQueues s (d, p))"
-  by (simp add: valid_queues'_def)
-
-lemma invs_valid_queues'[elim!]:
-  "invs' s \<Longrightarrow> valid_queues' s"
-  by (simp add: invs'_def valid_state'_def)
-
-
 lemma ntfn_ptr_get_queue_spec:
   "\<forall>s. \<Gamma> \<turnstile> {\<sigma>. s = \<sigma> \<and> \<sigma> \<Turnstile>\<^sub>c \<^bsup>\<sigma>\<^esup>ntfnPtr} \<acute>ret__struct_tcb_queue_C :== PROC ntfn_ptr_get_queue(\<acute>ntfnPtr)
        \<lbrace>head_C \<acute>ret__struct_tcb_queue_C = Ptr (ntfnQueue_head_CL (notification_lift (the (cslift s \<^bsup>s\<^esup>ntfnPtr)))) \<and>
@@ -229,22 +191,19 @@ lemma cancelSignal_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-            \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-           apply simp
-           apply (rule cendpoint_relation_ntfn_queue [OF invs_sym'], assumption+)
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+          apply simp
+          apply (rule cendpoint_relation_ntfn_queue [OF invs_sym'], assumption+)
            apply simp
-           apply (erule (1) map_to_ko_atI')
-          \<comment> \<open>ntfn relation\<close>
-          apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
-          apply (simp add: cnotification_relation_def Let_def NtfnState_Idle_def)
-          apply (simp add: carch_state_relation_def carch_globals_def)
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         apply (clarsimp simp: comp_def)
+          apply (erule (1) map_to_ko_atI')
+         \<comment> \<open>ntfn relation\<close>
+         apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
+         apply (simp add: cnotification_relation_def Let_def NtfnState_Idle_def)
+         apply (simp add: carch_state_relation_def carch_globals_def)
         apply (simp add: carch_state_relation_def carch_globals_def
                          typ_heap_simps')
        apply (simp add: cmachine_state_relation_def)
@@ -267,30 +226,27 @@ lemma cancelSignal_ccorres_helper:
                        typ_heap_simps')
       apply (elim conjE)
       apply (intro conjI)
-           \<comment> \<open>tcb relation\<close>
-           apply (erule ctcb_relation_null_queue_ptrs)
-           apply (clarsimp simp: comp_def)
-          \<comment> \<open>ep relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-          apply simp
-          apply (rule cendpoint_relation_ntfn_queue)
-              apply fastforce
-             apply assumption+
-          apply simp
-          apply (erule (1) map_to_ko_atI')
-         \<comment> \<open>ntfn relation\<close>
-         apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
-          apply (simp add: cnotification_relation_def Let_def isWaitingNtfn_def
-                    split: ntfn.splits split del: if_split)
-          apply (erule iffD1 [OF tcb_queue_relation'_cong [OF refl _ _ refl], rotated -1])
-           apply (clarsimp simp add: Ptr_ptr_val h_t_valid_clift_Some_iff)
-           apply (simp add: tcb_queue_relation'_next_mask)
-          apply (clarsimp simp add: Ptr_ptr_val h_t_valid_clift_Some_iff)
-          apply (simp add: tcb_queue_relation'_prev_mask)
+          \<comment> \<open>tcb relation\<close>
+          apply (erule ctcb_relation_null_ep_ptrs)
+          apply (clarsimp simp: comp_def)
+         \<comment> \<open>ep relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cendpoint_relation_ntfn_queue)
+             apply fastforce
+            apply assumption+
          apply simp
-        \<comment> \<open>queue relation\<close>
-        apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-        apply (clarsimp simp: comp_def)
+         apply (erule (1) map_to_ko_atI')
+        \<comment> \<open>ntfn relation\<close>
+        apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
+         apply (simp add: cnotification_relation_def Let_def isWaitingNtfn_def
+                   split: ntfn.splits split del: if_split)
+         apply (erule iffD1 [OF tcb_queue_relation'_cong [OF refl _ _ refl], rotated -1])
+          apply (clarsimp simp add: Ptr_ptr_val h_t_valid_clift_Some_iff)
+          apply (simp add: tcb_queue_relation'_next_mask)
+         apply (clarsimp simp add: Ptr_ptr_val h_t_valid_clift_Some_iff)
+         apply (simp add: tcb_queue_relation'_prev_mask)
+        apply simp
        apply (simp add: carch_state_relation_def carch_globals_def
                         typ_heap_simps')
       apply (simp add: cmachine_state_relation_def)
@@ -458,68 +414,6 @@ lemma isRunnable_ccorres [corres]:
        apply (simp add: ThreadState_defs)+
   done
 
-
-
-lemma tcb_queue_relation_update_head:
-  fixes getNext_update :: "(tcb_C ptr \<Rightarrow> tcb_C ptr) \<Rightarrow> tcb_C \<Rightarrow> tcb_C" and
-  getPrev_update :: "(tcb_C ptr \<Rightarrow> tcb_C ptr) \<Rightarrow> tcb_C \<Rightarrow> tcb_C"
-  assumes qr: "tcb_queue_relation getNext getPrev mp queue NULL qhead"
-  and     qh': "qhead' \<notin> tcb_ptr_to_ctcb_ptr ` set queue"
-  and  cs_tcb: "mp qhead' = Some tcb"
-  and valid_ep: "\<forall>t\<in>set queue. tcb_at' t s" "distinct queue"
-  and     qhN: "qhead' \<noteq> NULL"
-  and     fgN: "fg_cons getNext (getNext_update \<circ> (\<lambda>x _. x))"
-  and     fgP: "fg_cons getPrev (getPrev_update \<circ> (\<lambda>x _. x))"
-  and     npu: "\<And>f t. getNext (getPrev_update f t) = getNext t"
-  and     pnu: "\<And>f t. getPrev (getNext_update f t) = getPrev t"
-  shows   "tcb_queue_relation getNext getPrev
-                 (upd_unless_null qhead (getPrev_update (\<lambda>_. qhead') (the (mp qhead)))
-                       (mp(qhead' := Some (getPrev_update (\<lambda>_. NULL) (getNext_update (\<lambda>_. qhead)  tcb)))))
-                 (ctcb_ptr_to_tcb_ptr qhead' # queue) NULL qhead'"
-  using qr qh' cs_tcb valid_ep qhN
-  apply (subgoal_tac "qhead \<noteq> qhead'")
-  apply (clarsimp simp: pnu upd_unless_null_def fg_consD1 [OF fgN] fg_consD1 [OF fgP] pnu npu)
-  apply (cases queue)
-    apply simp
-   apply (frule (2) tcb_queue_relation_next_not_NULL)
-    apply simp
-   apply (clarsimp simp: fg_consD1 [OF fgN] fg_consD1 [OF fgP] pnu npu)
-   apply (subst tcb_queue_relation_cong [OF refl refl refl, where mp' = mp])
-    apply (clarsimp simp: inj_eq)
-    apply (intro impI conjI)
-     apply (frule_tac x = x in imageI [where f = tcb_ptr_to_ctcb_ptr])
-     apply simp
-    apply simp
-   apply simp
-  apply clarsimp
-  apply (cases queue)
-   apply simp
-  apply simp
-  done
-
-lemma tcbSchedEnqueue_update:
-  assumes sr: "sched_queue_relation' mp queue qhead qend"
-  and     qh': "qhead' \<notin> tcb_ptr_to_ctcb_ptr ` set queue"
-  and  cs_tcb: "mp qhead' = Some tcb"
-  and valid_ep: "\<forall>t\<in>set queue. tcb_at' t s" "distinct queue"
-  and     qhN: "qhead' \<noteq> NULL"
-  shows
-  "sched_queue_relation'
-                   (upd_unless_null qhead (tcbSchedPrev_C_update (\<lambda>_. qhead') (the (mp qhead)))
-                (mp(qhead' \<mapsto> tcb\<lparr>tcbSchedNext_C := qhead, tcbSchedPrev_C := NULL\<rparr>)))
-            (ctcb_ptr_to_tcb_ptr qhead' # queue) qhead' (if qend = NULL then qhead' else qend)"
-  using sr qh' cs_tcb valid_ep qhN
-  apply -
-  apply (erule tcb_queue_relationE')
-  apply (rule tcb_queue_relationI')
-   apply (erule (5) tcb_queue_relation_update_head
-        [where getNext_update = tcbSchedNext_C_update and getPrev_update = tcbSchedPrev_C_update], simp_all)[1]
-  apply simp
-  apply (intro impI)
-  apply (erule (1) tcb_queue_relation_not_NULL')
-  apply simp
-  done
-
 lemma tcb_ptr_to_ctcb_ptr_imageD:
   "x \<in> tcb_ptr_to_ctcb_ptr ` S \<Longrightarrow> ctcb_ptr_to_tcb_ptr x \<in> S"
   apply (erule imageE)
@@ -532,94 +426,8 @@ lemma ctcb_ptr_to_tcb_ptr_imageI:
   apply simp
   done
 
-lemma tcb_queue'_head_end_NULL:
-  assumes qr: "tcb_queue_relation' getNext getPrev mp queue qhead qend"
-  and   tat: "\<forall>t\<in>set queue. tcb_at' t s"
-  shows "(qend = NULL) = (qhead = NULL)"
-  using qr tat
-  apply -
-  apply (erule tcb_queue_relationE')
-  apply (simp add: tcb_queue_head_empty_iff)
-  apply (rule impI)
-  apply (rule tcb_at_not_NULL)
-  apply (erule bspec)
-  apply simp
-  done
-
-lemma tcb_queue_relation_qhead_mem:
-  "\<lbrakk> tcb_queue_relation getNext getPrev mp queue NULL qhead;
-  (\<forall>tcb\<in>set queue. tcb_at' tcb t) \<rbrakk>
-  \<Longrightarrow> qhead \<noteq> NULL \<longrightarrow> ctcb_ptr_to_tcb_ptr qhead \<in> set queue"
-  by (clarsimp simp: tcb_queue_head_empty_iff tcb_queue_relation_head_hd)
-
-lemma tcb_queue_relation_qhead_valid:
-  "\<lbrakk> tcb_queue_relation getNext getPrev (cslift s') queue NULL qhead;
-  (s, s') \<in> rf_sr; (\<forall>tcb\<in>set queue. tcb_at' tcb s) \<rbrakk>
-  \<Longrightarrow> qhead \<noteq> NULL \<longrightarrow> s' \<Turnstile>\<^sub>c qhead"
-  apply (frule (1) tcb_queue_relation_qhead_mem)
-  apply clarsimp
-  apply(drule (3) tcb_queue_memberD)
-  apply (simp add: h_t_valid_clift_Some_iff)
-  done
-
-lemmas tcb_queue_relation_qhead_mem' = tcb_queue_relation_qhead_mem [OF tcb_queue_relation'_queue_rel]
-lemmas tcb_queue_relation_qhead_valid' = tcb_queue_relation_qhead_valid [OF tcb_queue_relation'_queue_rel]
-
-
-lemma valid_queues_valid_q:
-  "valid_queues s \<Longrightarrow> (\<forall>tcb\<in>set (ksReadyQueues s (qdom, prio)). tcb_at' tcb s) \<and> distinct (ksReadyQueues s (qdom, prio))"
-  apply (clarsimp simp: valid_queues_def valid_queues_no_bitmap_def)
-  apply (drule spec [where x = qdom])
-  apply (drule spec [where x = prio])
-  apply clarsimp
-  apply (drule (1) bspec, erule obj_at'_weakenE)
-  apply simp
-  done
-
-lemma invs_valid_q:
-  "invs' s \<Longrightarrow> (\<forall>tcb\<in>set (ksReadyQueues s (qdom, prio)). tcb_at' tcb s) \<and> distinct (ksReadyQueues s (qdom, prio))"
-  apply (rule valid_queues_valid_q)
-  apply (clarsimp simp: invs'_def valid_state'_def)
-  done
-
-lemma tcbQueued_not_in_queues:
-  assumes vq: "valid_queues s"
-  and    objat: "obj_at' (Not \<circ> tcbQueued) thread s"
-  shows   "thread \<notin> set (ksReadyQueues s (d, p))"
-  using vq objat
-  apply -
-  apply clarsimp
-  apply (drule (1) valid_queues_obj_at'D)
-  apply (erule obj_atE')+
-  apply (clarsimp simp: inQ_def)
-  done
-
 declare unat_ucast_8_32[simp]
 
-lemma rf_sr_sched_queue_relation:
-  "\<lbrakk> (s, s') \<in> rf_sr; d \<le> ucast maxDom; p \<le> ucast maxPrio \<rbrakk>
-  \<Longrightarrow> sched_queue_relation' (cslift s') (ksReadyQueues s (d, p))
-                                        (head_C (index (ksReadyQueues_' (globals s'))
-                                                       (cready_queues_index_to_C d p)))
-                                        (end_C (index (ksReadyQueues_' (globals s'))
-                                                      (cready_queues_index_to_C d p)))"
-  unfolding rf_sr_def cstate_relation_def cready_queues_relation_def
-  apply (clarsimp simp: Let_def seL4_MinPrio_def minDom_def)
-  done
-
-lemma ready_queue_not_in:
-  assumes  vq: "valid_queues s"
-  and     inq: "t \<in> set (ksReadyQueues s (d, p))"
-  and     neq: "d \<noteq> d' \<or> p \<noteq> p'"
-  shows   "t \<notin> set (ksReadyQueues s (d', p'))"
-proof
-  assume "t \<in> set (ksReadyQueues s (d', p'))"
-  hence "obj_at' (inQ d' p') t s" using vq by (rule valid_queues_obj_at'D)
-  moreover have "obj_at' (inQ d p) t s" using inq vq by (rule valid_queues_obj_at'D)
-  ultimately show False using neq
-    by (clarsimp elim!: obj_atE' simp: inQ_def)
-qed
-
 lemma ctcb_relation_unat_prio_eq:
   "ctcb_relation tcb tcb' \<Longrightarrow> unat (tcbPriority tcb) = unat (tcbPriority_C tcb')"
   apply (clarsimp simp: ctcb_relation_def)
@@ -653,139 +461,6 @@ lemma threadSet_queued_ccorres [corres]:
   apply (clarsimp simp: typ_heap_simps)
   done
 
-lemma ccorres_pre_getQueue:
-  assumes cc: "\<And>queue. ccorres r xf (P queue) (P' queue) hs (f queue) c"
-  shows   "ccorres r xf (\<lambda>s. P (ksReadyQueues s (d, p)) s \<and> d \<le> maxDomain \<and> p \<le> maxPriority)
-                        {s'. \<forall>queue. (let cqueue = index (ksReadyQueues_' (globals s'))
-                                                         (cready_queues_index_to_C d p) in
-                                      sched_queue_relation' (cslift s') queue (head_C cqueue) (end_C cqueue)) \<longrightarrow> s' \<in> P' queue}
-           hs (getQueue d p >>= (\<lambda>queue. f queue)) c"
-  apply (rule ccorres_guard_imp2)
-  apply (rule ccorres_symb_exec_l2)
-     defer
-     defer
-     apply (rule gq_sp)
-    defer
-    apply (rule ccorres_guard_imp)
-    apply (rule cc)
-     apply clarsimp
-     apply assumption
-    apply assumption
-   apply (clarsimp simp: getQueue_def gets_exs_valid)
-  apply clarsimp
-  apply (drule spec, erule mp)
-  apply (simp add: Let_def)
-  apply (erule rf_sr_sched_queue_relation)
-   apply (simp add: maxDom_to_H maxPrio_to_H)+
-  done
-
-lemma state_relation_queue_update_helper':
-  "\<lbrakk> (s, s') \<in> rf_sr;
-     (\<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s)
-                                       \<and> distinct (ksReadyQueues s (d, p)));
-          globals t = ksReadyQueues_'_update
-             (\<lambda>_. Arrays.update (ksReadyQueues_' (globals s')) prio' q')
-             (t_hrs_'_update f (globals s'));
-          sched_queue_relation' (cslift t) q (head_C q') (end_C q');
-          cslift t |` ( - tcb_ptr_to_ctcb_ptr ` S )
-             = cslift s' |` ( - tcb_ptr_to_ctcb_ptr ` S );
-          option_map tcb_null_sched_ptrs \<circ> cslift t
-            = option_map tcb_null_sched_ptrs \<circ> cslift s';
-          cslift_all_but_tcb_C t s';
-          zero_ranges_are_zero (gsUntypedZeroRanges s) (f (t_hrs_' (globals s')))
-              = zero_ranges_are_zero (gsUntypedZeroRanges s) (t_hrs_' (globals s'));
-          hrs_htd (t_hrs_' (globals t)) = hrs_htd (t_hrs_' (globals s'));
-          prio' = cready_queues_index_to_C qdom prio;
-          \<forall>x \<in> S. obj_at' (inQ qdom prio) x s
-                   \<or> (obj_at' (\<lambda>tcb. tcbPriority tcb = prio) x s
-                       \<and> obj_at' (\<lambda>tcb. tcbDomain tcb = qdom) x s)
-                   \<or> (tcb_at' x s \<and> (\<forall>d' p'. (d' \<noteq> qdom \<or> p' \<noteq> prio)
-                                         \<longrightarrow> x \<notin> set (ksReadyQueues s (d', p'))));
-          S \<noteq> {}; qdom \<le> ucast maxDom; prio \<le> ucast maxPrio \<rbrakk>
-      \<Longrightarrow> (s \<lparr>ksReadyQueues := (ksReadyQueues s)((qdom, prio) := q)\<rparr>, t) \<in> rf_sr"
-  apply (subst(asm) disj_imp_rhs)
-   apply (subst obj_at'_and[symmetric])
-   apply (rule disjI1, erule obj_at'_weakenE, simp add: inQ_def)
-  apply (subst(asm) disj_imp_rhs)
-   apply (subst(asm) obj_at'_and[symmetric])
-   apply (rule conjI, erule obj_at'_weakenE, simp)
-   apply (rule allI, rule allI)
-   apply (drule_tac x=d' in spec)
-   apply (drule_tac x=p' in spec)
-   apply clarsimp
-   apply (drule(1) bspec)
-   apply (clarsimp simp: inQ_def obj_at'_def)
-  apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def)
-  apply (intro conjI)
-      \<comment> \<open>cpspace_relation\<close>
-     apply (erule nonemptyE, drule(1) bspec)
-     apply (clarsimp simp: cpspace_relation_def)
-     apply (drule obj_at_ko_at', clarsimp)
-     apply (rule cmap_relationE1, assumption,
-            erule ko_at_projectKO_opt)
-     apply (frule null_sched_queue)
-     apply (frule null_sched_epD)
-     apply (intro conjI)
-       \<comment> \<open>tcb relation\<close>
-       apply (drule ctcb_relation_null_queue_ptrs,
-              simp_all)[1]
-      \<comment> \<open>endpoint relation\<close>
-      apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-      apply simp
-      apply (erule cendpoint_relation_upd_tcb_no_queues, simp+)
-     \<comment> \<open>ntfn relation\<close>
-     apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-     apply simp
-     apply (erule cnotification_relation_upd_tcb_no_queues, simp+)
-    \<comment> \<open>ready queues\<close>
-    apply (simp add: cready_queues_relation_def Let_def cready_queues_index_to_C_in_range
-                     seL4_MinPrio_def minDom_def)
-    apply clarsimp
-    apply (frule cready_queues_index_to_C_distinct, assumption+)
-    apply (clarsimp simp: cready_queues_index_to_C_in_range all_conj_distrib)
-    apply (rule iffD1 [OF tcb_queue_relation'_cong[OF refl], rotated -1],
-           drule spec, drule spec, erule mp, simp+)
-    apply clarsimp
-    apply (drule_tac x="tcb_ptr_to_ctcb_ptr x" in fun_cong)+
-    apply (clarsimp simp: restrict_map_def
-                   split: if_split_asm)
-   apply (simp_all add: carch_state_relation_def cmachine_state_relation_def
-                        h_t_valid_clift_Some_iff)
-  done
-
-lemma state_relation_queue_update_helper:
-  "\<lbrakk> (s, s') \<in> rf_sr; valid_queues s;
-          globals t = ksReadyQueues_'_update
-             (\<lambda>_. Arrays.update (ksReadyQueues_' (globals s')) prio' q')
-             (t_hrs_'_update f (globals s'));
-          sched_queue_relation' (cslift t) q (head_C q') (end_C q');
-          cslift t |` ( - tcb_ptr_to_ctcb_ptr ` S )
-             = cslift s' |` ( - tcb_ptr_to_ctcb_ptr ` S );
-          option_map tcb_null_sched_ptrs \<circ> cslift t
-            = option_map tcb_null_sched_ptrs \<circ> cslift s';
-          cslift_all_but_tcb_C t s';
-          zero_ranges_are_zero (gsUntypedZeroRanges s) (f (t_hrs_' (globals s')))
-              = zero_ranges_are_zero (gsUntypedZeroRanges s) (t_hrs_' (globals s'));
-          hrs_htd (t_hrs_' (globals t)) = hrs_htd (t_hrs_' (globals s'));
-          prio' = cready_queues_index_to_C qdom prio;
-          \<forall>x \<in> S. obj_at' (inQ qdom prio) x s
-                   \<or> (obj_at' (\<lambda>tcb. tcbPriority tcb = prio) x s
-                       \<and> obj_at' (\<lambda>tcb. tcbDomain tcb = qdom) x s)
-                   \<or> (tcb_at' x s \<and> (\<forall>d' p'. (d' \<noteq> qdom \<or> p' \<noteq> prio)
-                                         \<longrightarrow> x \<notin> set (ksReadyQueues s (d', p'))));
-          S \<noteq> {}; qdom \<le> ucast maxDom; prio \<le> ucast maxPrio \<rbrakk>
-      \<Longrightarrow> (s \<lparr>ksReadyQueues := (ksReadyQueues s)((qdom, prio) := q)\<rparr>, t) \<in> rf_sr"
-  apply (subgoal_tac "\<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s)
-                           \<and> distinct(ksReadyQueues s (d, p))")
-   apply (erule(5) state_relation_queue_update_helper', simp_all)
-  apply (clarsimp simp: valid_queues_def valid_queues_no_bitmap_def)
-  apply (drule_tac x=d in spec)
-  apply (drule_tac x=p in spec)
-  apply (clarsimp)
-  apply (drule(1) bspec)
-  apply (erule obj_at'_weakenE, clarsimp)
-  done
-
 (* FIXME: move *)
 lemma cmap_relation_no_upd:
   "\<lbrakk> cmap_relation a c f rel; a p = Some ko; rel ko v; inj f \<rbrakk> \<Longrightarrow> cmap_relation a (c(f p \<mapsto> v)) f rel"
@@ -827,8 +502,8 @@ lemma cready_queues_index_to_C_def2:
 lemma ready_queues_index_spec:
   "\<forall>s. \<Gamma> \<turnstile> {s'. s' = s \<and> (Kernel_Config.numDomains \<le> 1 \<longrightarrow> dom_' s' = 0)}
        Call ready_queues_index_'proc
-       \<lbrace>\<acute>ret__unsigned_long = (dom_' s) * 0x100 + (prio_' s)\<rbrace>"
-  by vcg (simp add: numDomains_sge_1_simp)
+       \<lbrace>\<acute>ret__unsigned_long = (dom_' s) * word_of_nat numPriorities + (prio_' s)\<rbrace>"
+  by vcg (simp add: numDomains_sge_1_simp numPriorities_def)
 
 lemma prio_to_l1index_spec:
   "\<forall>s. \<Gamma> \<turnstile> {s} Call prio_to_l1index_'proc
@@ -964,15 +639,6 @@ lemma cmachine_state_relation_enqueue_simp:
   unfolding cmachine_state_relation_def
   by clarsimp
 
-lemma tcb_queue_relation'_empty_ksReadyQueues:
-  "\<lbrakk> sched_queue_relation' (cslift x) (q s) NULL NULL ; \<forall>t\<in> set (q s). tcb_at' t s  \<rbrakk> \<Longrightarrow> q s = []"
-  apply (clarsimp simp add: tcb_queue_relation'_def)
-  apply (subst (asm) eq_commute)
-  apply (cases "q s" rule: rev_cases, simp)
-  apply (clarsimp simp: tcb_at_not_NULL)
-  done
-
-
 lemma invert_prioToL1Index_c_simp:
   "p \<le> maxPriority
    \<Longrightarrow>
@@ -986,13 +652,247 @@ lemma c_invert_assist: "7 - (ucast (p :: priority) >> 5 :: machine_word) < 8"
   using prio_ucast_shiftr_wordRadix_helper'[simplified wordRadix_def]
   by - (rule word_less_imp_diff_less, simp_all)
 
+lemma addToBitmap_ccorres:
+  "ccorres dc xfdc
+     (K (tdom \<le> maxDomain \<and> prio \<le> maxPriority)) (\<lbrace>\<acute>dom = ucast tdom\<rbrace> \<inter> \<lbrace>\<acute>prio = ucast prio\<rbrace>) hs
+     (addToBitmap tdom prio) (Call addToBitmap_'proc)"
+  supply prio_and_dom_limit_helpers[simp] invert_prioToL1Index_c_simp[simp]
+  apply (rule ccorres_from_vcg)
+  apply (rule allI, rule conseqPre, vcg)
+  apply clarsimp
+  apply (frule maxDomain_le_unat_ucast_explicit)
+  apply (clarsimp simp: getQueue_def gets_def get_def setQueue_def modify_def
+                        put_def bind_def return_def bitmap_fun_defs)
+  apply (intro conjI impI allI)
+   apply (fastforce simp: c_invert_assist l2BitmapSize_def' wordRadix_def)
+  apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
+                        carch_state_relation_def cmachine_state_relation_def)
+  apply (rule conjI)
+   apply (clarsimp intro!: cbitmap_L1_relation_bit_set)
+  apply (fastforce dest!: cbitmap_L2_relation_bit_set simp: wordRadix_def mask_def)
+  done
+
+lemma rf_sr_tcb_update_twice:
+  "h_t_valid (hrs_htd (hrs2 (globals s') (t_hrs_' (gs2 (globals s'))))) c_guard
+      (ptr (t_hrs_' (gs2 (globals s'))) (globals s'))
+    \<Longrightarrow> ((s, globals_update (\<lambda>gs. t_hrs_'_update (\<lambda>ths.
+        hrs_mem_update (heap_update (ptr ths gs :: tcb_C ptr) (v ths gs))
+            (hrs_mem_update (heap_update (ptr ths gs) (v' ths gs)) (hrs2 gs ths))) (gs2 gs)) s') \<in> rf_sr)
+    = ((s, globals_update (\<lambda>gs. t_hrs_'_update (\<lambda>ths.
+        hrs_mem_update (heap_update (ptr ths gs) (v ths gs)) (hrs2 gs ths)) (gs2 gs)) s') \<in> rf_sr)"
+  by (simp add: rf_sr_def cstate_relation_def Let_def
+                cpspace_relation_def typ_heap_simps'
+                carch_state_relation_def cmachine_state_relation_def
+                packed_heap_update_collapse_hrs)
+
+lemmas rf_sr_tcb_update_no_queue_gen2 =
+  rf_sr_obj_update_helper[OF rf_sr_tcb_update_no_queue_gen, simplified]
+
+lemma tcb_queue_prepend_ccorres:
+  "ccorres ctcb_queue_relation ret__struct_tcb_queue_C_'
+     (\<lambda>s. tcb_at' tcbPtr s
+          \<and> (tcbQueueHead queue \<noteq> None \<longleftrightarrow> tcbQueueEnd queue \<noteq> None)
+          \<and> (\<forall>head. tcbQueueHead queue = Some head \<longrightarrow> tcb_at' head s))
+     (\<lbrace>ctcb_queue_relation queue \<acute>queue\<rbrace> \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr tcbPtr\<rbrace>) hs
+     (tcbQueuePrepend queue tcbPtr) (Call tcb_queue_prepend_'proc)"
+  (is "ccorres _ _ ?abs _ _ _ _")
+  supply if_split[split del]
+  apply (cinit lift: tcb_')
+   \<comment> \<open>cinit is not able to lift queue_' because queue_' is later modified in the C program\<close>
+   apply (rule_tac xf'=queue_' in ccorres_abstract, ceqv, rename_tac cqueue)
+   apply (rule_tac P="ctcb_queue_relation queue cqueue" in ccorres_gen_asm2)
+   apply (rule_tac xf'=ret__unsigned_long_'
+               and val="from_bool (tcbQueueEmpty queue)"
+               and R="?abs"
+               and R'="\<lbrace>\<acute>queue = cqueue\<rbrace>"
+                in ccorres_symb_exec_r_known_rv)
+      apply (rule conseqPre, vcg)
+      apply (fastforce dest: tcb_at_not_NULL
+                       simp: ctcb_queue_relation_def option_to_ctcb_ptr_def tcbQueueEmpty_def)
+     apply ceqv
+    apply (rule_tac r'=ctcb_queue_relation and xf'=queue_' in ccorres_split_nothrow)
+        apply (rule_tac Q="?abs"
+                    and Q'="\<lambda>s'. queue_' s' = cqueue"
+                     in ccorres_cond_both')
+          apply fastforce
+         apply clarsimp
+         apply (rule ccorres_return[where R=\<top>])
+         apply (rule conseqPre, vcg)
+         apply (fastforce simp: ctcb_queue_relation_def option_to_ctcb_ptr_def)
+        apply (rule ccorres_seq_skip'[THEN iffD1])
+        apply (rule ccorres_rhs_assoc)+
+        apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+            apply (rule ccorres_Guard)
+            apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb tcbPtr s
+                                            \<and> head_C cqueue = option_to_ctcb_ptr (tcbQueueHead queue)}"
+                        and R="\<lbrace>head_C cqueue = option_to_ctcb_ptr (tcbQueueHead queue)\<rbrace>"
+                         in threadSet_ccorres_lemma4[where P=\<top> and P'=\<top>])
+             apply (rule conseqPre, vcg)
+             apply clarsimp
+             apply (frule (1) obj_at_cslift_tcb)
+             apply (fastforce intro!: rf_sr_tcb_update_no_queue_gen2
+                                simp: typ_heap_simps' tcb_cte_cases_def cteSizeBits_def
+                                      ctcb_relation_def option_to_ctcb_ptr_def)
+            apply (clarsimp simp: ctcb_relation_def option_to_ctcb_ptr_def split: if_splits)
+           apply ceqv
+          apply simp
+          apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+              apply (rule ccorres_Guard)
+              apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr
+                                              \<and> ko_at' tcb (the (tcbQueueHead queue)) s
+                                              \<and> head_C cqueue = option_to_ctcb_ptr (tcbQueueHead queue)}"
+                          and R="\<lbrace>head_C cqueue = option_to_ctcb_ptr (tcbQueueHead queue)\<rbrace>"
+                           in threadSet_ccorres_lemma4[where P=\<top> and P'=\<top>])
+               apply (rule conseqPre, vcg)
+               apply clarsimp
+               apply (frule (1) obj_at_cslift_tcb)
+               apply (fastforce intro!: rf_sr_tcb_update_no_queue_gen2
+                                  simp: typ_heap_simps' tcb_cte_cases_def cteSizeBits_def
+                                        ctcb_relation_def option_to_ctcb_ptr_def tcbQueueEmpty_def)
+              apply fastforce
+             apply ceqv
+            apply (rule ccorres_return_Skip')
+           apply wpsimp
+          apply vcg
+         apply wpsimp
+        apply vcg
+       apply ceqv
+      apply csymbr
+      apply (fastforce intro: ccorres_return_C')
+     apply wpsimp
+    apply vcg
+   apply clarsimp
+   apply (vcg exspec=tcb_queue_empty_modifies)
+  apply clarsimp
+  apply (frule (1) tcb_at_h_t_valid)
+  by (force dest: tcb_at_h_t_valid
+            simp: ctcb_queue_relation_def option_to_ctcb_ptr_def tcbQueueEmpty_def)
+
+lemma tcb_queue_append_ccorres:
+  "ccorres ctcb_queue_relation ret__struct_tcb_queue_C_'
+     (\<lambda>s. tcb_at' tcbPtr s
+          \<and> (tcbQueueHead queue \<noteq> None \<longleftrightarrow> tcbQueueEnd queue \<noteq> None)
+          \<and> (\<forall>head. tcbQueueHead queue = Some head \<longrightarrow> tcb_at' head s)
+          \<and> (\<forall>end. tcbQueueEnd queue = Some end \<longrightarrow> tcb_at' end s))
+     (\<lbrace>ctcb_queue_relation queue \<acute>queue\<rbrace> \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr tcbPtr\<rbrace>) hs
+     (tcbQueueAppend queue tcbPtr) (Call tcb_queue_append_'proc)"
+  (is "ccorres _ _ ?abs _ _ _ _")
+  supply if_split[split del]
+  apply (cinit lift: tcb_')
+   \<comment> \<open>cinit is not able to lift queue_' because queue_' is later modified in the C program\<close>
+   apply (rule_tac xf'=queue_' in ccorres_abstract, ceqv, rename_tac cqueue)
+   apply (rule_tac P="ctcb_queue_relation queue cqueue
+                      \<and> (tcbQueueHead queue \<noteq> None \<longleftrightarrow> tcbQueueEnd queue \<noteq> None)"
+                in ccorres_gen_asm2)
+   apply (rule_tac xf'=ret__unsigned_long_'
+               and val="from_bool (tcbQueueEmpty queue)"
+               and R="?abs"
+               and R'="\<lbrace>\<acute>queue = cqueue\<rbrace>"
+                in ccorres_symb_exec_r_known_rv)
+      apply (rule conseqPre, vcg)
+      apply (fastforce dest: tcb_at_not_NULL
+                       simp: ctcb_queue_relation_def option_to_ctcb_ptr_def tcbQueueEmpty_def)
+     apply ceqv
+    apply (rule_tac r'=ctcb_queue_relation and xf'=queue_' in ccorres_split_nothrow)
+        apply (rule_tac Q="?abs"
+                    and Q'="\<lambda>s'. queue_' s' = cqueue"
+                     in ccorres_cond_both')
+          apply (fastforce dest: tcb_at_not_NULL
+                           simp: ctcb_queue_relation_def option_to_ctcb_ptr_def)
+         apply clarsimp
+         apply (rule ccorres_return[where R=\<top>])
+         apply (rule conseqPre, vcg)
+         apply (fastforce simp: ctcb_queue_relation_def option_to_ctcb_ptr_def)
+        apply (rule ccorres_seq_skip'[THEN iffD1])
+        apply (rule ccorres_rhs_assoc)+
+        apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+            apply (rule ccorres_Guard)
+            apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb tcbPtr s
+                                            \<and> end_C cqueue = option_to_ctcb_ptr (tcbQueueEnd queue)}"
+                        and R="\<lbrace>end_C cqueue = option_to_ctcb_ptr (tcbQueueEnd queue)\<rbrace>"
+                         in threadSet_ccorres_lemma4[where P=\<top> and P'=\<top>])
+             apply (rule conseqPre, vcg)
+             apply clarsimp
+             apply (frule (1) obj_at_cslift_tcb)
+             apply (fastforce intro!: rf_sr_tcb_update_no_queue_gen2
+                                simp: typ_heap_simps' tcb_cte_cases_def cteSizeBits_def
+                                      ctcb_relation_def option_to_ctcb_ptr_def)
+            apply (clarsimp simp: ctcb_relation_def option_to_ctcb_ptr_def split: if_splits)
+           apply ceqv
+          apply simp
+          apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+              apply (rule ccorres_Guard)
+              apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr
+                                              \<and> ko_at' tcb (the (tcbQueueEnd queue)) s
+                                              \<and> end_C cqueue = option_to_ctcb_ptr (tcbQueueEnd queue)}"
+                          and R="\<lbrace>end_C cqueue = option_to_ctcb_ptr (tcbQueueEnd queue)\<rbrace>"
+                           in threadSet_ccorres_lemma4[where P=\<top> and P'=\<top>])
+               apply (rule conseqPre, vcg)
+               apply clarsimp
+               apply (frule (1) obj_at_cslift_tcb)
+               apply (fastforce intro!: rf_sr_tcb_update_no_queue_gen2
+                                  simp: typ_heap_simps' tcb_cte_cases_def cteSizeBits_def
+                                        ctcb_relation_def option_to_ctcb_ptr_def tcbQueueEmpty_def)
+              apply fastforce
+             apply ceqv
+            apply (rule ccorres_return_Skip')
+           apply wpsimp
+          apply vcg
+         apply wpsimp
+        apply vcg
+       apply ceqv
+      apply csymbr
+      apply (fastforce intro: ccorres_return_C')
+     apply wpsimp
+    apply vcg
+   apply (vcg exspec=tcb_queue_empty_modifies)
+  apply clarsimp
+  apply (frule (1) tcb_at_h_t_valid)
+  by (force dest: tcb_at_h_t_valid
+            simp: ctcb_queue_relation_def option_to_ctcb_ptr_def tcbQueueEmpty_def)
+
+lemma getQueue_ccorres:
+  "ccorres ctcb_queue_relation queue_'
+     (K (tdom \<le> maxDomain \<and> prio \<le> maxPriority))
+     \<lbrace>\<acute>idx___unsigned_long = word_of_nat (cready_queues_index_to_C tdom prio)\<rbrace> hs
+     (getQueue tdom prio) (\<acute>queue :== \<acute>ksReadyQueues.[unat \<acute>idx___unsigned_long])"
+  apply (rule ccorres_from_vcg)
+  apply (rule allI, rule conseqPre, vcg)
+  apply (clarsimp simp: getQueue_def gets_def get_def bind_def return_def)
+  apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def)
+  apply (frule (1) cready_queues_index_to_C_in_range)
+  apply (clarsimp simp: unat_of_nat_eq cready_queues_relation_def)
+  done
+
+lemma setQueue_ccorres:
+  "ctcb_queue_relation queue cqueue \<Longrightarrow>
+   ccorres dc xfdc
+     (K (tdom \<le> maxDomain \<and> prio \<le> maxPriority))
+     \<lbrace>\<acute>idx___unsigned_long = word_of_nat (cready_queues_index_to_C tdom prio)\<rbrace> hs
+     (setQueue tdom prio queue)
+     (Basic (\<lambda>s. globals_update
+                  (ksReadyQueues_'_update
+                   (\<lambda>_. Arrays.update (ksReadyQueues_' (globals s)) (unat (idx___unsigned_long_' s)) cqueue)) s))"
+  apply (rule ccorres_from_vcg)
+  apply (rule allI, rule conseqPre, vcg)
+  apply (clarsimp simp: setQueue_def get_def modify_def put_def bind_def)
+  apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
+                        carch_state_relation_def cmachine_state_relation_def)
+  apply (frule (1) cready_queues_index_to_C_in_range)
+  apply (clarsimp simp: unat_of_nat_eq cready_queues_relation_def)
+  apply (frule cready_queues_index_to_C_distinct, assumption+)
+  apply (frule_tac qdom=d and prio=p in cready_queues_index_to_C_in_range)
+   apply fastforce
+  apply clarsimp
+  done
+
+crunch (empty_fail) empty_fail[wp]: isRunnable
+
 lemma tcbSchedEnqueue_ccorres:
   "ccorres dc xfdc
-           (valid_queues and tcb_at' t and valid_objs')
-           (UNIV \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace>)
-           hs
-           (tcbSchedEnqueue t)
-           (Call tcbSchedEnqueue_'proc)"
+     (tcb_at' t and valid_objs' and pspace_aligned' and pspace_distinct')
+     \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace> hs
+     (tcbSchedEnqueue t) (Call tcbSchedEnqueue_'proc)"
 proof -
   note prio_and_dom_limit_helpers[simp] word_sle_def[simp] maxDom_to_H[simp] maxPrio_to_H[simp]
   note invert_prioToL1Index_c_simp[simp]
@@ -1002,35 +902,13 @@ proof -
   note word_less_1[simp del]
 
   show ?thesis
-  apply (cinit lift: tcb_')
-   apply (rule_tac r'="\<lambda>rv rv'. rv = to_bool rv'"
-               and xf'="ret__unsigned_'" in ccorres_split_nothrow)
-       apply (rule threadGet_vcg_corres)
-       apply (rule allI, rule conseqPre, vcg)
-       apply clarsimp
-       apply (drule obj_at_ko_at', clarsimp)
-       apply (drule spec, drule(1) mp, clarsimp)
-       apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-      apply ceqv
-     apply (simp add: when_def unless_def del: Collect_const split del: if_split)
-     apply (rule ccorres_cond[where R=\<top>])
-       apply (simp add: to_bool_def)
-      apply (rule ccorres_rhs_assoc)+
-      apply csymbr
-      apply csymbr
-      apply csymbr
-      apply csymbr
-      apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv"
-          and xf'="dom_'" in ccorres_split_nothrow)
-          apply (rule threadGet_vcg_corres)
-          apply (rule allI, rule conseqPre, vcg)
-          apply clarsimp
-          apply (drule obj_at_ko_at', clarsimp)
-          apply (drule spec, drule(1) mp, clarsimp)
-          apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-         apply ceqv
-        apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv"
-            and xf'="prio_'" in ccorres_split_nothrow)
+    apply (cinit lift: tcb_')
+     apply (rule ccorres_stateAssert)+
+     apply (rule ccorres_symb_exec_l)
+        apply (rule ccorres_assert)
+        apply (thin_tac runnable)
+        apply (rule_tac r'="\<lambda>rv rv'. rv = to_bool rv'" and xf'="ret__unsigned_'"
+                     in ccorres_split_nothrow)
             apply (rule threadGet_vcg_corres)
             apply (rule allI, rule conseqPre, vcg)
             apply clarsimp
@@ -1038,237 +916,246 @@ proof -
             apply (drule spec, drule(1) mp, clarsimp)
             apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
            apply ceqv
-          apply (rule ccorres_rhs_assoc2)+
-          apply (simp only: bind_assoc[symmetric])
-          apply (rule ccorres_split_nothrow_novcg_dc)
-             prefer 2
-             apply (rule ccorres_move_c_guard_tcb)
-             apply ctac
-            prefer 2
-            apply (wp, clarsimp, wp+)
-           apply (rule_tac P="\<lambda>s. valid_queues s \<and> (\<forall>p. t \<notin> set (ksReadyQueues s p))
-                                  \<and> (\<exists>tcb. ko_at' tcb t s \<and> tcbDomain tcb =rva
-                                  \<and> tcbPriority tcb = rvb \<and> valid_tcb' tcb s)"
-                       and P'=UNIV in ccorres_from_vcg)
-           apply (rule allI, rule conseqPre, vcg)
-           apply (clarsimp simp: getQueue_def gets_def get_def setQueue_def modify_def
-                                 put_def bind_def return_def bitmap_fun_defs null_def)
-           apply (clarsimp simp: queue_in_range valid_tcb'_def)
-           apply (rule conjI; clarsimp simp: queue_in_range)
-            (* queue is empty, set t to be new queue *)
-            apply (drule (1) obj_at_cslift_tcb)
-            apply clarsimp
-            apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb"
-                     in rf_sr_sched_queue_relation)
-              apply clarsimp
-             apply clarsimp
-            apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL)
-             apply (simp add: valid_queues_valid_q)
-            apply (subgoal_tac
-                     "head_C (ksReadyQueues_'
-                        (globals x).[cready_queues_index_to_C (tcbDomain tcb) (tcbPriority tcb)]) = NULL")
-             prefer 2
-             apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL; simp add: valid_queues_valid_q)
-            apply (subgoal_tac
-                     "end_C (ksReadyQueues_'
-                        (globals x).[cready_queues_index_to_C (tcbDomain tcb) (tcbPriority tcb)]) = NULL")
-             prefer 2
-             apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL[symmetric]; simp add: valid_queues_valid_q)
-            apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                      unat_trans_ucast_helper\<close>)
-            apply (frule maxDomain_le_unat_ucast_explicit)
-            apply (clarsimp simp: cready_queues_index_to_C_def numPriorities_def)
-            apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-             apply (simp add: t_hrs_ksReadyQueues_upd_absorb)
-             apply (rule conjI)
-              apply (clarsimp simp: l2BitmapSize_def' wordRadix_def c_invert_assist)
-
-             apply (subst rf_sr_drop_bitmaps_enqueue_helper, assumption)
-               apply (fastforce intro: cbitmap_L1_relation_bit_set)
-              apply (fastforce intro: cbitmap_L2_relation_bit_set simp: wordRadix_def mask_def)
-
-            apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb"
-                     in rf_sr_sched_queue_relation)
-              apply clarsimp
-             apply clarsimp
-            apply (drule_tac qhead'="tcb_ptr_to_ctcb_ptr t" and s=\<sigma> in tcbSchedEnqueue_update,
-                   simp_all add: valid_queues_valid_q)[1]
-             apply (rule tcb_at_not_NULL, erule obj_at'_weakenE, simp)
-
-             apply (erule(1) state_relation_queue_update_helper[where S="{t}"],
-                    (simp | rule globals.equality)+,
-                    simp_all add: cready_queues_index_to_C_def2 numPriorities_def
-                                  t_hrs_ksReadyQueues_upd_absorb upd_unless_null_def
-                                  typ_heap_simps)[1]
-               apply (fastforce simp: tcb_null_sched_ptrs_def typ_heap_simps c_guard_clift
-                                elim: obj_at'_weaken)+
-           apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                     unat_trans_ucast_helper\<close>)
-           apply clarsimp
-           apply (rule conjI; clarsimp simp: queue_in_range)
-            (* invalid, disagreement between C and Haskell on emptiness of queue *)
-            apply (drule (1) obj_at_cslift_tcb)
-            apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-            apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb"
-                     in rf_sr_sched_queue_relation)
-              apply clarsimp
-             apply clarsimp
-            apply (clarsimp simp: cready_queues_index_to_C_def numPriorities_def)
-            apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL)
-             apply (simp add: valid_queues_valid_q)
-            apply clarsimp
-            apply (drule tcb_queue_relation'_empty_ksReadyQueues; simp add: valid_queues_valid_q)
-           (* queue was not empty, add t to queue and leave bitmaps alone *)
-           apply (drule (1) obj_at_cslift_tcb)
-           apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-           apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb"
-                    in rf_sr_sched_queue_relation)
-             apply clarsimp
-            apply clarsimp
-           apply (clarsimp simp: cready_queues_index_to_C_def numPriorities_def)
-           apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL)
-            apply (simp add: valid_queues_valid_q)
-           apply clarsimp
-           apply (frule_tac t=\<sigma> in tcb_queue_relation_qhead_mem')
-            apply (simp add: valid_queues_valid_q)
-           apply (frule(1) tcb_queue_relation_qhead_valid')
-            apply (simp add: valid_queues_valid_q)
-           apply (clarsimp simp: typ_heap_simps h_t_valid_clift_Some_iff numPriorities_def
-                                 cready_queues_index_to_C_def2)
-           apply (drule_tac qhead'="tcb_ptr_to_ctcb_ptr t" and s=\<sigma> in tcbSchedEnqueue_update,
-                    simp_all add: valid_queues_valid_q)[1]
-             apply clarsimp
-            apply (rule tcb_at_not_NULL, erule obj_at'_weakenE, simp)
-           apply (frule(2) obj_at_cslift_tcb[OF valid_queues_obj_at'D])
-           apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-           apply (erule_tac S="{t, v}" for v in state_relation_queue_update_helper,
-                  (simp | rule globals.equality)+,
-                  simp_all add: typ_heap_simps if_Some_helper numPriorities_def
-                                cready_queues_index_to_C_def2 upd_unless_null_def
-                           cong: if_cong split del: if_split
-                           del: fun_upd_restrict_conv)[1]
-              apply simp
-              apply (rule conjI)
+          apply (simp add: when_def unless_def del: Collect_const split del: if_split)
+          apply (rule ccorres_cond[where R=\<top>])
+            apply (simp add: to_bool_def)
+           apply (rule ccorres_rhs_assoc)+
+           apply csymbr
+           apply csymbr
+           apply csymbr
+           apply csymbr
+           apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="dom_'" in ccorres_split_nothrow)
+               apply (rule threadGet_vcg_corres)
+               apply (rule allI, rule conseqPre, vcg)
                apply clarsimp
-               apply (drule_tac s="tcb_ptr_to_ctcb_ptr t" in sym, simp)
-              apply (clarsimp simp add: fun_upd_twist)
-             prefer 4
-             apply (simp add: obj_at'_weakenE[OF _ TrueI])
-             apply (rule disjI1, erule valid_queues_obj_at'D)
-             apply simp+
-            apply (fastforce simp: tcb_null_sched_ptrs_def)
-           apply (simp add: typ_heap_simps c_guard_clift)
-          apply (simp add: guard_is_UNIV_def)
-         apply simp
-         apply (wp threadGet_wp)
-        apply vcg
-       apply simp
-       apply (wp threadGet_wp)
-      apply vcg
-     apply (rule ccorres_return_Skip)
-    apply simp
-    apply (wp threadGet_wp)
-   apply vcg
-  apply (fastforce simp: valid_objs'_def obj_at'_def ran_def projectKOs typ_at'_def
-                         valid_obj'_def inQ_def
-                   dest!: valid_queues_obj_at'D)
-  done
+               apply (drule obj_at_ko_at', clarsimp)
+               apply (drule spec, drule(1) mp, clarsimp)
+               apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+              apply ceqv
+             apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="prio_'" in ccorres_split_nothrow)
+                 apply (rule threadGet_vcg_corres)
+                 apply (rule allI, rule conseqPre, vcg)
+                 apply clarsimp
+                 apply (drule obj_at_ko_at', clarsimp)
+                 apply (drule spec, drule(1) mp, clarsimp)
+                 apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+                apply ceqv
+               apply (rule ccorres_rhs_assoc2)+
+               apply (simp only: bind_assoc[symmetric])
+               apply (rule ccorres_split_nothrow_novcg_dc)
+                  prefer 2
+                  apply (rule ccorres_move_c_guard_tcb)
+                  apply (simp only: dc_def[symmetric])
+                  apply ctac
+                 apply (rule ccorres_rhs_assoc)+
+                 apply (rule ccorres_symb_exec_r)
+                   apply (rule ccorres_Guard_Seq)
+                   apply (simp add: bind_assoc)
+                   apply (ctac add: getQueue_ccorres)
+                     apply (rename_tac queue cqueue)
+                     apply (rule_tac xf'=ret__unsigned_long_'
+                                 and val="from_bool (tcbQueueEmpty queue)"
+                                 and R="\<lambda>s. \<not> tcbQueueEmpty queue \<longrightarrow> tcb_at' (the (tcbQueueHead queue)) s
+                                            \<and> (tcbQueueHead queue \<noteq> None \<longleftrightarrow> tcbQueueEnd queue \<noteq> None)"
+                                 and R'="{s'. queue_' s' = cqueue}"
+                                  in ccorres_symb_exec_r_known_rv)
+                        apply (rule conseqPre, vcg)
+                        apply (fastforce dest: tcb_at_not_NULL
+                                         simp: ctcb_queue_relation_def option_to_ctcb_ptr_def
+                                               tcbQueueEmpty_def)
+                       apply ceqv
+                      apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                          apply (rule ccorres_cond[where R=\<top>])
+                            apply fastforce
+                           apply (ctac add: addToBitmap_ccorres)
+                          apply (rule ccorres_return_Skip)
+                         apply ceqv
+                        apply (ctac add: tcb_queue_prepend_ccorres)
+                          apply (rule ccorres_Guard)
+                          apply (rule setQueue_ccorres)
+                          apply fastforce
+                         apply wpsimp
+                        apply (vcg exspec=tcb_queue_prepend_modifies)
+                       apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift')
+                      apply (vcg exspec=addToBitmap_modifies)
+                     apply vcg
+                    apply wpsimp
+                   apply vcg
+                  apply clarsimp
+                  apply vcg
+                 apply (rule conseqPre, vcg)
+                 apply clarsimp
+                apply wpsimp
+               apply (clarsimp simp: guard_is_UNIV_def)
+              apply (wpsimp wp: threadGet_wp)
+             apply vcg
+            apply clarsimp
+            apply (wpsimp wp: threadGet_wp)
+           apply vcg
+          apply (rule ccorres_return_Skip)
+         apply (wpsimp wp: threadGet_wp)
+        apply (vcg expsec=thread_state_get_tcbQueued_modifies)
+       apply wpsimp
+      apply (wpsimp wp: isRunnable_wp)
+     apply wpsimp
+    apply normalise_obj_at'
+    apply (rename_tac tcb)
+    apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+    apply (clarsimp simp: valid_tcb'_def)
+    apply (frule (1) obj_at_cslift_tcb)
+    apply (rule conjI)
+     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
+     apply (frule (3) obj_at'_tcbQueueHead_ksReadyQueues)
+     apply (force dest!: tcbQueueHead_iff_tcbQueueEnd simp: tcbQueueEmpty_def obj_at'_def)
+    apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+    apply (rule conjI)
+     apply (clarsimp simp: maxDomain_def)
+    apply (cut_tac qdom="tcbDomain tcb" and prio="tcbPriority tcb"
+                in cready_queues_index_to_C_in_range)
+      apply fastforce
+     apply fastforce
+    apply (clarsimp simp: word_less_nat_alt cready_queues_index_to_C_def2)
+    done
 qed
 
-lemmas tcbSchedDequeue_update
-    = tcbDequeue_update[where tn=tcbSchedNext_C and tn_update=tcbSchedNext_C_update
-                          and tp=tcbSchedPrev_C and tp_update=tcbSchedPrev_C_update,
-                        simplified]
-
-lemma tcb_queue_relation_prev_next:
-  "\<lbrakk> tcb_queue_relation tn tp mp queue qprev qhead;
-     tcbp \<in> set queue; distinct (ctcb_ptr_to_tcb_ptr qprev # queue);
-     \<forall>t \<in> set queue. tcb_at' t s; qprev \<noteq> tcb_Ptr 0 \<longrightarrow> mp qprev \<noteq> None;
-     mp (tcb_ptr_to_ctcb_ptr tcbp) = Some tcb \<rbrakk>
-      \<Longrightarrow> (tn tcb \<noteq> tcb_Ptr 0 \<longrightarrow> tn tcb \<in> tcb_ptr_to_ctcb_ptr ` set queue
-                       \<and> mp (tn tcb) \<noteq> None \<and> tn tcb \<noteq> tcb_ptr_to_ctcb_ptr tcbp)
-        \<and> (tp tcb \<noteq> tcb_Ptr 0 \<longrightarrow> (tp tcb \<in> tcb_ptr_to_ctcb_ptr ` set queue
-                                         \<or> tp tcb = qprev)
-                       \<and> mp (tp tcb) \<noteq> None \<and> tp tcb \<noteq> tcb_ptr_to_ctcb_ptr tcbp)
-        \<and> (tn tcb \<noteq> tcb_Ptr 0 \<longrightarrow> tn tcb \<noteq> tp tcb)"
-  apply (induct queue arbitrary: qprev qhead)
-   apply simp
-  apply simp
-  apply (erule disjE)
-   apply clarsimp
-   apply (case_tac "queue")
-    apply clarsimp
-   apply clarsimp
-   apply (rule conjI)
-    apply clarsimp
-   apply clarsimp
-   apply (drule_tac f=ctcb_ptr_to_tcb_ptr in arg_cong[where y="tp tcb"], simp)
-  apply clarsimp
-  apply fastforce
-  done
-
-lemma tcb_queue_relation_prev_next':
-  "\<lbrakk> tcb_queue_relation' tn tp mp queue qhead qend; tcbp \<in> set queue; distinct queue;
-       \<forall>t \<in> set queue. tcb_at' t s; mp (tcb_ptr_to_ctcb_ptr tcbp) = Some tcb \<rbrakk>
-      \<Longrightarrow> (tn tcb \<noteq> tcb_Ptr 0 \<longrightarrow> tn tcb \<in> tcb_ptr_to_ctcb_ptr ` set queue
-                       \<and> mp (tn tcb) \<noteq> None \<and> tn tcb \<noteq> tcb_ptr_to_ctcb_ptr tcbp)
-        \<and> (tp tcb \<noteq> tcb_Ptr 0 \<longrightarrow> tp tcb \<in> tcb_ptr_to_ctcb_ptr ` set queue
-                       \<and> mp (tp tcb) \<noteq> None \<and> tp tcb \<noteq> tcb_ptr_to_ctcb_ptr tcbp)
-        \<and> (tn tcb \<noteq> tcb_Ptr 0 \<longrightarrow> tn tcb \<noteq> tp tcb)"
-  apply (clarsimp simp: tcb_queue_relation'_def split: if_split_asm)
-  apply (drule(1) tcb_queue_relation_prev_next, simp_all)
-   apply (fastforce dest: tcb_at_not_NULL)
-  apply clarsimp
-  done
+lemma tcbSchedAppend_ccorres:
+  "ccorres dc xfdc
+     (tcb_at' t and valid_objs' and pspace_aligned' and pspace_distinct')
+     \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace> hs
+     (tcbSchedAppend t) (Call tcbSchedAppend_'proc)"
+proof -
+  note prio_and_dom_limit_helpers[simp] word_sle_def[simp] maxDom_to_H[simp] maxPrio_to_H[simp]
+  note invert_prioToL1Index_c_simp[simp]
 
-(* L1 bitmap only updated if L2 entry bits end up all zero *)
-lemma rf_sr_drop_bitmaps_dequeue_helper_L2:
-  "\<lbrakk> (\<sigma>,\<sigma>') \<in> rf_sr ;
-     cbitmap_L2_relation ksqL2upd' ksqL2upd \<rbrakk>
-   \<Longrightarrow>
-((\<sigma>\<lparr>ksReadyQueues := ksqupd,
-   ksReadyQueuesL2Bitmap := ksqL2upd\<rparr>,
- \<sigma>'\<lparr>idx___unsigned_long_' := i',
-   queue_' := queue_upd',
-   globals := globals \<sigma>'
-     \<lparr>ksReadyQueuesL2Bitmap_' := ksqL2upd',
-      ksReadyQueues_' := ksqupd'\<rparr>\<rparr>)
-         \<in> rf_sr)
- =
-((\<sigma>\<lparr>ksReadyQueues := ksqupd\<rparr>,
- \<sigma>'\<lparr>idx___unsigned_long_' := i',
-   queue_' := queue_upd',
-   globals := globals \<sigma>'
-     \<lparr>ksReadyQueues_' := ksqupd'\<rparr>\<rparr>) \<in> rf_sr)
-"
-  unfolding rf_sr_def cstate_relation_def Let_def
-             carch_state_relation_def cmachine_state_relation_def
-  by (clarsimp simp: rf_sr_cbitmap_L1_relation rf_sr_cbitmap_L2_relation)
+  (* when numDomains = 1, array bounds checks would become _ = 0 rather than _ < 1, changing the
+     shape of the proof compared to when numDomains > 1 *)
+  note word_less_1[simp del]
 
-lemma rf_sr_drop_bitmaps_dequeue_helper:
-  "\<lbrakk> (\<sigma>,\<sigma>') \<in> rf_sr ;
-     cbitmap_L1_relation ksqL1upd' ksqL1upd ; cbitmap_L2_relation ksqL2upd' ksqL2upd \<rbrakk>
-   \<Longrightarrow>
-((\<sigma>\<lparr>ksReadyQueues := ksqupd,
-   ksReadyQueuesL2Bitmap := ksqL2upd,
-   ksReadyQueuesL1Bitmap := ksqL1upd\<rparr>,
- \<sigma>'\<lparr>idx___unsigned_long_' := i',
-   queue_' := queue_upd',
-   globals := globals \<sigma>'
-     \<lparr>ksReadyQueuesL2Bitmap_' := ksqL2upd',
-      ksReadyQueuesL1Bitmap_' := ksqL1upd',
-      ksReadyQueues_' := ksqupd'\<rparr>\<rparr>)
-         \<in> rf_sr)
- =
-((\<sigma>\<lparr>ksReadyQueues := ksqupd\<rparr>,
- \<sigma>'\<lparr>idx___unsigned_long_' := i',
-   queue_' := queue_upd',
-   globals := globals \<sigma>'
-     \<lparr>ksReadyQueues_' := ksqupd'\<rparr>\<rparr>) \<in> rf_sr)
-"
-  unfolding rf_sr_def cstate_relation_def Let_def
-             carch_state_relation_def cmachine_state_relation_def
-  by (clarsimp simp: rf_sr_cbitmap_L1_relation rf_sr_cbitmap_L2_relation)
+  show ?thesis
+    apply (cinit lift: tcb_')
+     apply (rule ccorres_stateAssert)+
+     apply (rule ccorres_symb_exec_l)
+        apply (rule ccorres_assert)
+        apply (thin_tac "runnable")
+        apply (rule_tac r'="\<lambda>rv rv'. rv = to_bool rv'" and xf'="ret__unsigned_'"
+                     in ccorres_split_nothrow)
+            apply (rule threadGet_vcg_corres)
+            apply (rule allI, rule conseqPre, vcg)
+            apply clarsimp
+            apply (drule obj_at_ko_at', clarsimp)
+            apply (drule spec, drule(1) mp, clarsimp)
+            apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+           apply ceqv
+          apply (simp add: when_def unless_def del: Collect_const split del: if_split)
+          apply (rule ccorres_cond[where R=\<top>])
+            apply (simp add: to_bool_def)
+           apply (rule ccorres_rhs_assoc)+
+           apply csymbr
+           apply csymbr
+           apply csymbr
+           apply csymbr
+           apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="dom_'" in ccorres_split_nothrow)
+               apply (rule threadGet_vcg_corres)
+               apply (rule allI, rule conseqPre, vcg)
+               apply clarsimp
+               apply (drule obj_at_ko_at', clarsimp)
+               apply (drule spec, drule(1) mp, clarsimp)
+               apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+              apply ceqv
+             apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="prio_'" in ccorres_split_nothrow)
+                 apply (rule threadGet_vcg_corres)
+                 apply (rule allI, rule conseqPre, vcg)
+                 apply clarsimp
+                 apply (drule obj_at_ko_at', clarsimp)
+                 apply (drule spec, drule(1) mp, clarsimp)
+                 apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+                apply ceqv
+               apply (rule ccorres_rhs_assoc2)+
+               apply (simp only: bind_assoc[symmetric])
+               apply (rule ccorres_split_nothrow_novcg_dc)
+                  prefer 2
+                  apply (rule ccorres_move_c_guard_tcb)
+                  apply (simp only: dc_def[symmetric])
+                  apply ctac
+                 apply (rule ccorres_rhs_assoc)+
+                 apply (rule ccorres_symb_exec_r)
+                   apply (rule ccorres_Guard_Seq)
+                   apply (simp add: bind_assoc)
+                   apply (ctac add: getQueue_ccorres)
+                     apply (rename_tac queue cqueue)
+                     apply (rule_tac xf'=ret__unsigned_long_'
+                                 and val="from_bool (tcbQueueEmpty queue)"
+                                 and R="\<lambda>s. \<not> tcbQueueEmpty queue \<longrightarrow> tcb_at' (the (tcbQueueHead queue)) s
+                                            \<and> (tcbQueueHead queue \<noteq> None \<longleftrightarrow> tcbQueueEnd queue \<noteq> None)"
+                                 and R'="{s'. queue_' s' = cqueue}"
+                                  in ccorres_symb_exec_r_known_rv)
+                        apply (rule conseqPre, vcg)
+                        apply (fastforce dest: tcb_at_not_NULL
+                                         simp: ctcb_queue_relation_def option_to_ctcb_ptr_def
+                                               tcbQueueEmpty_def)
+                       apply ceqv
+                      apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                          apply (rule ccorres_cond[where R=\<top>])
+                            apply (fastforce dest!: tcb_at_not_NULL
+                                              simp: ctcb_queue_relation_def option_to_ctcb_ptr_def)
+                           apply (ctac add: addToBitmap_ccorres)
+                          apply (rule ccorres_return_Skip)
+                         apply ceqv
+                        apply (ctac add: tcb_queue_append_ccorres)
+                          apply (rule ccorres_Guard)
+                          apply (rule setQueue_ccorres)
+                          apply fastforce
+                         apply wpsimp
+                        apply (vcg exspec=tcb_queue_prepend_modifies)
+                       apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift')
+                      apply (vcg exspec=addToBitmap_modifies)
+                     apply vcg
+                    apply wpsimp
+                   apply vcg
+                  apply clarsimp
+                  apply vcg
+                 apply (rule conseqPre, vcg)
+                 apply clarsimp
+                apply wpsimp
+               apply (clarsimp simp: guard_is_UNIV_def)
+              apply (wpsimp wp: threadGet_wp)
+             apply vcg
+            apply clarsimp
+            apply (wpsimp wp: threadGet_wp)
+           apply clarsimp
+           apply vcg
+          apply (rule ccorres_return_Skip)
+         apply (wpsimp wp: threadGet_wp)
+        apply (vcg expsec=thread_state_get_tcbQueued_modifies)
+       apply wpsimp
+      apply (wpsimp wp: isRunnable_wp)
+     apply wpsimp
+    apply normalise_obj_at'
+    apply (rename_tac tcb)
+    apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+    apply (clarsimp simp: valid_tcb'_def)
+    apply (frule (1) obj_at_cslift_tcb)
+    apply (rule conjI)
+     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
+     apply (frule (3) obj_at'_tcbQueueHead_ksReadyQueues)
+     apply (frule (3) obj_at'_tcbQueueEnd_ksReadyQueues)
+     apply (force dest!: tcbQueueHead_iff_tcbQueueEnd simp: tcbQueueEmpty_def obj_at'_def)
+    apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+    apply (rule conjI)
+     apply (clarsimp simp: maxDomain_def)
+    apply (cut_tac qdom="tcbDomain tcb" and prio="tcbPriority tcb"
+                in cready_queues_index_to_C_in_range)
+      apply fastforce
+     apply fastforce
+    apply (clarsimp simp: word_less_nat_alt cready_queues_index_to_C_def2 tcbQueueEmpty_def)
+    done
+qed
 
 (* FIXME same proofs as bit_set, maybe can generalise? *)
 lemma cbitmap_L1_relation_bit_clear:
@@ -1285,27 +1172,6 @@ lemma cbitmap_L1_relation_bit_clear:
                      invertL1Index_def l2BitmapSize_def'
                      le_maxDomain_eq_less_numDomains word_le_nat_alt num_domains_index_updates)
 
-lemma cready_queues_relation_empty_queue_helper:
-  "\<lbrakk> tcbDomain ko \<le> maxDomain ; tcbPriority ko \<le> maxPriority ;
-     cready_queues_relation (cslift \<sigma>') (ksReadyQueues_' (globals \<sigma>')) (ksReadyQueues \<sigma>)\<rbrakk>
-   \<Longrightarrow>
-   cready_queues_relation (cslift \<sigma>')
-          (Arrays.update (ksReadyQueues_' (globals \<sigma>')) (unat (tcbDomain ko) * 256 + unat (tcbPriority ko))
-            (tcb_queue_C.end_C_update (\<lambda>_. NULL)
-              (head_C_update (\<lambda>_. NULL)
-                (ksReadyQueues_' (globals \<sigma>').[unat (tcbDomain ko) * 256 + unat (tcbPriority ko)]))))
-          ((ksReadyQueues \<sigma>)((tcbDomain ko, tcbPriority ko) := []))"
-  unfolding cready_queues_relation_def Let_def
-  using maxPrio_to_H[simp] maxDom_to_H[simp]
-  apply clarsimp
-  apply (frule (1) cready_queues_index_to_C_in_range[simplified maxDom_to_H maxPrio_to_H])
-  apply (fold cready_queues_index_to_C_def[simplified numPriorities_def])
-  apply (case_tac "qdom = tcbDomain ko",
-          simp_all add: prio_and_dom_limit_helpers seL4_MinPrio_def
-                        minDom_def)
-   apply (fastforce simp: cready_queues_index_to_C_in_range simp: cready_queues_index_to_C_distinct)+
-  done
-
 lemma cbitmap_L2_relationD:
   "\<lbrakk> cbitmap_L2_relation cbitmap2 abitmap2 ; d \<le> maxDomain ; i < l2BitmapSize \<rbrakk> \<Longrightarrow>
     cbitmap2.[unat d].[i] = abitmap2 (d, i)"
@@ -1335,64 +1201,301 @@ lemma cbitmap_L2_relation_bit_clear:
   apply (case_tac "da = d" ; clarsimp simp: num_domains_index_updates)
   done
 
-lemma tcbSchedDequeue_ccorres':
+lemma removeFromBitmap_ccorres:
   "ccorres dc xfdc
-           ((\<lambda>s. \<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s)
-                     \<and> distinct (ksReadyQueues s (d, p)))
-             and valid_queues' and tcb_at' t and valid_objs')
-           (UNIV \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace>)
-           []
-           (tcbSchedDequeue t)
-           (Call tcbSchedDequeue_'proc)"
+     (K (tdom \<le> maxDomain \<and> prio \<le> maxPriority)) (\<lbrace>\<acute>dom = ucast tdom\<rbrace> \<inter> \<lbrace>\<acute>prio = ucast prio\<rbrace>) hs
+     (removeFromBitmap tdom prio) (Call removeFromBitmap_'proc)"
 proof -
-
   note prio_and_dom_limit_helpers[simp] word_sle_def[simp]
 
   (* when numDomains = 1, array bounds checks would become _ = 0 rather than _ < 1, changing the
      shape of the proof compared to when numDomains > 1 *)
   include no_less_1_simps
 
-  have ksQ_tcb_at': "\<And>s ko d p.
-    \<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s)
-                                          \<and> distinct (ksReadyQueues s (d, p)) \<Longrightarrow>
-    \<forall>t\<in>set (ksReadyQueues s (d, p)). tcb_at' t s"
-    by (fastforce dest: spec elim: obj_at'_weakenE)
-
-  have invert_l1_index_limit: "\<And>p. invertL1Index (prioToL1Index p) < 8"
+  have invert_l1_index_limit: "\<And>p. invertL1Index (prioToL1Index p) < l2BitmapSize"
     unfolding invertL1Index_def l2BitmapSize_def' prioToL1Index_def
     by simp
 
   show ?thesis
-  apply (cinit lift: tcb_')
-   apply (rule_tac r'="\<lambda>rv rv'. rv = to_bool rv'"
-              and xf'="ret__unsigned_'" in ccorres_split_nothrow)
-       apply (rule threadGet_vcg_corres)
-       apply (rule allI, rule conseqPre, vcg)
-       apply clarsimp
-       apply (drule obj_at_ko_at', clarsimp)
-       apply (drule spec, drule(1) mp, clarsimp)
-       apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-      apply ceqv
-     apply (simp add: when_def
-                 del: Collect_const split del: if_split)
-     apply (rule ccorres_cond[where R=\<top>])
-       apply (simp add: to_bool_def)
-      apply (rule ccorres_rhs_assoc)+
-      apply csymbr
-      apply csymbr
-      apply csymbr
-      apply csymbr
-      apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv"
-              and xf'="dom_'" in ccorres_split_nothrow)
-          apply (rule threadGet_vcg_corres)
+    supply if_split[split del]
+    (* pull out static assms *)
+    apply simp
+    apply (rule ccorres_grab_asm[where P=\<top>, simplified])
+    apply (cinit lift: dom_' prio_')
+     apply clarsimp
+     apply csymbr
+     apply csymbr
+     (* we can clear up all C guards now *)
+     apply (clarsimp simp: maxDomain_le_unat_ucast_explicit word_and_less')
+     apply (simp add: invert_prioToL1Index_c_simp word_less_nat_alt)
+     apply (simp add: invert_l1_index_limit[simplified l2BitmapSize_def'])
+     apply ccorres_rewrite
+     (* handle L2 update *)
+     apply (rule_tac ccorres_split_nothrow_novcg_dc)
+        apply (rule_tac P=\<top> and P'=UNIV in ccorres_from_vcg)
+        apply (rule allI, rule conseqPre, vcg)
+        apply (clarsimp simp: simpler_gets_def get_def modify_def
+                              put_def bind_def return_def bitmap_fun_defs)
+        apply (frule rf_sr_cbitmap_L2_relation)
+        apply (erule cbitmap_L2_relation_update)
+        apply (erule (1) cbitmap_L2_relation_bit_clear)
+       (* the check on the C side is identical to checking the L2 entry, rewrite the condition *)
+       apply (simp add: getReadyQueuesL2Bitmap_def)
+       apply (rule ccorres_symb_exec_l3, rename_tac l2)
+          apply (rule_tac C'="{s. l2 = 0}"
+                      and Q="\<lambda>s. l2 = ksReadyQueuesL2Bitmap s (tdom, invertL1Index (prioToL1Index prio))"
+                   in ccorres_rewrite_cond_sr[where Q'=UNIV])
+           apply clarsimp
+           apply (frule rf_sr_cbitmap_L2_relation)
+           apply (clarsimp simp: cbitmap_L2_relationD invert_l1_index_limit split: if_split)
+          (* unset L1 bit when L2 entry is empty *)
+          apply (rule ccorres_from_vcg[where P=\<top> and P'=UNIV])
           apply (rule allI, rule conseqPre, vcg)
-          apply clarsimp
-          apply (drule obj_at_ko_at', clarsimp)
-          apply (drule spec, drule(1) mp, clarsimp)
-          apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-         apply ceqv
-        apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv"
-                and xf'="prio_'" in ccorres_split_nothrow)
+          apply (clarsimp simp: simpler_gets_def get_def modify_def
+                                put_def bind_def return_def bitmap_fun_defs)
+          apply (frule rf_sr_cbitmap_L1_relation)
+          apply (erule cbitmap_L1_relation_update)
+          apply (erule (1) cbitmap_L1_relation_bit_clear)
+         apply wpsimp+
+     apply (fastforce simp: guard_is_UNIV_def)
+    apply clarsimp
+    done
+qed
+
+lemma ctcb_ptr_to_tcb_ptr_option_to_ctcb_ptr[simp]:
+  "ctcb_ptr_to_tcb_ptr (option_to_ctcb_ptr (Some ptr)) = ptr"
+  by (clarsimp simp: option_to_ctcb_ptr_def)
+
+lemma tcb_queue_remove_ccorres:
+  "ccorres ctcb_queue_relation ret__struct_tcb_queue_C_'
+     (\<lambda>s. tcb_at' tcbPtr s \<and> valid_objs' s
+          \<and> (tcbQueueHead queue \<noteq> None \<longleftrightarrow> tcbQueueEnd queue \<noteq> None))
+     (\<lbrace>ctcb_queue_relation queue \<acute>queue\<rbrace> \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr tcbPtr\<rbrace>) hs
+     (tcbQueueRemove queue tcbPtr) (Call tcb_queue_remove_'proc)"
+  (is "ccorres _ _ ?abs _ _ _ _")
+  supply if_split[split del]
+  apply (cinit' lift: tcb_')
+   apply (rename_tac tcb')
+   apply (simp only: tcbQueueRemove_def)
+    \<comment> \<open>cinit is not able to lift queue_' because queue_' is later modified in the C program\<close>
+   apply (rule_tac xf'=queue_' in ccorres_abstract, ceqv, rename_tac cqueue)
+   apply (rule_tac P="ctcb_queue_relation queue cqueue" in ccorres_gen_asm2)
+   apply (rule ccorres_pre_getObject_tcb, rename_tac tcb)
+   apply (rule ccorres_symb_exec_l, rename_tac beforePtrOpt)
+      apply (rule ccorres_symb_exec_l, rename_tac afterPtrOpt)
+         apply (rule ccorres_move_c_guard_tcb)
+         apply (rule_tac xf'="before___ptr_to_struct_tcb_C_'"
+                     and val="option_to_ctcb_ptr beforePtrOpt"
+                     and R="ko_at' tcb tcbPtr and K (tcbSchedPrev tcb = beforePtrOpt)"
+                     and R'=UNIV
+                      in ccorres_symb_exec_r_known_rv)
+            apply (rule conseqPre, vcg)
+            apply (fastforce dest: obj_at_cslift_tcb simp: typ_heap_simps ctcb_relation_def)
+           apply ceqv
+          apply (rule ccorres_move_c_guard_tcb)
+          apply (rule_tac xf'="after___ptr_to_struct_tcb_C_'"
+                      and val="option_to_ctcb_ptr afterPtrOpt"
+                      and R="ko_at' tcb tcbPtr and K (tcbSchedNext tcb = afterPtrOpt)"
+                       in ccorres_symb_exec_r_known_rv[where R'=UNIV])
+             apply (rule conseqPre, vcg)
+             apply (fastforce dest: obj_at_cslift_tcb simp: typ_heap_simps ctcb_relation_def)
+            apply ceqv
+           apply (rule ccorres_cond_seq)
+           apply (rule ccorres_cond[where R="?abs"])
+             apply (fastforce dest: tcb_at_not_NULL
+                              simp: ctcb_queue_relation_def option_to_ctcb_ptr_def)
+            apply (rule ccorres_rhs_assoc)+
+            apply csymbr
+            apply csymbr
+            apply (fastforce intro: ccorres_return_C')
+           apply (rule ccorres_cond_seq)
+           apply (rule_tac Q="?abs" and Q'=\<top> in ccorres_cond_both')
+             apply (fastforce dest: tcb_at_not_NULL
+                              simp: ctcb_queue_relation_def option_to_ctcb_ptr_def split: if_splits)
+            apply clarsimp
+            apply (rule ccorres_assert2)
+            apply (rule ccorres_rhs_assoc)+
+            apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                apply (rule ccorres_move_c_guard_tcb)+
+                apply (rule_tac P=\<top> and P'="tcb_at' tcbPtr"
+                            and Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb (the afterPtrOpt) s}"
+                             in threadSet_ccorres_lemma3)
+                 apply (rule conseqPre, vcg)
+                 apply clarsimp
+                 apply (frule (1) obj_at_cslift_tcb)
+                 apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                   simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                         tcb_cte_cases_def cteSizeBits_def)
+                apply fastforce
+               apply ceqv
+              apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                  apply (rule ccorres_move_c_guard_tcb)
+                  apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb tcbPtr s}"
+                               in threadSet_ccorres_lemma3[where P=\<top> and P'=\<top>, simplified])
+                   apply (rule conseqPre, vcg)
+                   apply clarsimp
+                   apply (frule (1) obj_at_cslift_tcb[where thread=tcbPtr])
+                   apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                     simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                           tcb_cte_cases_def cteSizeBits_def)
+                  apply clarsimp
+                 apply ceqv
+                apply (rule ccorres_symb_exec_r)
+                  apply (fastforce intro: ccorres_return_C')
+                 apply vcg
+                apply (rule conseqPre, vcg)
+                apply clarsimp
+               apply wpsimp
+              apply vcg
+             apply wpsimp
+            apply vcg
+           apply (rule ccorres_cond_seq)
+           apply (rule_tac Q="?abs" and Q'=\<top> in ccorres_cond_both')
+             apply (fastforce dest: tcb_at_not_NULL
+                              simp: ctcb_queue_relation_def option_to_ctcb_ptr_def split: if_splits)
+            apply clarsimp
+            apply (rule ccorres_assert2)
+            apply (rule ccorres_rhs_assoc)+
+            apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                apply (rule ccorres_move_c_guard_tcb)+
+                apply (rule_tac P=\<top> and P'="tcb_at' tcbPtr"
+                            and Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb (the beforePtrOpt) s}"
+                             in threadSet_ccorres_lemma3)
+                 apply (rule conseqPre, vcg)
+                 apply clarsimp
+                 apply (frule (1) obj_at_cslift_tcb)
+                 apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                   simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                         tcb_cte_cases_def cteSizeBits_def)
+                apply fastforce
+               apply ceqv
+              apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                  apply (rule ccorres_move_c_guard_tcb)
+                  apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb tcbPtr s}"
+                               in threadSet_ccorres_lemma3[where P=\<top> and P'=\<top>, simplified])
+                   apply (rule conseqPre, vcg)
+                   apply clarsimp
+                   apply (frule (1) obj_at_cslift_tcb[where thread=tcbPtr])
+                   apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                     simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                           tcb_cte_cases_def cteSizeBits_def)
+                  apply clarsimp
+                 apply ceqv
+                apply (rule ccorres_symb_exec_r)
+                  apply (fastforce intro: ccorres_return_C')
+                 apply vcg
+                apply (rule conseqPre, vcg)
+                apply clarsimp
+               apply wpsimp
+              apply vcg
+             apply wpsimp
+            apply vcg
+           apply clarsimp
+           apply (rule ccorres_assert2)+
+           apply (rule ccorres_rhs_assoc)+
+           apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+               apply (rule ccorres_move_c_guard_tcb)+
+               apply (rule_tac Q="\<lambda>s tcb'. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb' (the beforePtrOpt) s}"
+                            in threadSet_ccorres_lemma3[where P=\<top> and P'=\<top>, simplified])
+                apply (rule conseqPre, vcg)
+                apply clarsimp
+                apply (frule (1) obj_at_cslift_tcb)
+                apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                  simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                        tcb_cte_cases_def cteSizeBits_def)
+               apply clarsimp
+              apply ceqv
+             apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                 apply (rule ccorres_move_c_guard_tcb)+
+                 apply (rule_tac P=\<top> and P'="tcb_at' tcbPtr"
+                             and Q="\<lambda>s tcb'. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb' (the afterPtrOpt) s}"
+                              in threadSet_ccorres_lemma3)
+                  apply (rule conseqPre, vcg)
+                  apply clarsimp
+                  apply (frule (1) obj_at_cslift_tcb)
+                  apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                    simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                          tcb_cte_cases_def cteSizeBits_def)
+                 apply clarsimp
+                apply ceqv
+               apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                   apply (rule ccorres_move_c_guard_tcb)
+                   apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb tcbPtr s}"
+                                in threadSet_ccorres_lemma3[where P=\<top> and P'=\<top>, simplified])
+                    apply (rule conseqPre, vcg)
+                    apply clarsimp
+                    apply (frule (1) obj_at_cslift_tcb[where thread=tcbPtr])
+                    apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                      simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                            tcb_cte_cases_def cteSizeBits_def)
+                   apply clarsimp
+                  apply ceqv
+                 apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                     apply (rule ccorres_move_c_guard_tcb)
+                     apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb tcbPtr s}"
+                                  in threadSet_ccorres_lemma3[where P=\<top> and P'=\<top>, simplified])
+                      apply (rule conseqPre, vcg)
+                      apply clarsimp
+                      apply (frule (1) obj_at_cslift_tcb[where thread=tcbPtr])
+                      apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                        simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                              tcb_cte_cases_def cteSizeBits_def)
+                     apply fastforce
+                    apply ceqv
+                   apply (fastforce intro: ccorres_return_C')
+                  apply (wpsimp | vcg)+
+  apply (clarsimp split: if_splits)
+  apply normalise_obj_at'
+  apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+  by (intro conjI impI;
+      clarsimp simp: ctcb_queue_relation_def typ_heap_simps option_to_ctcb_ptr_def
+                     valid_tcb'_def valid_bound_tcb'_def)
+
+lemma tcbQueueRemove_tcb_at'_head:
+  "\<lbrace>\<lambda>s. valid_objs' s \<and> (\<forall>head. tcbQueueHead queue = Some head \<longrightarrow> tcb_at' head s)\<rbrace>
+   tcbQueueRemove queue t
+   \<lbrace>\<lambda>rv s. \<not> tcbQueueEmpty rv \<longrightarrow> tcb_at' (the (tcbQueueHead rv)) s\<rbrace>"
+  unfolding tcbQueueRemove_def
+  apply (wpsimp wp: getTCB_wp haskell_assert_wp hoare_vcg_imp_lift')
+  apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+  apply (fastforce simp: valid_tcb'_def valid_bound_tcb'_def tcbQueueEmpty_def obj_at'_def)
+  done
+
+lemma tcbSchedDequeue_ccorres:
+  "ccorres dc xfdc
+     (tcb_at' t and valid_objs' and pspace_aligned' and pspace_distinct')
+     \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace> hs
+     (tcbSchedDequeue t) (Call tcbSchedDequeue_'proc)"
+proof -
+  note prio_and_dom_limit_helpers[simp] word_sle_def[simp] maxDom_to_H[simp] maxPrio_to_H[simp]
+  note invert_prioToL1Index_c_simp[simp]
+
+  (* when numDomains = 1, array bounds checks would become _ = 0 rather than _ < 1, changing the
+     shape of the proof compared to when numDomains > 1 *)
+  note word_less_1[simp del]
+
+  show ?thesis
+    apply (cinit lift: tcb_')
+     apply (rule ccorres_stateAssert)+
+     apply (rule_tac r'="\<lambda>rv rv'. rv = to_bool rv'" and xf'="ret__unsigned_'"
+                  in ccorres_split_nothrow)
+         apply (rule threadGet_vcg_corres)
+         apply (rule allI, rule conseqPre, vcg)
+         apply clarsimp
+         apply (drule obj_at_ko_at', clarsimp)
+         apply (drule spec, drule(1) mp, clarsimp)
+         apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+        apply ceqv
+       apply (simp add: when_def del: Collect_const split del: if_split)
+       apply (rule ccorres_cond[where R=\<top>])
+         apply (simp add: to_bool_def)
+        apply (rule ccorres_rhs_assoc)+
+        apply csymbr
+        apply csymbr
+        apply csymbr
+        apply csymbr
+        apply csymbr
+        apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="dom_'" in ccorres_split_nothrow)
             apply (rule threadGet_vcg_corres)
             apply (rule allI, rule conseqPre, vcg)
             apply clarsimp
@@ -1400,308 +1503,80 @@ proof -
             apply (drule spec, drule(1) mp, clarsimp)
             apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
            apply ceqv
-          apply (rule ccorres_rhs_assoc2)+
-          apply (simp only: bind_assoc[symmetric])
-          apply (rule ccorres_split_nothrow_novcg_dc)
-             prefer 2
-             apply (rule ccorres_move_c_guard_tcb)
-             apply ctac
-            prefer 2
-            apply (wp, clarsimp, wp+)
-           apply (rule_tac P="(\<lambda>s. \<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s)
-                                       \<and> distinct(ksReadyQueues s (d, p)))
-                               and valid_queues' and obj_at' (inQ rva rvb) t
-                               and (\<lambda>s. rva \<le> maxDomain \<and> rvb \<le> maxPriority)"
-                       and P'=UNIV in ccorres_from_vcg)
-           apply (rule allI, rule conseqPre, vcg)
-           apply (clarsimp simp: getQueue_def gets_def get_def setQueue_def modify_def
-                                 put_def bind_def return_def bitmap_fun_defs when_def
-                                 null_def)
-
-           apply (rule conjI; clarsimp simp: queue_in_range[simplified maxDom_to_H maxPrio_to_H])
-            apply (rule conjI; clarsimp simp: queue_in_range[simplified maxDom_to_H maxPrio_to_H])
-             apply (frule(1) valid_queuesD')
-             apply (drule (1) obj_at_cslift_tcb, clarsimp simp: inQ_def)
-             apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko"
-                       in rf_sr_sched_queue_relation)
-               apply (fastforce simp: maxDom_to_H maxPrio_to_H)+
-             apply (frule_tac s=\<sigma> in tcb_queue_relation_prev_next'; (fastforce simp: ksQ_tcb_at')?)
-             apply (drule_tac s=\<sigma> in tcbSchedDequeue_update, assumption,
-                     simp_all add: remove1_filter ksQ_tcb_at')[1]
-             apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                       unat_trans_ucast_helper\<close>)
-             apply (clarsimp simp: maxDomain_le_unat_ucast_explicit)
-             apply (intro conjI ;
-                     clarsimp simp: h_val_field_clift'
-                                    h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)+
-               apply (drule(2) filter_empty_unfiltered_contr, simp)+
-             apply (rule conjI; clarsimp)
-              apply (rule conjI)
-               apply (fastforce simp: c_invert_assist l2BitmapSize_def' wordRadix_def)
-              apply (rule conjI; clarsimp)
-               apply (subst rf_sr_drop_bitmaps_dequeue_helper, assumption)
-                 apply (fastforce intro: cbitmap_L1_relation_bit_clear)
-                apply (simp add: invert_prioToL1Index_c_simp)
-                apply (frule rf_sr_cbitmap_L2_relation)
-                apply (clarsimp simp: cbitmap_L2_relation_def
-                                      word_size prioToL1Index_def wordRadix_def mask_def
-                                      word_le_nat_alt
-                                      numPriorities_def wordBits_def l2BitmapSize_def'
-                                      invertL1Index_def numDomains_less_numeric_explicit)
-                apply (case_tac "d = tcbDomain ko"
-                       ; fastforce simp: le_maxDomain_eq_less_numDomains
-                                         numDomains_less_numeric_explicit)
-               apply (drule (1) obj_at_cslift_tcb, clarsimp simp: inQ_def)
-               apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko"
-                        in rf_sr_sched_queue_relation)
-                 apply (fold_subgoals (prefix))[2]
-                 subgoal premises prems using prems by (fastforce simp: maxDom_to_H maxPrio_to_H)+
-
-               apply (frule_tac s=\<sigma> in tcb_queue_relation_prev_next', assumption)
-                  prefer 3
-                  apply fastforce
-                 apply (fold_subgoals (prefix))[2]
-                 subgoal premises prems using prems by ((fastforce simp: ksQ_tcb_at')+)
-               apply (drule_tac s=\<sigma> in tcbSchedDequeue_update, assumption,
-                      simp_all add: remove1_filter ksQ_tcb_at')[1]
-               (* trivial case, setting queue to empty *)
-               apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def carch_state_relation_def
-                                     cmachine_state_relation_def)
-               apply (erule (2) cready_queues_relation_empty_queue_helper)
-              (* impossible case, C L2 update disagrees with Haskell update *)
-              apply (simp add: invert_prioToL1Index_c_simp)
-              apply (subst (asm) num_domains_index_updates)
-               subgoal by (simp add: le_maxDomain_eq_less_numDomains word_le_nat_alt)
-              apply (subst (asm) Arrays.index_update)
-               apply (simp add: invert_l1_index_limit)
-
-              apply (frule rf_sr_cbitmap_L2_relation)
-              apply (drule_tac i="invertL1Index (prioToL1Index (tcbPriority ko))"
-                        in cbitmap_L2_relationD, assumption)
-               apply (fastforce simp: l2BitmapSize_def' invert_l1_index_limit)
-              apply (fastforce simp: prioToL1Index_def invertL1Index_def mask_def wordRadix_def)
-             (* impossible case *)
-             apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-             apply (drule(2) filter_empty_unfiltered_contr, fastforce)
-
-            apply (frule (1) valid_queuesD')
-            apply (drule (1) obj_at_cslift_tcb, clarsimp simp: inQ_def)
-            apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko"
-                     in rf_sr_sched_queue_relation)
-              apply fold_subgoals[2]
-              apply (fastforce simp: maxDom_to_H maxPrio_to_H)+
-            apply (clarsimp simp: h_val_field_clift'
-                                  h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)
-            apply (frule_tac s=\<sigma> in tcb_queue_relation_prev_next', assumption)
-               prefer 3
-               apply fastforce
-              apply (fold_subgoals (prefix))[2]
-              subgoal premises prems using prems by (fastforce simp: ksQ_tcb_at')+
-            apply (drule_tac s=\<sigma> in tcbSchedDequeue_update, assumption,
-                   simp_all add: remove1_filter ksQ_tcb_at')[1]
-            apply (clarsimp simp:  filter_noteq_op upd_unless_null_def)
-            apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                      unat_trans_ucast_helper\<close>)
-            apply (clarsimp simp: maxDomain_le_unat_ucast_explicit)
-            apply (rule conjI, clarsimp)
-             apply (clarsimp simp: h_val_field_clift'
-                                   h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)
-             apply (rule conjI; clarsimp)
-              apply (simp add: typ_heap_simps)
-              apply (clarsimp simp: h_t_valid_c_guard [OF h_t_valid_field, OF h_t_valid_clift]
-                                    h_t_valid_field[OF h_t_valid_clift] h_t_valid_clift)
-              apply (erule_tac S="set (ksReadyQueues \<sigma> (tcbDomain ko, tcbPriority ko))"
-                       in state_relation_queue_update_helper',
-                     (simp | rule globals.equality)+,
-                     simp_all add: clift_field_update if_Some_helper numPriorities_def
-                                   cready_queues_index_to_C_def2 typ_heap_simps
-                                   maxDom_to_H maxPrio_to_H
-                  cong: if_cong split del: if_split)[1]
-              apply (fold_subgoals (prefix))[3]
-              subgoal premises prems using prems by (fastforce simp: tcb_null_sched_ptrs_def typ_heap_simps c_guard_clift)+
-             apply (erule_tac S="set (ksReadyQueues \<sigma> (tcbDomain ko, tcbPriority ko))"
-                      in state_relation_queue_update_helper',
-                    (simp | rule globals.equality)+,
-                    simp_all add: clift_field_update if_Some_helper numPriorities_def
-                                  cready_queues_index_to_C_def2
-                                  maxDom_to_H maxPrio_to_H
-                             cong: if_cong split del: if_split,
-                    simp_all add: typ_heap_simps')[1]
-              subgoal by (fastforce simp: tcb_null_sched_ptrs_def)
-             subgoal by fastforce
-
+          apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="prio_'" in ccorres_split_nothrow)
+              apply (rule threadGet_vcg_corres)
+              apply (rule allI, rule conseqPre, vcg)
+              apply clarsimp
+              apply (drule obj_at_ko_at', clarsimp)
+              apply (drule spec, drule(1) mp, clarsimp)
+              apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+             apply ceqv
+            apply (rule ccorres_symb_exec_r)
+              apply (rule ccorres_Guard_Seq)
+              apply (simp add: bind_assoc)
+              apply (ctac add: getQueue_ccorres)
+                apply (rule_tac r'=ctcb_queue_relation and xf'=new_queue_' in ccorres_split_nothrow)
+                    apply (ctac add: tcb_queue_remove_ccorres)
+                   apply ceqv
+                  apply (rename_tac queue' newqueue)
+                  apply (rule ccorres_Guard_Seq)
+                  apply (ctac add: setQueue_ccorres)
+                    apply (rule ccorres_split_nothrow_novcg_dc)
+                       apply ctac
+                      apply (rule_tac xf'=ret__unsigned_long_'
+                                  and val="from_bool (tcbQueueEmpty queue')"
+                                  and R="\<lambda>s. \<not> tcbQueueEmpty queue' \<longrightarrow> tcb_at' (the (tcbQueueHead queue')) s"
+                                  in ccorres_symb_exec_r_known_rv[where R'=UNIV])
+                         apply (rule conseqPre, vcg)
+                         apply (fastforce dest: tcb_at_not_NULL
+                                          simp: ctcb_queue_relation_def option_to_ctcb_ptr_def
+                                                tcbQueueEmpty_def split: option.splits)
+                        apply ceqv
+                       apply (rule ccorres_cond[where R=\<top>])
+                         apply fastforce
+                        apply (ctac add: removeFromBitmap_ccorres)
+                       apply (rule ccorres_return_Skip)
+                      apply vcg
+                     apply (wpsimp wp: hoare_vcg_imp_lift')
+                    apply (clarsimp simp: guard_is_UNIV_def)
+                   apply (wpsimp wp: hoare_vcg_imp_lift')
+                  apply vcg
+                 apply ((wpsimp wp: tcbQueueRemove_tcb_at'_head | wp (once) hoare_drop_imps)+)[1]
+                apply (vcg exspec=tcb_queue_remove_modifies)
+               apply wpsimp
+              apply vcg
+             apply vcg
+            apply (rule conseqPre, vcg)
             apply clarsimp
-            apply (rule conjI; clarsimp)
-             apply (rule conjI)
-              apply (fastforce simp: c_invert_assist l2BitmapSize_def' wordRadix_def)
-             apply (rule conjI; clarsimp)
-              (* invalid, missing bitmap updates on haskell side *)
-              apply (fold_subgoals (prefix))[2]
-              subgoal premises prems using prems
-                        by (fastforce dest!: tcb_queue_relation'_empty_ksReadyQueues
-                                      elim: obj_at'_weaken)+
-            apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-            apply (erule_tac S="set (ksReadyQueues \<sigma> (tcbDomain ko, tcbPriority ko))"
-                     in state_relation_queue_update_helper',
-                   (simp | rule globals.equality)+,
-                   simp_all add: clift_field_update if_Some_helper numPriorities_def
-                                 cready_queues_index_to_C_def2
-                                 maxDom_to_H maxPrio_to_H
-                 cong: if_cong split del: if_split)[1]
-               apply (fold_subgoals (prefix))[4]
-               subgoal premises prems using prems
-                         by (fastforce simp: typ_heap_simps c_guard_clift tcb_null_sched_ptrs_def)+
-           apply (rule conjI; clarsimp simp: queue_in_range[simplified maxDom_to_H maxPrio_to_H])
-            apply (frule (1) valid_queuesD')
-            apply (drule (1) obj_at_cslift_tcb, clarsimp simp: inQ_def)
-            apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko"
-                     in rf_sr_sched_queue_relation)
-              apply (fold_subgoals (prefix))[2]
-              subgoal premises prems using prems by (fastforce simp: maxDom_to_H maxPrio_to_H)+
-            apply (clarsimp simp: h_val_field_clift'
-                                  h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)
-            apply (frule_tac s=\<sigma> in tcb_queue_relation_prev_next')
-                apply fastforce
-               prefer 3
-               apply fastforce
-              apply (fold_subgoals (prefix))[2]
-              subgoal premises prems using prems by (fastforce simp: ksQ_tcb_at')+
-            apply (drule_tac s=\<sigma> in tcbSchedDequeue_update, assumption,
-                   simp_all add: remove1_filter ksQ_tcb_at')[1]
-            apply (clarsimp simp:  filter_noteq_op upd_unless_null_def)
-            apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                      unat_trans_ucast_helper\<close>)
-            apply (clarsimp simp: maxDomain_le_unat_ucast_explicit)
-            apply (rule conjI; clarsimp)
-             apply (clarsimp simp: h_val_field_clift'
-                                   h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)
-             apply (clarsimp simp: typ_heap_simps)
-             apply (rule conjI; clarsimp simp: typ_heap_simps)
-             apply (drule(2) filter_empty_unfiltered_contr[simplified filter_noteq_op], simp)
-            apply (rule conjI)
-             apply (fastforce simp: c_invert_assist l2BitmapSize_def' wordRadix_def)
-            apply (rule conjI; clarsimp)
-             (* impossible case, C L2 update disagrees with Haskell update *)
-             apply (subst (asm) num_domains_index_updates)
-              apply (simp add: le_maxDomain_eq_less_numDomains word_le_nat_alt)
-             apply (subst (asm) Arrays.index_update)
-              subgoal using invert_l1_index_limit
-                by (fastforce simp add: invert_prioToL1Index_c_simp intro: nat_Suc_less_le_imp)
-             apply (frule rf_sr_cbitmap_L2_relation)
-             apply (simp add: invert_prioToL1Index_c_simp)
-             apply (drule_tac i="invertL1Index (prioToL1Index (tcbPriority ko))"
-                      in cbitmap_L2_relationD, assumption)
-              subgoal by (simp add: invert_l1_index_limit l2BitmapSize_def')
-             apply (fastforce simp: prioToL1Index_def invertL1Index_def mask_def wordRadix_def)
-
-            apply (simp add: invert_prioToL1Index_c_simp)
-            apply (subst rf_sr_drop_bitmaps_dequeue_helper_L2, assumption)
-             subgoal by (fastforce dest: rf_sr_cbitmap_L2_relation elim!: cbitmap_L2_relation_bit_clear)
-
-            (* trivial case, setting queue to empty *)
-            apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def carch_state_relation_def
-                                  cmachine_state_relation_def)
-            apply (erule (2) cready_queues_relation_empty_queue_helper)
-
-           apply (frule (1) valid_queuesD')
-           apply (drule (1) obj_at_cslift_tcb, clarsimp simp: inQ_def)
-           apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko"
-                    in rf_sr_sched_queue_relation)
-             apply (fold_subgoals (prefix))[2]
-             subgoal premises prems using prems by (fastforce simp: maxDom_to_H maxPrio_to_H)+
-           apply (clarsimp simp: h_val_field_clift'
-                                 h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)
-           apply (simp add: invert_prioToL1Index_c_simp)
-           apply (frule_tac s=\<sigma> in tcb_queue_relation_prev_next')
-              apply (fastforce simp add: ksQ_tcb_at')+
-           apply (drule_tac s=\<sigma> in tcbSchedDequeue_update, assumption,
-                  simp_all add: remove1_filter ksQ_tcb_at')[1]
-           apply (clarsimp simp: filter_noteq_op upd_unless_null_def)
-           apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                     unat_trans_ucast_helper\<close>)
-           apply (clarsimp simp: maxDomain_le_unat_ucast_explicit)
-           apply (rule conjI, clarsimp)
-            apply (clarsimp simp: h_val_field_clift'
-                                  h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)
-            apply (clarsimp simp: typ_heap_simps)
-            apply (rule conjI; clarsimp simp: typ_heap_simps)
-             apply (erule_tac S="set (ksReadyQueues \<sigma> (tcbDomain ko, tcbPriority ko))"
-                      in state_relation_queue_update_helper',
-                    (simp | rule globals.equality)+,
-                    simp_all add: clift_field_update if_Some_helper numPriorities_def
-                                  cready_queues_index_to_C_def2
-                                  maxDom_to_H maxPrio_to_H
-                             cong: if_cong split del: if_split)[1]
-                apply (fastforce simp: tcb_null_sched_ptrs_def)
-               apply (clarsimp simp: typ_heap_simps)
-               apply (fastforce simp: typ_heap_simps c_guard_clift)
-              apply (fastforce simp: typ_heap_simps)
-             apply (fastforce simp: tcb_null_sched_ptrs_def)
-            apply (erule_tac S="set (ksReadyQueues \<sigma> (tcbDomain ko, tcbPriority ko))"
-                     in state_relation_queue_update_helper',
-                   (simp | rule globals.equality)+,
-                   simp_all add: clift_field_update if_Some_helper numPriorities_def
-                                 cready_queues_index_to_C_def2
-                                 maxDom_to_H maxPrio_to_H
-                            cong: if_cong split del: if_split)[1]
-               apply (fold_subgoals (prefix))[4]
-               subgoal premises prems using prems
-                         by (fastforce simp: typ_heap_simps c_guard_clift tcb_null_sched_ptrs_def)+
-           apply (clarsimp)
-           apply (rule conjI; clarsimp simp: typ_heap_simps)
-            apply (rule conjI)
-             apply (fastforce simp: c_invert_assist l2BitmapSize_def' wordRadix_def)
-            apply (rule conjI; clarsimp)
-             (* invalid, missing bitmap updates on haskell side *)
-             apply (drule tcb_queue_relation'_empty_ksReadyQueues)
-              apply (fold_subgoals (prefix))[2]
-              subgoal premises prems using prems by (fastforce elim: obj_at'_weaken)+
-            (* invalid, missing bitmap updates on haskell side *)
-            apply (drule tcb_queue_relation'_empty_ksReadyQueues)
-             apply (fold_subgoals (prefix))[2]
-             subgoal premises prems using prems by (fastforce elim: obj_at'_weaken)+
-           apply (erule_tac S="set (ksReadyQueues \<sigma> (tcbDomain ko, tcbPriority ko))"
-                    in state_relation_queue_update_helper',
-                  (simp | rule globals.equality)+,
-                  simp_all add: clift_field_update if_Some_helper numPriorities_def
-                                cready_queues_index_to_C_def2 typ_heap_simps
-                                maxDom_to_H maxPrio_to_H
-                           cong: if_cong split del: if_split)[1]
-             apply (fold_subgoals (prefix))[3]
-             subgoal premises prems using prems
-                       by (fastforce simp: typ_heap_simps c_guard_clift tcb_null_sched_ptrs_def)+
-          apply (simp add: guard_is_UNIV_def)
-         apply simp
-         apply (wp threadGet_wp)
+           apply (wpsimp wp: threadGet_wp)
+          apply vcg
+         apply clarsimp
+         apply (wpsimp wp: threadGet_wp)
         apply vcg
-       apply simp
-       apply (wp threadGet_wp)
-      apply vcg
-     apply (rule ccorres_return_Skip)
-    apply simp
-    apply (wp threadGet_wp)
-   apply vcg
-  by (fastforce simp: valid_objs'_def obj_at'_def ran_def projectKOs typ_at'_def
-                         valid_obj'_def valid_tcb'_def inQ_def)
+       apply (rule ccorres_return_Skip)
+      apply (wpsimp wp: threadGet_wp)
+     apply (vcg expsec=thread_state_get_tcbQueued_modifies)
+    apply normalise_obj_at'
+    apply (rename_tac tcb)
+    apply (frule (1) obj_at_cslift_tcb)
+    apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+    apply (clarsimp simp: valid_tcb'_def)
+    apply (cut_tac qdom="tcbDomain tcb" and prio="tcbPriority tcb"
+                in cready_queues_index_to_C_in_range)
+      apply fastforce
+     apply fastforce
+    apply (rule conjI)
+     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
+     apply (frule (3) obj_at'_tcbQueueHead_ksReadyQueues)
+     apply (force dest!: tcbQueueHead_iff_tcbQueueEnd simp: tcbQueueEmpty_def obj_at'_def)
+    by (fastforce simp: word_less_nat_alt
+                        cready_queues_index_to_C_def2 ctcb_relation_def
+                        typ_heap_simps le_maxDomain_eq_less_numDomains(2) unat_trans_ucast_helper)
 qed
 
-lemma tcbSchedDequeue_ccorres:
-  "ccorres dc xfdc
-           (valid_queues and valid_queues' and tcb_at' t and valid_objs')
-           (UNIV \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace>)
-           []
-           (tcbSchedDequeue t)
-           (Call tcbSchedDequeue_'proc)"
-  apply (rule ccorres_guard_imp [OF tcbSchedDequeue_ccorres'])
-   apply (clarsimp simp: valid_queues_def valid_queues_no_bitmap_def)
-   apply (drule_tac x=d in spec)
-   apply (drule_tac x=p in spec)
-   apply (clarsimp)
-   apply (drule(1) bspec)
-   apply (erule obj_at'_weakenE)
-   apply (clarsimp)+
-  done
-
 lemma tcb_queue_relation_append:
   "\<lbrakk> tcb_queue_relation tn tp mp queue qprev qhead; queue \<noteq> [];
      qend' \<notin> tcb_ptr_to_ctcb_ptr ` set queue; mp qend' = Some tcb;
@@ -1720,211 +1595,6 @@ lemma tcb_queue_relation_append:
   apply clarsimp
   done
 
-lemma tcbSchedAppend_update:
-  assumes sr: "sched_queue_relation' mp queue qhead qend"
-  and     qh': "qend' \<notin> tcb_ptr_to_ctcb_ptr ` set queue"
-  and  cs_tcb: "mp qend' = Some tcb"
-  and valid_ep: "\<forall>t\<in>set queue. tcb_at' t s" "distinct queue"
-  and     qhN: "qend' \<noteq> NULL"
-  shows
-  "sched_queue_relation'
-            (upd_unless_null qend (tcbSchedNext_C_update (\<lambda>_. qend') (the (mp qend)))
-                (mp(qend' \<mapsto> tcb\<lparr>tcbSchedNext_C := NULL, tcbSchedPrev_C := qend\<rparr>)))
-            (queue @ [ctcb_ptr_to_tcb_ptr qend']) (if queue = [] then qend' else qhead) qend'"
-  using sr qh' valid_ep cs_tcb qhN
-  apply -
-  apply (rule rev_cases[where xs=queue])
-   apply (simp add: tcb_queue_relation'_def upd_unless_null_def)
-  apply (clarsimp simp: tcb_queue_relation'_def upd_unless_null_def tcb_at_not_NULL)
-  apply (drule_tac qend'=qend' and tn_update=tcbSchedNext_C_update
-             and tp_update=tcbSchedPrev_C_update and qend="tcb_ptr_to_ctcb_ptr y"
-             in tcb_queue_relation_append, simp_all)
-   apply (fastforce simp add: tcb_at_not_NULL)
-  apply (simp add: fun_upd_twist)
-  done
-
-lemma tcb_queue_relation_qend_mems:
-  "\<lbrakk> tcb_queue_relation' getNext getPrev mp queue qhead qend;
-     \<forall>x \<in> set queue. tcb_at' x s \<rbrakk>
-      \<Longrightarrow> (qend = NULL \<longrightarrow> queue = [])
-       \<and> (qend \<noteq> NULL \<longrightarrow> ctcb_ptr_to_tcb_ptr qend \<in> set queue)"
-  apply (clarsimp simp: tcb_queue_relation'_def)
-  apply (drule bspec, erule last_in_set)
-  apply (simp add: tcb_at_not_NULL)
-  done
-
-lemma tcbSchedAppend_ccorres:
-  "ccorres dc xfdc
-           (valid_queues and tcb_at' t and valid_objs')
-           (UNIV \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace>)
-           []
-           (tcbSchedAppend t)
-           (Call tcbSchedAppend_'proc)"
-proof -
-  note prio_and_dom_limit_helpers[simp] word_sle_def[simp] maxDom_to_H[simp] maxPrio_to_H[simp]
-
-  (* when numDomains = 1, array bounds checks would become _ = 0 rather than _ < 1, changing the
-     shape of the proof compared to when numDomains > 1 *)
-  include no_less_1_simps
-
-  show ?thesis
-  apply (cinit lift: tcb_')
-   apply (rule_tac r'="\<lambda>rv rv'. rv = to_bool rv'"
-               and xf'="ret__unsigned_'" in ccorres_split_nothrow)
-       apply (rule threadGet_vcg_corres)
-       apply (rule allI, rule conseqPre, vcg)
-       apply clarsimp
-       apply (drule obj_at_ko_at', clarsimp)
-       apply (drule spec, drule(1) mp, clarsimp)
-       apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-      apply ceqv
-     apply (simp add: when_def unless_def del: Collect_const split del: if_split)
-     apply (rule ccorres_cond[where R=\<top>])
-       apply (simp add: to_bool_def)
-      apply (rule ccorres_rhs_assoc)+
-      apply csymbr
-      apply csymbr
-      apply csymbr
-      apply csymbr
-      apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv"
-          and xf'="dom_'" in ccorres_split_nothrow)
-          apply (rule threadGet_vcg_corres)
-          apply (rule allI, rule conseqPre, vcg)
-          apply clarsimp
-          apply (drule obj_at_ko_at', clarsimp)
-          apply (drule spec, drule(1) mp, clarsimp)
-          apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-         apply ceqv
-        apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv"
-            and xf'="prio_'" in ccorres_split_nothrow)
-            apply (rule threadGet_vcg_corres)
-            apply (rule allI, rule conseqPre, vcg)
-            apply clarsimp
-            apply (drule obj_at_ko_at', clarsimp)
-            apply (drule spec, drule(1) mp, clarsimp)
-            apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-           apply ceqv
-          apply (rule ccorres_rhs_assoc2)+
-          apply (simp only: bind_assoc[symmetric])
-          apply (rule ccorres_split_nothrow_novcg_dc)
-             prefer 2
-             apply (rule ccorres_move_c_guard_tcb)
-             apply ctac
-            prefer 2
-            apply (wp, clarsimp, wp+)
-           apply (rule_tac P="\<lambda>s. valid_queues s \<and> (\<forall>p. t \<notin> set (ksReadyQueues s p))
-                                  \<and> (\<exists>tcb. ko_at' tcb t s \<and> tcbDomain tcb =rva
-                                  \<and> tcbPriority tcb = rvb \<and> valid_tcb' tcb s)"
-                       and P'=UNIV in ccorres_from_vcg)
-           apply (rule allI, rule conseqPre, vcg)
-           apply (clarsimp simp: getQueue_def gets_def get_def setQueue_def modify_def
-                                 put_def bind_def return_def bitmap_fun_defs null_def)
-           apply (clarsimp simp: queue_in_range valid_tcb'_def)
-           apply (rule conjI; clarsimp simp: queue_in_range)
-            apply (drule (1) obj_at_cslift_tcb)
-            apply clarsimp
-            apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb"
-                     in rf_sr_sched_queue_relation)
-              apply clarsimp
-             apply clarsimp
-            apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL)
-             apply (simp add: valid_queues_valid_q)
-            apply (frule_tac s=\<sigma> in tcb_queue_relation_qend_mems,  simp add: valid_queues_valid_q)
-            apply (drule_tac qend'="tcb_ptr_to_ctcb_ptr t" and s=\<sigma> in tcbSchedAppend_update,
-                   simp_all add: valid_queues_valid_q)[1]
-             apply (rule tcb_at_not_NULL, erule obj_at'_weakenE, simp)
-            apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-            apply (simp add: invert_prioToL1Index_c_simp)
-            apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                      unat_trans_ucast_helper\<close>)
-            apply (clarsimp simp: maxDomain_le_unat_ucast_explicit)
-            apply (rule conjI; clarsimp)
-             apply (rule conjI)
-              apply (fastforce simp: c_invert_assist l2BitmapSize_def' wordRadix_def)
-             apply (simp add: t_hrs_ksReadyQueues_upd_absorb)
-             apply (subst rf_sr_drop_bitmaps_enqueue_helper, assumption)
-               apply (fastforce intro: cbitmap_L1_relation_bit_set)
-              subgoal by (fastforce intro: cbitmap_L2_relation_bit_set simp: wordRadix_def mask_def)
-             apply (erule(1) state_relation_queue_update_helper[where S="{t}"],
-                    (simp | rule globals.equality)+,
-                    simp_all add: cready_queues_index_to_C_def2 numPriorities_def
-                                  t_hrs_ksReadyQueues_upd_absorb upd_unless_null_def
-                                  typ_heap_simps)[1]
-               apply (fastforce simp: tcb_null_sched_ptrs_def elim: obj_at'_weaken)
-              apply (fastforce simp: typ_heap_simps c_guard_clift)
-             apply (fastforce simp: tcb_null_sched_ptrs_def elim: obj_at'_weaken)
-            apply (clarsimp simp: upd_unless_null_def cready_queues_index_to_C_def numPriorities_def)
-           apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                     unat_trans_ucast_helper\<close>)
-           apply (clarsimp simp: maxDomain_le_unat_ucast_explicit)
-           apply (rule conjI; clarsimp simp: queue_in_range)
-            apply (drule (1) obj_at_cslift_tcb)
-            apply clarsimp
-            apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb"
-                     in rf_sr_sched_queue_relation)
-              apply clarsimp
-             apply clarsimp
-            apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL)
-             apply (simp add: valid_queues_valid_q)
-            apply (frule_tac s=\<sigma> in tcb_queue_relation_qend_mems,
-                   simp add: valid_queues_valid_q)
-            apply (drule_tac qend'="tcb_ptr_to_ctcb_ptr t" and s=\<sigma> in tcbSchedAppend_update,
-                   simp_all add: valid_queues_valid_q)[1]
-              apply clarsimp
-             apply (rule tcb_at_not_NULL, erule obj_at'_weakenE, simp)
-            apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-            apply (clarsimp simp: upd_unless_null_def cready_queues_index_to_C_def numPriorities_def)
-           apply (drule (1) obj_at_cslift_tcb)
-           apply clarsimp
-           apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb"
-                    in rf_sr_sched_queue_relation)
-             apply clarsimp
-            apply clarsimp
-           apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL)
-            apply (simp add: valid_queues_valid_q)
-           apply (frule_tac s=\<sigma> in tcb_queue_relation_qend_mems,
-                  simp add: valid_queues_valid_q)
-           apply (drule_tac qend'="tcb_ptr_to_ctcb_ptr t" and s=\<sigma> in tcbSchedAppend_update,
-                  simp_all add: valid_queues_valid_q)[1]
-             apply clarsimp
-            apply (rule tcb_at_not_NULL, erule obj_at'_weakenE, simp)
-           apply (clarsimp simp: cready_queues_index_to_C_def2 numPriorities_def)
-           apply (frule(2) obj_at_cslift_tcb[OF valid_queues_obj_at'D])
-           apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-           apply (erule_tac S="{t, v}" for v in state_relation_queue_update_helper,
-                  (simp | rule globals.equality)+,
-                  simp_all add: typ_heap_simps if_Some_helper numPriorities_def
-                                cready_queues_index_to_C_def2 upd_unless_null_def
-                           cong: if_cong split del: if_split
-                           del: fun_upd_restrict_conv)[1]
-               apply simp
-               apply (rule conjI)
-                apply clarsimp
-                apply (drule_tac s="tcb_ptr_to_ctcb_ptr t" in sym, simp)
-               apply (clarsimp simp add: fun_upd_twist)
-              prefer 4
-              apply (simp add: obj_at'_weakenE[OF _ TrueI])
-              apply (rule disjI1, erule valid_queues_obj_at'D)
-              subgoal by simp
-             subgoal by simp
-            subgoal by (fastforce simp: tcb_null_sched_ptrs_def)
-           subgoal by (fastforce simp: typ_heap_simps c_guard_clift)
-          apply (simp add: guard_is_UNIV_def)
-         apply simp
-         apply (wp threadGet_wp)
-        apply vcg
-       apply simp
-       apply (wp threadGet_wp)
-      apply vcg
-     apply (rule ccorres_return_Skip)
-    apply simp
-    apply (wp threadGet_wp)
-   apply vcg
-  by (fastforce simp: valid_objs'_def obj_at'_def ran_def projectKOs typ_at'_def
-                         valid_obj'_def inQ_def
-                   dest!: valid_queues_obj_at'D)
-qed
-
 lemma isStopped_spec:
   "\<forall>s. \<Gamma> \<turnstile> ({s} \<inter> {s. cslift s (thread_' s) \<noteq> None}) Call isStopped_'proc
        {s'. ret__unsigned_long_' s' = from_bool (tsType_CL (thread_state_lift (tcbState_C (the (cslift s (thread_' s))))) \<in>
@@ -1970,8 +1640,11 @@ lemma tcb_at_1:
   done
 
 lemma rescheduleRequired_ccorres:
-  "ccorres dc xfdc (valid_queues and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and valid_objs')
-           UNIV [] rescheduleRequired (Call rescheduleRequired_'proc)"
+  "ccorres dc xfdc
+     ((\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and valid_objs'
+      and pspace_aligned' and pspace_distinct')
+     UNIV []
+     rescheduleRequired (Call rescheduleRequired_'proc)"
   apply cinit
    apply (rule ccorres_symb_exec_l)
       apply (rule ccorres_split_nothrow_novcg[where r'=dc and xf'=xfdc])
@@ -2081,43 +1754,18 @@ lemma cguard_UNIV:
   by fastforce
 
 lemma lookupBitmapPriority_le_maxPriority:
-  "\<lbrakk> ksReadyQueuesL1Bitmap s d \<noteq> 0 ; valid_queues s \<rbrakk>
+  "\<lbrakk> ksReadyQueuesL1Bitmap s d \<noteq> 0 ;
+     \<forall>d p. d > maxDomain \<or> p > maxPriority \<longrightarrow> tcbQueueEmpty (ksReadyQueues s (d, p));
+     valid_bitmaps s \<rbrakk>
    \<Longrightarrow> lookupBitmapPriority d s \<le> maxPriority"
-   unfolding valid_queues_def valid_queues_no_bitmap_def
-   by (fastforce dest!: bitmapQ_from_bitmap_lookup bitmapQ_ksReadyQueuesI intro: ccontr)
-
-lemma rf_sr_ksReadyQueuesL1Bitmap_not_zero:
-  "\<lbrakk> (\<sigma>, s') \<in> rf_sr ; d \<le> maxDomain ; ksReadyQueuesL1Bitmap_' (globals s').[unat d] \<noteq> 0 \<rbrakk>
-  \<Longrightarrow> ksReadyQueuesL1Bitmap \<sigma> d \<noteq> 0"
-  apply (drule rf_sr_cbitmap_L1_relation)
-  apply (simp add: cbitmap_L1_relation_def)
-  done
+  apply (clarsimp simp: valid_bitmaps_def)
+  by (fastforce dest!: bitmapQ_from_bitmap_lookup bitmapQ_ksReadyQueuesI intro: ccontr)
 
 lemma ksReadyQueuesL1Bitmap_word_log2_max:
-    "\<lbrakk>valid_queues s; ksReadyQueuesL1Bitmap s d \<noteq> 0\<rbrakk>
-    \<Longrightarrow> word_log2 (ksReadyQueuesL1Bitmap s d) < l2BitmapSize"
-    unfolding valid_queues_def
-    by (fastforce dest: word_log2_nth_same bitmapQ_no_L1_orphansD)
-
-
-lemma rf_sr_ksReadyQueuesL2Bitmap_simp:
-  "\<lbrakk> (\<sigma>, s') \<in> rf_sr ; d \<le> maxDomain ; valid_queues \<sigma> ; ksReadyQueuesL1Bitmap \<sigma> d \<noteq> 0 \<rbrakk>
-   \<Longrightarrow> ksReadyQueuesL2Bitmap_' (globals s').[unat d].[word_log2 (ksReadyQueuesL1Bitmap \<sigma> d)] =
-      ksReadyQueuesL2Bitmap \<sigma> (d, word_log2 (ksReadyQueuesL1Bitmap \<sigma> d))"
-  apply (frule rf_sr_cbitmap_L2_relation)
-  apply (frule (1) ksReadyQueuesL1Bitmap_word_log2_max)
-  apply (drule (3) cbitmap_L2_relationD)
-  done
-
-lemma ksReadyQueuesL2Bitmap_nonzeroI:
-  "\<lbrakk> d \<le> maxDomain ; valid_queues s ; ksReadyQueuesL1Bitmap s d \<noteq> 0 \<rbrakk>
-   \<Longrightarrow> ksReadyQueuesL2Bitmap s (d, invertL1Index (word_log2 (ksReadyQueuesL1Bitmap s d))) \<noteq> 0"
-   unfolding valid_queues_def
-   apply clarsimp
-   apply (frule bitmapQ_no_L1_orphansD)
-    apply (erule word_log2_nth_same)
-   apply clarsimp
-   done
+  "\<lbrakk>valid_bitmaps s; ksReadyQueuesL1Bitmap s d \<noteq> 0\<rbrakk>
+   \<Longrightarrow> word_log2 (ksReadyQueuesL1Bitmap s d) < l2BitmapSize"
+  unfolding valid_bitmaps_def
+  by (fastforce dest: word_log2_nth_same bitmapQ_no_L1_orphansD)
 
 lemma clzl_spec:
   "\<forall>s. \<Gamma> \<turnstile> {\<sigma>. s = \<sigma> \<and> x___unsigned_long_' s \<noteq> 0} Call clzl_'proc
@@ -2313,9 +1961,9 @@ lemma threadGet_get_obj_at'_has_domain:
 lemma possibleSwitchTo_ccorres:
   shows
   "ccorres dc xfdc
-         (valid_queues and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
+         ((\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
             and st_tcb_at' runnable' t and (\<lambda>s. ksCurDomain s \<le> maxDomain)
-            and valid_objs')
+            and valid_objs' and pspace_aligned' and pspace_distinct')
          ({s. target_' s = tcb_ptr_to_ctcb_ptr t}
           \<inter> UNIV) []
      (possibleSwitchTo t )
@@ -2363,8 +2011,8 @@ lemma possibleSwitchTo_ccorres:
 
 lemma scheduleTCB_ccorres':
   "ccorres dc xfdc
-           (tcb_at' thread and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and valid_queues
-                           and valid_objs')
+           (tcb_at' thread and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
+                           and valid_objs' and pspace_aligned' and pspace_distinct')
            (UNIV \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr thread})
            []
   (do (runnable, curThread, action) \<leftarrow> do
@@ -2414,24 +2062,26 @@ lemma scheduleTCB_ccorres':
            apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
                                  cscheduler_action_relation_def)
           apply wp+
-     apply (simp add: isRunnable_def isStopped_def)
-    apply wp
+   apply (simp add: isRunnable_def isStopped_def)
    apply (simp add: guard_is_UNIV_def)
   apply clarsimp
   apply (clarsimp simp: st_tcb_at'_def obj_at'_def weak_sch_act_wf_def)
   done
 
 lemma scheduleTCB_ccorres_valid_queues'_pre:
-        "ccorresG rf_sr \<Gamma> dc xfdc (tcb_at' thread and st_tcb_at' (not runnable') thread and valid_queues' and valid_queues and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and valid_objs')
-         (UNIV \<inter> \<lbrace>\<acute>tptr = tcb_ptr_to_ctcb_ptr thread\<rbrace>) []
-         (do (runnable, curThread, action) \<leftarrow> do
-             runnable \<leftarrow> isRunnable thread;
-             curThread \<leftarrow> getCurThread;
-             action \<leftarrow> getSchedulerAction;
-             return (runnable, curThread, action) od;
-             when (\<not> runnable \<and> curThread = thread \<and> action = ResumeCurrentThread) rescheduleRequired
-          od)
-         (Call scheduleTCB_'proc)"
+  "ccorresG rf_sr \<Gamma> dc xfdc
+     (tcb_at' thread and st_tcb_at' (not runnable') thread
+      and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
+      and valid_objs' and pspace_aligned' and pspace_distinct')
+     \<lbrace>\<acute>tptr = tcb_ptr_to_ctcb_ptr thread\<rbrace> []
+     (do (runnable, curThread, action) \<leftarrow> do runnable \<leftarrow> isRunnable thread;
+                                             curThread \<leftarrow> getCurThread;
+                                             action \<leftarrow> getSchedulerAction;
+                                             return (runnable, curThread, action)
+                                          od;
+         when (\<not> runnable \<and> curThread = thread \<and> action = ResumeCurrentThread) rescheduleRequired
+      od)
+     (Call scheduleTCB_'proc)"
   supply empty_fail_cond[simp]
   apply (cinit' lift: tptr_' simp del: word_neq_0_conv)
    apply (rule ccorres_rhs_assoc2)+
@@ -2472,17 +2122,17 @@ lemma scheduleTCB_ccorres_valid_queues'_pre:
                            split: scheduler_action.split_asm)
           apply wp+
      apply (simp add: isRunnable_def isStopped_def)
-    apply wp
    apply (simp add: guard_is_UNIV_def)
   apply (clarsimp simp: st_tcb_at'_def obj_at'_def)
   done
 
-
 lemmas scheduleTCB_ccorres_valid_queues'
     = scheduleTCB_ccorres_valid_queues'_pre[unfolded bind_assoc return_bind split_conv]
 
 lemma rescheduleRequired_ccorres_valid_queues'_simple:
-  "ccorresG rf_sr \<Gamma> dc xfdc (valid_queues' and sch_act_simple) UNIV [] rescheduleRequired (Call rescheduleRequired_'proc)"
+  "ccorresG rf_sr \<Gamma> dc xfdc
+     sch_act_simple UNIV []
+     rescheduleRequired (Call rescheduleRequired_'proc)"
   apply cinit
    apply (rule ccorres_symb_exec_l)
       apply (rule ccorres_split_nothrow_novcg[where r'=dc and xf'=xfdc])
@@ -2515,16 +2165,17 @@ lemma rescheduleRequired_ccorres_valid_queues'_simple:
                  split: scheduler_action.split_asm)
 
 lemma scheduleTCB_ccorres_valid_queues'_pre_simple:
-        "ccorresG rf_sr \<Gamma> dc xfdc (tcb_at' thread and st_tcb_at' (not runnable') thread and valid_queues' and sch_act_simple)
-         (UNIV \<inter> \<lbrace>\<acute>tptr = tcb_ptr_to_ctcb_ptr thread\<rbrace>) []
-         (do (runnable, curThread, action) \<leftarrow> do
-             runnable \<leftarrow> isRunnable thread;
-             curThread \<leftarrow> getCurThread;
-             action \<leftarrow> getSchedulerAction;
-             return (runnable, curThread, action) od;
-             when (\<not> runnable \<and> curThread = thread \<and> action = ResumeCurrentThread) rescheduleRequired
-          od)
-         (Call scheduleTCB_'proc)"
+  "ccorresG rf_sr \<Gamma> dc xfdc
+     (tcb_at' thread and st_tcb_at' (not runnable') thread and valid_queues' and sch_act_simple)
+     \<lbrace>\<acute>tptr = tcb_ptr_to_ctcb_ptr thread\<rbrace> []
+     (do (runnable, curThread, action) \<leftarrow> do runnable \<leftarrow> isRunnable thread;
+                                             curThread \<leftarrow> getCurThread;
+                                             action \<leftarrow> getSchedulerAction;
+                                             return (runnable, curThread, action)
+                                          od;
+         when (\<not> runnable \<and> curThread = thread \<and> action = ResumeCurrentThread) rescheduleRequired
+      od)
+     (Call scheduleTCB_'proc)"
   supply empty_fail_cond[simp]
   apply (cinit' lift: tptr_' simp del: word_neq_0_conv)
    apply (rule ccorres_rhs_assoc2)+
@@ -2563,11 +2214,10 @@ lemma scheduleTCB_ccorres_valid_queues'_pre_simple:
            apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
                                  cscheduler_action_relation_def)
           apply wp+
-     apply (simp add: isRunnable_def isStopped_def)
-    apply wp
+   apply (simp add: isRunnable_def isStopped_def)
    apply (simp add: guard_is_UNIV_def)
   apply clarsimp
-  apply (clarsimp simp: st_tcb_at'_def obj_at'_def valid_queues'_def)
+  apply (clarsimp simp: st_tcb_at'_def obj_at'_def)
   done
 
 lemmas scheduleTCB_ccorres_valid_queues'_simple
@@ -2587,48 +2237,35 @@ lemma threadSet_weak_sch_act_wf_runnable':
   apply (clarsimp)
 done
 
-lemma threadSet_valid_queues_and_runnable': "\<lbrace>\<lambda>s. valid_queues s \<and> (\<forall>p. thread \<in> set (ksReadyQueues s p) \<longrightarrow> runnable' st)\<rbrace>
-                 threadSet (tcbState_update (\<lambda>_. st)) thread
-               \<lbrace>\<lambda>rv s. valid_queues s\<rbrace>"
-  apply (wp threadSet_valid_queues)
-  apply (clarsimp simp: inQ_def)
-done
-
 lemma setThreadState_ccorres[corres]:
    "ccorres dc xfdc
-   (\<lambda>s. tcb_at' thread s \<and> valid_queues s \<and> valid_objs' s \<and> valid_tcb_state' st s \<and>
-                 (ksSchedulerAction s = SwitchToThread thread \<longrightarrow> runnable' st) \<and>
-                 (\<forall>p. thread \<in> set (ksReadyQueues s p) \<longrightarrow> runnable' st) \<and>
-                 sch_act_wf (ksSchedulerAction s) s)
-     ({s'. (\<forall>cl fl. cthread_state_relation_lifted st (cl\<lparr>tsType_CL := ts_' s' && mask 4\<rparr>, fl))}
+   (\<lambda>s. tcb_at' thread s \<and> valid_objs' s \<and> valid_tcb_state' st s
+        \<and> (ksSchedulerAction s = SwitchToThread thread \<longrightarrow> runnable' st)
+        \<and> sch_act_wf (ksSchedulerAction s) s \<and> pspace_aligned' s \<and> pspace_distinct' s)
+   ({s'. (\<forall>cl fl. cthread_state_relation_lifted st (cl\<lparr>tsType_CL := ts_' s' && mask 4\<rparr>, fl))}
     \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr thread}) hs
-         (setThreadState st thread) (Call setThreadState_'proc)"
+   (setThreadState st thread) (Call setThreadState_'proc)"
    apply (cinit lift: tptr_' cong add: call_ignore_cong)
    apply (ctac (no_vcg) add: threadSet_tcbState_simple_corres)
     apply (ctac add: scheduleTCB_ccorres)
-  apply (wp threadSet_weak_sch_act_wf_runnable' threadSet_valid_queues_and_runnable'
-            threadSet_valid_objs')
-  by (clarsimp simp: weak_sch_act_wf_def valid_queues_def valid_tcb'_tcbState_update)
-
-lemma threadSet_valid_queues'_and_not_runnable': "\<lbrace>tcb_at' thread and valid_queues' and (\<lambda>s. (\<not> runnable' st))\<rbrace>
-                  threadSet (tcbState_update (\<lambda>_. st)) thread
-               \<lbrace>\<lambda>rv. tcb_at' thread and st_tcb_at' (not runnable') thread and valid_queues' \<rbrace>"
-
-  apply (wp threadSet_valid_queues' threadSet_tcbState_st_tcb_at')
-  apply (clarsimp simp: pred_neg_def valid_queues'_def inQ_def)+
-done
+  apply (wp threadSet_weak_sch_act_wf_runnable' threadSet_valid_objs')
+  apply (clarsimp simp: weak_sch_act_wf_def valid_tcb'_tcbState_update)
+  done
 
 lemma setThreadState_ccorres_valid_queues':
-   "ccorres dc xfdc
-   (\<lambda>s. tcb_at' thread s \<and> valid_queues' s \<and> \<not> runnable' st \<and> weak_sch_act_wf (ksSchedulerAction s) s \<and> Invariants_H.valid_queues s \<and> (\<forall>p. thread \<notin> set (ksReadyQueues s p)) \<and> sch_act_not thread s \<and> valid_objs' s \<and> valid_tcb_state' st s)
+  "ccorres dc xfdc
+     (\<lambda>s. tcb_at' thread s \<and> \<not> runnable' st \<and> weak_sch_act_wf (ksSchedulerAction s) s
+          \<and> sch_act_not thread s \<and> valid_objs' s \<and> valid_tcb_state' st s
+          \<and> pspace_aligned' s \<and> pspace_distinct' s)
      ({s'. (\<forall>cl fl. cthread_state_relation_lifted st (cl\<lparr>tsType_CL := ts_' s' && mask 4\<rparr>, fl))}
-    \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr thread}) []
-         (setThreadState st thread) (Call setThreadState_'proc)"
+      \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr thread}) []
+     (setThreadState st thread) (Call setThreadState_'proc)"
    apply (cinit lift: tptr_' cong add: call_ignore_cong)
    apply (ctac (no_vcg) add: threadSet_tcbState_simple_corres)
     apply (ctac add: scheduleTCB_ccorres_valid_queues')
-   apply (wp threadSet_valid_queues'_and_not_runnable' threadSet_weak_sch_act_wf_runnable' threadSet_valid_queues_and_runnable' threadSet_valid_objs')
-  by (clarsimp simp: valid_tcb'_def tcb_cte_cases_def)
+   apply (wp threadSet_weak_sch_act_wf_runnable' threadSet_valid_objs'
+             threadSet_tcbState_st_tcb_at')
+  by (clarsimp simp: valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)
 
 lemma simp_list_case_return:
   "(case x of [] \<Rightarrow> return e | y # ys \<Rightarrow> return f) = return (if x = [] then e else f)"
@@ -2649,24 +2286,23 @@ lemma cancelSignal_ccorres [corres]:
    apply (rule ccorres_rhs_assoc2)
    apply (ctac (no_vcg) add: cancelSignal_ccorres_helper)
      apply (ctac add: setThreadState_ccorres_valid_queues')
-    apply ((wp setNotification_ksQ hoare_vcg_all_lift set_ntfn_valid_objs' | simp add: valid_tcb_state'_def split del: if_split)+)[1]
+    apply ((wp hoare_vcg_all_lift set_ntfn_valid_objs' | simp add: valid_tcb_state'_def split del: if_split)+)[1]
    apply (simp add: ThreadState_defs)
   apply (rule conjI, clarsimp, rule conjI, clarsimp)
     apply (frule (1) ko_at_valid_ntfn'[OF _ invs_valid_objs'])
-   subgoal by ((auto simp: obj_at'_def projectKOs st_tcb_at'_def invs'_def valid_state'_def
+   subgoal
+     by ((auto simp: obj_at'_def projectKOs st_tcb_at'_def invs'_def valid_state'_def
                      isTS_defs cte_wp_at_ctes_of
                      cthread_state_relation_def sch_act_wf_weak valid_ntfn'_def
-             dest!: valid_queues_not_runnable'_not_ksQ[where t=thread] |
-           clarsimp simp: eq_commute)+)
+          | clarsimp simp: eq_commute)+)
    apply (clarsimp)
    apply (frule (1) ko_at_valid_ntfn'[OF _ invs_valid_objs'])
    apply (frule (2) ntfn_blocked_in_queueD)
    by (auto simp: obj_at'_def projectKOs st_tcb_at'_def invs'_def valid_state'_def
                      isTS_defs cte_wp_at_ctes_of valid_ntfn'_def
                      cthread_state_relation_def sch_act_wf_weak isWaitingNtfn_def
-             dest!: valid_queues_not_runnable'_not_ksQ[where t=thread]
-             split: ntfn.splits option.splits
-         |  clarsimp simp: eq_commute
+            split: ntfn.splits option.splits
+         | clarsimp simp: eq_commute
          | drule_tac x=thread in bspec)+
 
 lemma cmap_relation_ep:
@@ -2969,23 +2605,20 @@ lemma cancelIPC_ccorres_helper:
                         cpspace_relation_def update_ep_map_tos typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-       \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            subgoal by (clarsimp simp: comp_def)
-        \<comment> \<open>ep relation\<close>
-           apply (rule cpspace_relation_ep_update_ep, assumption+)
-            subgoal by (simp add: cendpoint_relation_def Let_def EPState_Idle_def)
-           subgoal by simp
-           \<comment> \<open>ntfn relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-          apply simp
-          apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
-           subgoal by simp
-          apply (erule (1) map_to_ko_atI')
-         apply (simp add: heap_to_user_data_def Let_def)
-        \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         subgoal by (clarsimp simp: comp_def)
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           subgoal by (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (rule cpspace_relation_ep_update_ep, assumption+)
+           subgoal by (simp add: cendpoint_relation_def Let_def EPState_Idle_def)
+          subgoal by simp
+          \<comment> \<open>ntfn relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+          subgoal by simp
+         apply (erule (1) map_to_ko_atI')
+        apply (simp add: heap_to_user_data_def Let_def)
         subgoal by (simp add: carch_state_relation_def carch_globals_def
                               typ_heap_simps')
        subgoal by (simp add: cmachine_state_relation_def)
@@ -3006,38 +2639,36 @@ lemma cancelIPC_ccorres_helper:
                        cpspace_relation_def update_ep_map_tos typ_heap_simps')
       apply (elim conjE)
       apply (intro conjI)
-      \<comment> \<open>tcb relation\<close>
-           apply (erule ctcb_relation_null_queue_ptrs)
-           subgoal by (clarsimp simp: comp_def)
-       \<comment> \<open>ep relation\<close>
-          apply (rule cpspace_relation_ep_update_ep, assumption+)
-           apply (simp add: cendpoint_relation_def Let_def isSendEP_def isRecvEP_def split: endpoint.splits split del: if_split)
+          \<comment> \<open>tcb relation\<close>
+          apply (erule ctcb_relation_null_ep_ptrs)
+          subgoal by (clarsimp simp: comp_def)
+         \<comment> \<open>ep relation\<close>
+         apply (rule cpspace_relation_ep_update_ep, assumption+)
+          apply (simp add: cendpoint_relation_def Let_def isSendEP_def isRecvEP_def
+                    split: endpoint.splits split del: if_split)
            \<comment> \<open>recv case\<close>
-            apply (clarsimp simp add: Ptr_ptr_val h_t_valid_clift_Some_iff
-              tcb_queue_relation'_next_mask tcb_queue_relation'_prev_mask cong: tcb_queue_relation'_cong)
-            subgoal by (intro impI conjI; simp)
-           \<comment> \<open>send case\<close>
-           apply (clarsimp simp add: Ptr_ptr_val h_t_valid_clift_Some_iff
-             tcb_queue_relation'_next_mask tcb_queue_relation'_prev_mask cong: tcb_queue_relation'_cong)
+           apply (clarsimp simp: Ptr_ptr_val h_t_valid_clift_Some_iff
+                                 tcb_queue_relation'_next_mask tcb_queue_relation'_prev_mask
+                           cong: tcb_queue_relation'_cong)
+           subgoal by (intro impI conjI; simp)
+          \<comment> \<open>send case\<close>
+          apply (clarsimp simp: Ptr_ptr_val h_t_valid_clift_Some_iff
+                         tcb_queue_relation'_next_mask tcb_queue_relation'_prev_mask cong: tcb_queue_relation'_cong)
            subgoal by (intro impI conjI; simp)
           subgoal by simp
-                \<comment> \<open>ntfn relation\<close>
-         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-         apply simp
-         apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
-         apply simp
-         apply (erule (1) map_to_ko_atI')
-         \<comment> \<open>queue relation\<close>
-        apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-        subgoal by (clarsimp simp: comp_def)
-       subgoal by (simp add: carch_state_relation_def carch_globals_def
-                             typ_heap_simps')
+        \<comment> \<open>ntfn relation\<close>
+        apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+        apply simp
+        apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+        apply simp
+        apply (erule (1) map_to_ko_atI')
+       subgoal by (simp add: carch_state_relation_def carch_globals_def typ_heap_simps')
       subgoal by (simp add: cmachine_state_relation_def)
      subgoal by (simp add: h_t_valid_clift_Some_iff)
     subgoal by (simp add: objBits_simps')
    subgoal by (simp add: objBits_simps)
   apply assumption
-   done
+  done
 
 declare empty_fail_get[iff]
 
@@ -3244,37 +2875,35 @@ lemma cancelIPC_ccorres1:
      subgoal by (auto simp: obj_at'_def projectKOs pred_tcb_at'_def invs'_def valid_state'_def
                      isTS_defs cte_wp_at_ctes_of
                      cthread_state_relation_def sch_act_wf_weak valid_ep'_def
-             dest!: valid_queues_not_runnable'_not_ksQ[where t=thread] split: thread_state.splits)
+                     split: thread_state.splits)
     apply clarsimp
     apply (frule (2) ep_blocked_in_queueD_recv)
     apply (frule (1) ko_at_valid_ep'[OF _ invs_valid_objs'])
     subgoal by (auto simp: obj_at'_def projectKOs pred_tcb_at'_def invs'_def valid_state'_def
                          isTS_defs cte_wp_at_ctes_of isRecvEP_def
                          cthread_state_relation_def sch_act_wf_weak valid_ep'_def
-                 dest!: valid_queues_not_runnable'_not_ksQ[where t=thread] split: thread_state.splits endpoint.splits)
+                    split: thread_state.splits endpoint.splits)
    apply (rule conjI)
     apply (clarsimp simp: inQ_def)
-   apply (rule conjI)
-    apply clarsimp
    apply clarsimp
    apply (rule conjI)
     subgoal by (auto simp: obj_at'_def projectKOs pred_tcb_at'_def invs'_def valid_state'_def
                          isTS_defs cte_wp_at_ctes_of
                          cthread_state_relation_def sch_act_wf_weak valid_ep'_def
-                 dest!: valid_queues_not_runnable'_not_ksQ[where t=thread] split: thread_state.splits)
+                    split: thread_state.splits)
    apply clarsimp
    apply (rule conjI)
     subgoal by (auto simp: obj_at'_def projectKOs pred_tcb_at'_def invs'_def valid_state'_def
                          isTS_defs cte_wp_at_ctes_of
                          cthread_state_relation_def sch_act_wf_weak valid_ep'_def
-                 dest!: valid_queues_not_runnable'_not_ksQ[where t=thread] split: thread_state.splits)
+                    split: thread_state.splits)
    apply clarsimp
    apply (frule (2) ep_blocked_in_queueD_send)
    apply (frule (1) ko_at_valid_ep'[OF _ invs_valid_objs'])
    subgoal by (auto simp: obj_at'_def projectKOs pred_tcb_at'_def invs'_def valid_state'_def
                         isTS_defs cte_wp_at_ctes_of isSendEP_def
                         cthread_state_relation_def sch_act_wf_weak valid_ep'_def
-                dest!: valid_queues_not_runnable'_not_ksQ[where t=thread] split: thread_state.splits endpoint.splits)[1]
+                   split: thread_state.splits endpoint.splits)[1]
   apply (auto simp: isTS_defs cthread_state_relation_def typ_heap_simps weak_sch_act_wf_def)
   apply (case_tac ts,
            auto simp: isTS_defs cthread_state_relation_def typ_heap_simps)
diff --git a/proof/crefine/ARM_HYP/Ipc_C.thy b/proof/crefine/ARM_HYP/Ipc_C.thy
index 9d661c04c5..65b4af48ca 100644
--- a/proof/crefine/ARM_HYP/Ipc_C.thy
+++ b/proof/crefine/ARM_HYP/Ipc_C.thy
@@ -27,10 +27,6 @@ lemma replyFromKernel_success_empty:
   unfolding replyFromKernel_def replyFromKernel_success_empty_def
   by (simp add: setMRs_Nil submonad_asUser.fn_stateAssert)
 
-crunch valid_queues[wp]: handleFaultReply valid_queues
-
-crunch valid_queues'[wp]: handleFaultReply valid_queues'
-
 crunch sch_act_wf: handleFaultReply "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
 
 crunch valid_ipc_buffer_ptr' [wp]: copyMRs "valid_ipc_buffer_ptr' p"
@@ -1434,8 +1430,7 @@ lemma getRestartPC_ccorres [corres]:
   done
 
 lemma asUser_tcbFault_obj_at:
-  "\<lbrace>obj_at' (\<lambda>tcb. P (tcbFault tcb)) t\<rbrace> asUser t' m
-   \<lbrace>\<lambda>rv. obj_at' (\<lambda>tcb. P (tcbFault tcb)) t\<rbrace>"
+  "asUser t' m \<lbrace>obj_at' (\<lambda>tcb. P (tcbFault tcb)) t\<rbrace>"
   supply if_cong[cong]
   apply (simp add: asUser_def split_def)
   apply (wp threadGet_wp)
@@ -4461,10 +4456,6 @@ lemma doReplyTransfer_ccorres [corres]:
           \<inter> \<lbrace>\<acute>grant = from_bool grant\<rbrace>)  hs
     (doReplyTransfer sender receiver slot grant)
     (Call doReplyTransfer_'proc)"
-proof -
-  have invs_valid_queues_strg: "\<And>s. invs' s \<longrightarrow> valid_queues s"
-    by clarsimp
-  show ?thesis
   apply (cinit lift: sender_' receiver_' slot_' grant_')
    apply (rule getThreadState_ccorres_foo)
    apply (rule ccorres_assert2)
@@ -4496,7 +4487,7 @@ proof -
         apply (ctac(no_vcg) add: cteDeleteOne_ccorres[where w="scast cap_reply_cap"])
          apply (ctac(no_vcg) add: setThreadState_ccorres)
           apply (ctac(no_vcg) add: possibleSwitchTo_ccorres)
-         apply (wpsimp wp: sts_running_valid_queues setThreadState_st_tcb)+
+         apply (wpsimp wp: sts_valid_objs' setThreadState_st_tcb)+
         apply (wp cteDeleteOne_sch_act_wf)
        apply vcg
       apply (rule conseqPre, vcg)
@@ -4505,8 +4496,7 @@ proof -
      apply wp
      apply (simp add: cap_get_tag_isCap)
      apply (strengthen invs_weak_sch_act_wf_strg
-                       cte_wp_at_imp_consequent'[where P="\<lambda>ct. Ex (ccap_relation (cteCap ct))" for ct]
-                       invs_valid_queues_strg)
+                       cte_wp_at_imp_consequent'[where P="\<lambda>ct. Ex (ccap_relation (cteCap ct))" for ct])
      apply (simp add: cap_reply_cap_def)
      apply (wp doIPCTransfer_reply_or_replyslot)
     apply (clarsimp simp: seL4_Fault_NullFault_def ccorres_cond_iffs
@@ -4541,19 +4531,20 @@ proof -
               apply (ctac (no_vcg))
                apply (simp only: K_bind_def)
                apply (ctac add: possibleSwitchTo_ccorres)
-              apply (wp sts_running_valid_queues setThreadState_st_tcb | simp)+
-             apply (ctac add: setThreadState_ccorres_valid_queues'_simple)
+              apply (wp sts_valid_objs' setThreadState_st_tcb | simp)+
+             apply (ctac add: setThreadState_ccorres_simple)
              apply wp
-            apply ((wp threadSet_valid_queues threadSet_sch_act threadSet_valid_queues' hoare_weak_lift_imp
+            apply ((wp threadSet_sch_act hoare_weak_lift_imp
                        threadSet_valid_objs' threadSet_weak_sch_act_wf
                          | simp add: valid_tcb_state'_def)+)[1]
            apply (clarsimp simp: guard_is_UNIV_def ThreadState_defs mask_def option_to_ctcb_ptr_def)
 
-          apply (rule_tac Q="\<lambda>rv. valid_queues and tcb_at' receiver and valid_queues' and
+          apply (rule_tac Q="\<lambda>rv. tcb_at' receiver and
                                 valid_objs' and sch_act_simple and (\<lambda>s. ksCurDomain s \<le> maxDomain) and
-                                (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)" in hoare_post_imp)
+                                (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and
+                                pspace_aligned' and pspace_distinct'" in hoare_post_imp)
            apply (clarsimp simp: inQ_def weak_sch_act_wf_def)
-          apply (wp threadSet_valid_queues threadSet_sch_act handleFaultReply_sch_act_wf)
+          apply (wp threadSet_sch_act handleFaultReply_sch_act_wf)
          apply (clarsimp simp: guard_is_UNIV_def)
         apply assumption
        apply clarsimp
@@ -4562,7 +4553,7 @@ proof -
        apply (erule(1) cmap_relation_ko_atE [OF cmap_relation_tcb])
        apply (clarsimp simp: ctcb_relation_def typ_heap_simps)
       apply wp
-      apply (strengthen vp_invs_strg' invs_valid_queues')
+      apply (strengthen vp_invs_strg')
       apply (wp cteDeleteOne_tcbFault cteDeleteOne_sch_act_wf)
      apply vcg
     apply (rule conseqPre, vcg)
@@ -4578,7 +4569,6 @@ proof -
                         cap_get_tag_isCap)
   apply fastforce
   done
-qed
 
 lemma ccorres_getCTE_cte_at:
   "ccorresG rf_sr \<Gamma> r xf P P' hs (getCTE p >>= f) c
@@ -4598,7 +4588,7 @@ lemma ccorres_getCTE_cte_at:
   done
 
 lemma setupCallerCap_ccorres [corres]:
-  "ccorres dc xfdc (valid_queues and valid_pspace' and (\<lambda>s. \<forall>d p. sender \<notin> set (ksReadyQueues s (d, p)))
+  "ccorres dc xfdc (valid_pspace'
                     and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and sch_act_not sender
                     and tcb_at' sender and tcb_at' receiver
                     and tcb_at' sender and tcb_at' receiver)
@@ -4728,23 +4718,20 @@ lemma sendIPC_dequeue_ccorres_helper:
                          typ_heap_simps')
         apply (elim conjE)
         apply (intro conjI)
-             \<comment> \<open>tcb relation\<close>
-             apply (erule ctcb_relation_null_queue_ptrs)
-             apply (clarsimp simp: comp_def)
-            \<comment> \<open>ep relation\<close>
-            apply (rule cpspace_relation_ep_update_ep, assumption+)
-             apply (simp add: cendpoint_relation_def Let_def EPState_Idle_def
-                              tcb_queue_relation'_def)
-            apply simp
-           \<comment> \<open>ntfn relation\<close>
-           apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+            \<comment> \<open>tcb relation\<close>
+            apply (erule ctcb_relation_null_ep_ptrs)
+            apply (clarsimp simp: comp_def)
+           \<comment> \<open>ep relation\<close>
+           apply (rule cpspace_relation_ep_update_ep, assumption+)
+            apply (simp add: cendpoint_relation_def Let_def EPState_Idle_def
+                             tcb_queue_relation'_def)
            apply simp
-           apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
-            apply simp
-           apply (erule (1) map_to_ko_atI')
-          \<comment> \<open>queue relation\<close>
-          apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-          apply (clarsimp simp: comp_def)
+          \<comment> \<open>ntfn relation\<close>
+          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+          apply simp
+          apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+           apply simp
+          apply (erule (1) map_to_ko_atI')
          apply (simp add: carch_state_relation_def typ_heap_simps')
         apply (simp add: cmachine_state_relation_def)
        apply (simp add: h_t_valid_clift_Some_iff)
@@ -4768,30 +4755,27 @@ lemma sendIPC_dequeue_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-             \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (rule cpspace_relation_ep_update_ep, assumption+)
-            apply (clarsimp simp: cendpoint_relation_def Let_def
-                                  isRecvEP_def isSendEP_def
-                                  tcb_queue_relation'_def valid_ep'_def
-                           split: endpoint.splits list.splits
-                       split del: if_split)
-            apply (subgoal_tac "tcb_at' (if x22 = [] then x21 else last x22) \<sigma>")
-             apply (clarsimp dest!: is_aligned_tcb_ptr_to_ctcb_ptr
-                         split del: if_split)
-            apply (clarsimp split: if_split)
-           apply simp
-          \<comment> \<open>ntfn relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (rule cpspace_relation_ep_update_ep, assumption+)
+           apply (clarsimp simp: cendpoint_relation_def Let_def
+                                 isRecvEP_def isSendEP_def
+                                 tcb_queue_relation'_def valid_ep'_def
+                          split: endpoint.splits list.splits
+                      split del: if_split)
+           apply (subgoal_tac "tcb_at' (if x22 = [] then x21 else last x22) \<sigma>")
+            apply (clarsimp dest!: is_aligned_tcb_ptr_to_ctcb_ptr
+                        split del: if_split)
+           apply (clarsimp split: if_split)
           apply simp
-          apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
-           apply simp
-          apply (erule (1) map_to_ko_atI')
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         apply (clarsimp simp: comp_def)
+         \<comment> \<open>ntfn relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+          apply simp
+         apply (erule (1) map_to_ko_atI')
         apply (simp add: carch_state_relation_def typ_heap_simps')
        apply (simp add: cmachine_state_relation_def)
       apply (simp add: h_t_valid_clift_Some_iff)
@@ -4814,10 +4798,9 @@ lemma rf_sr_tcb_update_twice:
                 cmachine_state_relation_def)
 
 lemma sendIPC_block_ccorres_helper:
-  "ccorres dc xfdc (tcb_at' thread and valid_queues and valid_objs' and
+  "ccorres dc xfdc (tcb_at' thread and valid_objs' and pspace_aligned' and pspace_distinct' and
                     sch_act_not thread and ep_at' epptr and
-                    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s \<and>
-                         (\<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))) and
+                    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and
                     K (bos = ThreadState_BlockedOnSend
                       \<and> epptr' = epptr \<and> badge' = badge
                       \<and> cg = from_bool canGrant \<and> cgr = from_bool canGrantReply
@@ -4873,7 +4856,7 @@ lemma sendIPC_block_ccorres_helper:
        apply ceqv
       apply clarsimp
       apply ctac
-     apply (wp threadSet_weak_sch_act_wf_runnable' threadSet_valid_queues
+     apply (wp threadSet_weak_sch_act_wf_runnable'
                threadSet_valid_objs')
     apply (clarsimp simp: guard_is_UNIV_def)
    apply (clarsimp simp: sch_act_wf_weak valid_tcb'_def valid_tcb_state'_def
@@ -4977,6 +4960,19 @@ lemma tcb_queue_relation_qend_valid':
   apply (simp add: h_t_valid_clift_Some_iff)
   done
 
+lemma tcb_queue'_head_end_NULL:
+  assumes qr: "tcb_queue_relation' getNext getPrev mp queue qhead qend"
+  and   tat: "\<forall>t\<in>set queue. tcb_at' t s"
+  shows "(qend = NULL) = (qhead = NULL)"
+  using qr tat
+  apply -
+  apply (erule tcb_queue_relationE')
+  apply (simp add: tcb_queue_head_empty_iff split: if_splits)
+  apply (rule tcb_at_not_NULL)
+  apply (erule bspec)
+  apply simp
+  done
+
 lemma tcbEPAppend_spec:
   "\<forall>s queue. \<Gamma> \<turnstile> \<lbrace>s. \<exists>t. (t, s) \<in> rf_sr
                       \<and> (\<forall>tcb\<in>set queue. tcb_at' tcb t) \<and> distinct queue
@@ -5097,29 +5093,26 @@ lemma sendIPC_enqueue_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-            \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (rule cpspace_relation_ep_update_ep', assumption+)
-            apply (clarsimp simp: cendpoint_relation_def Let_def
-                                  mask_def [where n=2] EPState_Send_def)
-            apply (clarsimp simp: tcb_queue_relation'_def)
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (rule cpspace_relation_ep_update_ep', assumption+)
+           apply (clarsimp simp: cendpoint_relation_def Let_def
+                                 mask_def [where n=2] EPState_Send_def)
+           apply (clarsimp simp: tcb_queue_relation'_def)
+          apply (simp add: isSendEP_def isRecvEP_def)
+         \<comment> \<open>ntfn relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cnotification_relation_ep_queue, assumption+)
            apply (simp add: isSendEP_def isRecvEP_def)
-          \<comment> \<open>ntfn relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
           apply simp
-          apply (rule cnotification_relation_ep_queue, assumption+)
-            apply (simp add: isSendEP_def isRecvEP_def)
-           apply simp
-          apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
-          apply (erule(2) map_to_ko_at_updI')
-           apply (simp only:projectKOs injectKO_ep objBits_simps)
-           apply clarsimp
-          apply (clarsimp simp: obj_at'_def projectKOs)
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         apply (clarsimp simp: comp_def)
+         apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
+         apply (erule(2) map_to_ko_at_updI')
+          apply (simp only:projectKOs injectKO_ep objBits_simps)
+          apply clarsimp
+         apply (clarsimp simp: obj_at'_def projectKOs)
         apply (simp add: carch_state_relation_def typ_heap_simps')
        apply (simp add: cmachine_state_relation_def)
       apply (simp add: typ_heap_simps')
@@ -5136,31 +5129,28 @@ lemma sendIPC_enqueue_ccorres_helper:
                        typ_heap_simps')
       apply (elim conjE)
       apply (intro conjI)
-           \<comment> \<open>tcb relation\<close>
-           apply (erule ctcb_relation_null_queue_ptrs)
-           apply (clarsimp simp: comp_def)
-          \<comment> \<open>ep relation\<close>
-          apply (rule cpspace_relation_ep_update_ep', assumption+)
-           apply (clarsimp simp: cendpoint_relation_def Let_def
-                                 mask_def [where n=2] EPState_Send_def
-                          split: if_split)
-           apply (fastforce simp: tcb_queue_relation'_def
-                                 valid_ep'_def
-                           dest: tcb_queue_relation_next_not_NULL)
+          \<comment> \<open>tcb relation\<close>
+          apply (erule ctcb_relation_null_ep_ptrs)
+          apply (clarsimp simp: comp_def)
+         \<comment> \<open>ep relation\<close>
+         apply (rule cpspace_relation_ep_update_ep', assumption+)
+          apply (clarsimp simp: cendpoint_relation_def Let_def
+                                mask_def [where n=2] EPState_Send_def
+                         split: if_split)
+          apply (fastforce simp: tcb_queue_relation'_def
+                                valid_ep'_def
+                          dest: tcb_queue_relation_next_not_NULL)
+         apply (simp add: isSendEP_def isRecvEP_def)
+        \<comment> \<open>ntfn relation\<close>
+        apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+        apply simp
+        apply (rule cnotification_relation_ep_queue, assumption+)
           apply (simp add: isSendEP_def isRecvEP_def)
-         \<comment> \<open>ntfn relation\<close>
-         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
          apply simp
-         apply (rule cnotification_relation_ep_queue, assumption+)
-           apply (simp add: isSendEP_def isRecvEP_def)
-          apply simp
-         apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
-         apply (erule(2) map_to_ko_at_updI')
-          apply (clarsimp simp: objBitsKO_def)
-         apply (clarsimp simp: obj_at'_def projectKOs)
-        \<comment> \<open>queue relation\<close>
-        apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-        apply (clarsimp simp: comp_def)
+        apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
+        apply (erule(2) map_to_ko_at_updI')
+         apply (clarsimp simp: objBitsKO_def)
+        apply (clarsimp simp: obj_at'_def projectKOs)
        apply (simp add: carch_state_relation_def typ_heap_simps')
       apply (simp add: cmachine_state_relation_def)
      apply (simp add: h_t_valid_clift_Some_iff)
@@ -5180,8 +5170,7 @@ lemma ctcb_relation_blockingIPCCanGrantD:
 
 lemma sendIPC_ccorres [corres]:
   "ccorres dc xfdc (invs' and st_tcb_at' simple' thread
-                          and sch_act_not thread and ep_at' epptr and
-                          (\<lambda>s. \<forall>d p. thread \<notin> set (ksReadyQueues s (d, p))))
+                          and sch_act_not thread and ep_at' epptr)
      (UNIV \<inter> \<lbrace>\<acute>blocking = from_bool blocking\<rbrace>
            \<inter> \<lbrace>\<acute>do_call = from_bool do_call\<rbrace>
            \<inter> \<lbrace>\<acute>badge = badge\<rbrace>
@@ -5212,8 +5201,7 @@ lemma sendIPC_ccorres [corres]:
      apply ceqv
     apply (rule_tac A="invs' and st_tcb_at' simple' thread
                           and sch_act_not thread and ko_at' ep epptr
-                          and ep_at' epptr
-                          and (\<lambda>s. \<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))"
+                          and ep_at' epptr"
                  in ccorres_guard_imp2 [where A'=UNIV])
      apply wpc
        \<comment> \<open>RecvEP case\<close>
@@ -5261,12 +5249,11 @@ lemma sendIPC_ccorres [corres]:
               apply (ctac add: setThreadState_ccorres)
              apply (rule ccorres_return_Skip)
             apply (wpsimp wp: hoare_drop_imps hoare_vcg_all_lift possibleSwitchTo_sch_act_not
-                              possibleSwitchTo_sch_act_not sts_st_tcb'
-                              possibleSwitchTo_ksQ' sts_valid_queues sts_ksQ'
+                              possibleSwitchTo_sch_act_not sts_st_tcb' sts_valid_objs'
                           simp: valid_tcb_state'_def)+
           apply vcg
-         apply (wpsimp wp: doIPCTransfer_sch_act setEndpoint_ksQ hoare_vcg_all_lift
-                          set_ep_valid_objs' setEndpoint_valid_mdb'
+         apply (wpsimp wp: doIPCTransfer_sch_act hoare_vcg_all_lift
+                           set_ep_valid_objs' setEndpoint_valid_mdb'
                 | wp (once) hoare_drop_imp
                 | strengthen sch_act_wf_weak)+
        apply (fastforce simp: guard_is_UNIV_def ThreadState_defs Collect_const_mem mask_def
@@ -5342,7 +5329,7 @@ lemma sendIPC_ccorres [corres]:
                              st_tcb_at'_def valid_tcb_state'_def ko_wp_at'_def
                              isBlockedOnSend_def projectKO_opt_tcb
                       split: if_split_asm if_split)
-       apply (rule conjI, simp, rule impI, clarsimp simp: valid_pspace_valid_objs')
+       apply (rule conjI, simp, rule impI, clarsimp simp: valid_pspace'_def)
        apply (erule delta_sym_refs)
         apply (clarsimp split: if_split_asm
                         dest!: symreftype_inverse')+
@@ -5385,10 +5372,9 @@ lemma ctcb_relation_blockingIPCCanGrantReplyD:
   done
 
 lemma receiveIPC_block_ccorres_helper:
-  "ccorres dc xfdc (tcb_at' thread and valid_queues and valid_objs' and
+  "ccorres dc xfdc (tcb_at' thread and valid_objs' and pspace_aligned' and pspace_distinct' and
                     sch_act_not thread and ep_at' epptr and
-                    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s \<and>
-                     (\<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))) and
+                    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and
                     K (epptr = epptr && ~~ mask 4) and
                     K (isEndpointCap cap \<and> ccap_relation cap cap'))
                    UNIV hs
@@ -5426,7 +5412,7 @@ lemma receiveIPC_block_ccorres_helper:
        apply ceqv
       apply clarsimp
       apply ctac
-     apply (wp threadSet_valid_queues hoare_vcg_all_lift threadSet_valid_objs'
+     apply (wp hoare_vcg_all_lift threadSet_valid_objs'
                threadSet_weak_sch_act_wf_runnable')
     apply (clarsimp simp: guard_is_UNIV_def)
    apply (clarsimp simp: sch_act_wf_weak valid_tcb'_def valid_tcb_state'_def
@@ -5491,31 +5477,28 @@ lemma receiveIPC_enqueue_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-             \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (rule cpspace_relation_ep_update_ep', assumption+)
-            apply (clarsimp simp: cendpoint_relation_def Let_def
-                                  mask_def [where n=2] EPState_Recv_def
-                           split: if_split)
-            apply (fastforce simp: tcb_queue_relation'_def
-                                  valid_ep'_def
-                            dest: tcb_queue_relation_next_not_NULL)
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (rule cpspace_relation_ep_update_ep', assumption+)
+           apply (clarsimp simp: cendpoint_relation_def Let_def
+                                 mask_def [where n=2] EPState_Recv_def
+                          split: if_split)
+           apply (fastforce simp: tcb_queue_relation'_def
+                                 valid_ep'_def
+                           dest: tcb_queue_relation_next_not_NULL)
+          apply (simp add: isSendEP_def isRecvEP_def)
+         \<comment> \<open>ntfn relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cnotification_relation_ep_queue, assumption+)
            apply (simp add: isSendEP_def isRecvEP_def)
-          \<comment> \<open>ntfn relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
           apply simp
-          apply (rule cnotification_relation_ep_queue, assumption+)
-            apply (simp add: isSendEP_def isRecvEP_def)
-           apply simp
-          apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
-          apply (erule(2) map_to_ko_at_updI')
-           apply (clarsimp simp: objBitsKO_def)
-          apply (clarsimp simp: obj_at'_def projectKOs)
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         apply (clarsimp simp: comp_def)
+         apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
+         apply (erule(2) map_to_ko_at_updI')
+          apply (clarsimp simp: objBitsKO_def)
+         apply (clarsimp simp: obj_at'_def projectKOs)
         apply (simp add: carch_state_relation_def typ_heap_simps')
        apply (simp add: cmachine_state_relation_def)
       apply (simp add: h_t_valid_clift_Some_iff)
@@ -5532,28 +5515,25 @@ lemma receiveIPC_enqueue_ccorres_helper:
                        typ_heap_simps')
       apply (elim conjE)
       apply (intro conjI)
-           \<comment> \<open>tcb relation\<close>
-           apply (erule ctcb_relation_null_queue_ptrs)
-           apply (clarsimp simp: comp_def)
-          \<comment> \<open>ep relation\<close>
-          apply (rule cpspace_relation_ep_update_ep', assumption+)
-           apply (clarsimp simp: cendpoint_relation_def Let_def
-                                 mask_def [where n=2] EPState_Recv_def)
-           apply (clarsimp simp: tcb_queue_relation'_def)
+          \<comment> \<open>tcb relation\<close>
+          apply (erule ctcb_relation_null_ep_ptrs)
+          apply (clarsimp simp: comp_def)
+         \<comment> \<open>ep relation\<close>
+         apply (rule cpspace_relation_ep_update_ep', assumption+)
+          apply (clarsimp simp: cendpoint_relation_def Let_def
+                                mask_def [where n=2] EPState_Recv_def)
+          apply (clarsimp simp: tcb_queue_relation'_def)
+         apply (simp add: isSendEP_def isRecvEP_def)
+        \<comment> \<open>ntfn relation\<close>
+        apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+        apply simp
+        apply (rule cnotification_relation_ep_queue, assumption+)
           apply (simp add: isSendEP_def isRecvEP_def)
-         \<comment> \<open>ntfn relation\<close>
-         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
          apply simp
-         apply (rule cnotification_relation_ep_queue, assumption+)
-           apply (simp add: isSendEP_def isRecvEP_def)
-          apply simp
-         apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
-         apply (erule(2) map_to_ko_at_updI')
-          apply (clarsimp simp: objBitsKO_def)
-         apply (clarsimp simp: obj_at'_def projectKOs)
-        \<comment> \<open>queue relation\<close>
-        apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-        apply (clarsimp simp: comp_def)
+        apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
+        apply (erule(2) map_to_ko_at_updI')
+         apply (clarsimp simp: objBitsKO_def)
+        apply (clarsimp simp: obj_at'_def projectKOs)
        apply (simp add: carch_state_relation_def typ_heap_simps')
       apply (simp add: cmachine_state_relation_def)
      apply (simp add: typ_heap_simps')
@@ -5621,23 +5601,20 @@ lemma receiveIPC_dequeue_ccorres_helper:
                          typ_heap_simps')
         apply (elim conjE)
         apply (intro conjI)
-             \<comment> \<open>tcb relation\<close>
-             apply (erule ctcb_relation_null_queue_ptrs)
-             apply (clarsimp simp: comp_def)
-            \<comment> \<open>ep relation\<close>
-            apply (rule cpspace_relation_ep_update_ep, assumption+)
-             apply (simp add: cendpoint_relation_def Let_def EPState_Idle_def
-                              tcb_queue_relation'_def)
-            apply simp
-           \<comment> \<open>ntfn relation\<close>
-           apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-           apply simp
-           apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+            \<comment> \<open>tcb relation\<close>
+            apply (erule ctcb_relation_null_ep_ptrs)
+            apply (clarsimp simp: comp_def)
+           \<comment> \<open>ep relation\<close>
+           apply (rule cpspace_relation_ep_update_ep, assumption+)
+            apply (simp add: cendpoint_relation_def Let_def EPState_Idle_def
+                             tcb_queue_relation'_def)
            apply simp
+          \<comment> \<open>ntfn relation\<close>
+          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+          apply simp
+          apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+          apply simp
           apply (erule (1) map_to_ko_atI')
-          \<comment> \<open>queue relation\<close>
-          apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-          apply (clarsimp simp: comp_def)
          apply (simp add: carch_state_relation_def typ_heap_simps')
         apply (simp add: cmachine_state_relation_def)
        apply (simp add: typ_heap_simps')
@@ -5661,30 +5638,27 @@ lemma receiveIPC_dequeue_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-            \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (rule cpspace_relation_ep_update_ep, assumption+)
-            apply (clarsimp simp: cendpoint_relation_def Let_def
-                                  isRecvEP_def isSendEP_def
-                                  tcb_queue_relation'_def valid_ep'_def
-                           split: endpoint.splits list.splits
-                       split del: if_split)
-            apply (subgoal_tac "tcb_at' (if x22 = [] then x21 else last x22) \<sigma>")
-             apply (clarsimp dest!: is_aligned_tcb_ptr_to_ctcb_ptr
-                         split del: if_split)
-            apply (clarsimp split: if_split)
-           apply simp
-          \<comment> \<open>ntfn relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (rule cpspace_relation_ep_update_ep, assumption+)
+           apply (clarsimp simp: cendpoint_relation_def Let_def
+                                 isRecvEP_def isSendEP_def
+                                 tcb_queue_relation'_def valid_ep'_def
+                          split: endpoint.splits list.splits
+                      split del: if_split)
+           apply (subgoal_tac "tcb_at' (if x22 = [] then x21 else last x22) \<sigma>")
+            apply (clarsimp dest!: is_aligned_tcb_ptr_to_ctcb_ptr
+                        split del: if_split)
+           apply (clarsimp split: if_split)
           apply simp
-          apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
-           apply simp
-          apply (erule (1) map_to_ko_atI')
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         apply (clarsimp simp: comp_def)
+         \<comment> \<open>ntfn relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+          apply simp
+         apply (erule (1) map_to_ko_atI')
         apply (simp add: carch_state_relation_def typ_heap_simps')
        apply (simp add: cmachine_state_relation_def)
       apply (simp add: typ_heap_simps')
@@ -5801,7 +5775,6 @@ lemma receiveIPC_ccorres [corres]:
   notes option.case_cong_weak [cong]
   shows
   "ccorres dc xfdc (invs' and st_tcb_at' simple' thread and sch_act_not thread
-                          and (\<lambda>s. \<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))
                           and valid_cap' cap and K (isEndpointCap cap))
      (UNIV \<inter> \<lbrace>\<acute>thread = tcb_ptr_to_ctcb_ptr thread\<rbrace>
            \<inter> \<lbrace>ccap_relation cap \<acute>cap\<rbrace>
@@ -5877,7 +5850,6 @@ lemma receiveIPC_ccorres [corres]:
           apply ceqv
          apply (rule_tac A="invs' and st_tcb_at' simple' thread
                                   and sch_act_not thread
-                              and (\<lambda>s. \<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))
                                   and ko_at' ep (capEPPtr cap)"
                      in ccorres_guard_imp2 [where A'=UNIV])
            apply wpc
@@ -6017,28 +5989,26 @@ lemma receiveIPC_ccorres [corres]:
                  apply ccorres_rewrite
                  apply ctac
                    apply (ctac add: possibleSwitchTo_ccorres)
-                  apply (wpsimp wp: sts_st_tcb' sts_valid_queues)
+                  apply (wpsimp wp: sts_st_tcb' sts_valid_objs')
                  apply (vcg exspec=setThreadState_modifies)
                 apply (fastforce simp: guard_is_UNIV_def ThreadState_defs mask_def
                                        cap_get_tag_isCap ccap_relation_ep_helpers)
                apply (clarsimp simp: valid_tcb_state'_def)
-               apply (rule_tac Q="\<lambda>_. valid_pspace' and valid_queues
+               apply (rule_tac Q="\<lambda>_. valid_pspace'
                                        and st_tcb_at' ((=) sendState) sender and tcb_at' thread
                                        and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)
-                                       and (\<lambda>s. (\<forall>a b. sender \<notin> set (ksReadyQueues s (a, b))))
                                        and sch_act_not sender and K (thread \<noteq> sender)
                                        and (\<lambda>s. ksCurDomain s \<le> maxDomain)" in hoare_post_imp)
-                apply (clarsimp simp: valid_pspace_valid_objs' pred_tcb_at'_def sch_act_wf_weak
-                                      obj_at'_def)
+                apply (fastforce simp: valid_pspace_valid_objs' pred_tcb_at'_def sch_act_wf_weak
+                                       obj_at'_def)
                apply (wpsimp simp: guard_is_UNIV_def option_to_ptr_def option_to_0_def conj_ac)+
-        apply (rule_tac Q="\<lambda>rv. valid_queues and valid_pspace'
-                            and cur_tcb' and tcb_at' sender and tcb_at' thread
-                            and sch_act_not sender and K (thread \<noteq> sender)
-                            and ep_at' (capEPPtr cap)
-                            and (\<lambda>s. ksCurDomain s \<le> maxDomain)
-                            and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s \<and>
-                                     (\<forall>d p. sender \<notin> set (ksReadyQueues s (d, p))))"
-                         in hoare_post_imp)
+           apply (rule_tac Q="\<lambda>rv. valid_pspace'
+                               and cur_tcb' and tcb_at' sender and tcb_at' thread
+                               and sch_act_not sender and K (thread \<noteq> sender)
+                               and ep_at' (capEPPtr cap)
+                               and (\<lambda>s. ksCurDomain s \<le> maxDomain)
+                               and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)"
+                            in hoare_post_imp)
              subgoal by (auto, auto simp: st_tcb_at'_def obj_at'_def)
         apply (wp hoare_vcg_all_lift set_ep_valid_objs')
            apply (clarsimp simp: guard_is_UNIV_def)
@@ -6072,13 +6042,11 @@ lemma receiveIPC_ccorres [corres]:
                                   split: if_split_asm bool.splits) (*very long *)
             apply (clarsimp simp: obj_at'_def state_refs_of'_def projectKOs)
            apply (frule(1) sym_refs_ko_atD' [OF _ invs_sym'])
-           apply (frule invs_queues)
            apply clarsimp
            apply (rename_tac list x xa)
            apply (rule_tac P="x\<in>set list" in case_split)
             apply (clarsimp simp:st_tcb_at_refs_of_rev')
             apply (erule_tac x=x and P="\<lambda>x. st_tcb_at' P x s" for P in ballE)
-             apply (drule_tac t=x in valid_queues_not_runnable'_not_ksQ)
               apply (clarsimp simp: st_tcb_at'_def obj_at'_def)
              apply (subgoal_tac "sch_act_not x s")
               prefer 2
@@ -6157,23 +6125,20 @@ lemma sendSignal_dequeue_ccorres_helper:
                          typ_heap_simps')
         apply (elim conjE)
         apply (intro conjI)
-             \<comment> \<open>tcb relation\<close>
-             apply (erule ctcb_relation_null_queue_ptrs)
-             apply (clarsimp simp: comp_def)
-            \<comment> \<open>ep relation\<close>
-            apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-            apply simp
-            apply (rule cendpoint_relation_ntfn_queue [OF invs_sym'], assumption+)
-             apply simp+
-            apply (erule (1) map_to_ko_atI')
-           \<comment> \<open>ntfn relation\<close>
-           apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
-            apply (simp add: cnotification_relation_def Let_def NtfnState_Idle_def
-                             tcb_queue_relation'_def)
+            \<comment> \<open>tcb relation\<close>
+            apply (erule ctcb_relation_null_ep_ptrs)
+            apply (clarsimp simp: comp_def)
+           \<comment> \<open>ep relation\<close>
+           apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
            apply simp
-          \<comment> \<open>queue relation\<close>
-          apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-          apply (clarsimp simp: comp_def)
+           apply (rule cendpoint_relation_ntfn_queue [OF invs_sym'], assumption+)
+            apply simp+
+           apply (erule (1) map_to_ko_atI')
+          \<comment> \<open>ntfn relation\<close>
+          apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
+           apply (simp add: cnotification_relation_def Let_def NtfnState_Idle_def
+                            tcb_queue_relation'_def)
+          apply simp
          apply (simp add: carch_state_relation_def typ_heap_simps')
         apply (simp add: cmachine_state_relation_def)
        apply (simp add: h_t_valid_clift_Some_iff)
@@ -6199,30 +6164,27 @@ lemma sendSignal_dequeue_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-            \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-           apply simp
-           apply (rule cendpoint_relation_ntfn_queue [OF invs_sym'], assumption+)
-            apply simp+
-           apply (erule (1) map_to_ko_atI')
-          \<comment> \<open>ntfn relation\<close>
-          apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
-           apply (clarsimp simp: cnotification_relation_def Let_def
-                                 isWaitingNtfn_def
-                                 tcb_queue_relation'_def valid_ntfn'_def
-                          split: Structures_H.notification.splits list.splits
-                      split del: if_split)
-           apply (subgoal_tac "tcb_at' (if x22 = [] then x21 else last x22) \<sigma>")
-            apply (clarsimp dest!: is_aligned_tcb_ptr_to_ctcb_ptr
-                        split del: if_split)
-           apply (clarsimp split: if_split)
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
           apply simp
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         apply (clarsimp simp: comp_def)
+          apply (rule cendpoint_relation_ntfn_queue [OF invs_sym'], assumption+)
+           apply simp+
+          apply (erule (1) map_to_ko_atI')
+         \<comment> \<open>ntfn relation\<close>
+         apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
+          apply (clarsimp simp: cnotification_relation_def Let_def
+                                isWaitingNtfn_def
+                                tcb_queue_relation'_def valid_ntfn'_def
+                         split: Structures_H.notification.splits list.splits
+                     split del: if_split)
+          apply (subgoal_tac "tcb_at' (if x22 = [] then x21 else last x22) \<sigma>")
+           apply (clarsimp dest!: is_aligned_tcb_ptr_to_ctcb_ptr
+                       split del: if_split)
+          apply (clarsimp split: if_split)
+         apply simp
         apply (simp add: carch_state_relation_def typ_heap_simps')
        apply (simp add: cmachine_state_relation_def)
       apply (simp add: h_t_valid_clift_Some_iff)
@@ -6328,7 +6290,7 @@ lemma sendSignal_ccorres [corres]:
          apply (ctac(no_vcg) add: setThreadState_ccorres)
           apply (ctac(no_vcg) add: setRegister_ccorres)
            apply (ctac add: possibleSwitchTo_ccorres)
-          apply (wp sts_running_valid_queues sts_st_tcb_at'_cases
+          apply (wp sts_valid_objs' sts_st_tcb_at'_cases
                  | simp add: option_to_ctcb_ptr_def split del: if_split)+
         apply (rule_tac Q="\<lambda>_. tcb_at' (the (ntfnBoundTCB ntfn)) and invs'"
                  in hoare_post_imp)
@@ -6394,10 +6356,8 @@ lemma sendSignal_ccorres [corres]:
        apply (ctac (no_vcg))
         apply (ctac add: possibleSwitchTo_ccorres)
        apply (simp)
-       apply (wp weak_sch_act_wf_lift_linear
-         setThreadState_oa_queued
-         sts_valid_queues tcb_in_cur_domain'_lift)[1]
-      apply (wp sts_valid_queues sts_runnable)
+       apply (wp weak_sch_act_wf_lift_linear tcb_in_cur_domain'_lift)[1]
+      apply (wp sts_valid_objs' sts_runnable)
      apply (wp setThreadState_st_tcb set_ntfn_valid_objs' | clarsimp)+
     apply (clarsimp simp: guard_is_UNIV_def ThreadState_defs mask_def
                           badgeRegister_def Kernel_C.badgeRegister_def
@@ -6422,10 +6382,9 @@ lemma sendSignal_ccorres [corres]:
   done
 
 lemma receiveSignal_block_ccorres_helper:
-  "ccorres dc xfdc (tcb_at' thread and valid_queues and sch_act_not thread and
-                    valid_objs' and ntfn_at' ntfnptr and
-                    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s \<and>
-                        (\<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))) and
+  "ccorres dc xfdc (tcb_at' thread and sch_act_not thread and
+                    valid_objs' and ntfn_at' ntfnptr and pspace_aligned' and pspace_distinct' and
+                    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and
                     K (ntfnptr = ntfnptr && ~~ mask 4))
                    UNIV hs
            (setThreadState (Structures_H.thread_state.BlockedOnNotification
@@ -6458,7 +6417,7 @@ lemma receiveSignal_block_ccorres_helper:
        apply ceqv
       apply clarsimp
       apply ctac
-     apply (wp threadSet_valid_queues hoare_vcg_all_lift threadSet_valid_objs'
+     apply (wp hoare_vcg_all_lift threadSet_valid_objs'
                threadSet_weak_sch_act_wf_runnable')
     apply (clarsimp simp: guard_is_UNIV_def)
    apply (auto simp: weak_sch_act_wf_def valid_tcb'_def tcb_cte_cases_def
@@ -6580,31 +6539,28 @@ lemma receiveSignal_enqueue_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-            \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+          apply simp
+          apply (rule cendpoint_relation_ntfn_queue, assumption+)
+            apply (simp add: isWaitingNtfn_def)
            apply simp
-           apply (rule cendpoint_relation_ntfn_queue, assumption+)
-             apply (simp add: isWaitingNtfn_def)
-            apply simp
-           apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
-           apply (erule(2) map_to_ko_at_updI')
-            apply (clarsimp simp: objBitsKO_def)
-           apply (clarsimp simp: obj_at'_def projectKOs)
-          \<comment> \<open>ntfn relation\<close>
-          apply (rule cpspace_relation_ntfn_update_ntfn', assumption+)
-            apply (case_tac "ntfn", simp_all)[1]
-           apply (clarsimp simp: cnotification_relation_def Let_def
-                                 mask_def [where n=2] NtfnState_Waiting_def)
-           subgoal by (fastforce simp: tcb_queue_relation'_def is_aligned_neg_mask_weaken
-                                 valid_ntfn'_def
-                           dest: tcb_queue_relation_next_not_NULL)
-          apply (simp add: isWaitingNtfn_def)
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         subgoal by (clarsimp simp: comp_def)
+          apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
+          apply (erule(2) map_to_ko_at_updI')
+           apply (clarsimp simp: objBitsKO_def)
+          apply (clarsimp simp: obj_at'_def projectKOs)
+         \<comment> \<open>ntfn relation\<close>
+         apply (rule cpspace_relation_ntfn_update_ntfn', assumption+)
+           apply (case_tac "ntfn", simp_all)[1]
+          apply (clarsimp simp: cnotification_relation_def Let_def
+                                mask_def [where n=2] NtfnState_Waiting_def)
+          subgoal by (fastforce simp: tcb_queue_relation'_def is_aligned_neg_mask_weaken
+                                valid_ntfn'_def
+                          dest: tcb_queue_relation_next_not_NULL)
+         apply (simp add: isWaitingNtfn_def)
         apply (simp add: carch_state_relation_def typ_heap_simps')
        apply (simp add: cmachine_state_relation_def)
       apply (simp add: h_t_valid_clift_Some_iff)
@@ -6621,30 +6577,27 @@ lemma receiveSignal_enqueue_ccorres_helper:
                        typ_heap_simps')
       apply (elim conjE)
       apply (intro conjI)
-           \<comment> \<open>tcb relation\<close>
-           apply (erule ctcb_relation_null_queue_ptrs)
-           apply (clarsimp simp: comp_def)
-          \<comment> \<open>ep relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+          \<comment> \<open>tcb relation\<close>
+          apply (erule ctcb_relation_null_ep_ptrs)
+          apply (clarsimp simp: comp_def)
+         \<comment> \<open>ep relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cendpoint_relation_ntfn_queue, assumption+)
+           apply (simp add: isWaitingNtfn_def)
           apply simp
-          apply (rule cendpoint_relation_ntfn_queue, assumption+)
-            apply (simp add: isWaitingNtfn_def)
-           apply simp
-          apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
-          apply (erule(2) map_to_ko_at_updI')
-           apply (clarsimp simp: objBitsKO_def)
-          apply (clarsimp simp: obj_at'_def projectKOs)
-         \<comment> \<open>ntfn relation\<close>
-         apply (rule cpspace_relation_ntfn_update_ntfn', assumption+)
-           apply (case_tac "ntfn", simp_all)[1]
-          apply (clarsimp simp: cnotification_relation_def Let_def
-                                mask_def [where n=2] NtfnState_Waiting_def
-                         split: if_split)
-          apply (fastforce simp: tcb_queue_relation'_def is_aligned_neg_mask_weaken)
-         apply (simp add: isWaitingNtfn_def)
-        \<comment> \<open>queue relation\<close>
-        apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-        apply (clarsimp simp: comp_def)
+         apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
+         apply (erule(2) map_to_ko_at_updI')
+          apply (clarsimp simp: objBitsKO_def)
+         apply (clarsimp simp: obj_at'_def projectKOs)
+        \<comment> \<open>ntfn relation\<close>
+        apply (rule cpspace_relation_ntfn_update_ntfn', assumption+)
+          apply (case_tac "ntfn", simp_all)[1]
+         apply (clarsimp simp: cnotification_relation_def Let_def
+                               mask_def [where n=2] NtfnState_Waiting_def
+                        split: if_split)
+         apply (fastforce simp: tcb_queue_relation'_def is_aligned_neg_mask_weaken)
+        apply (simp add: isWaitingNtfn_def)
        apply (simp add: carch_state_relation_def typ_heap_simps')
       apply (simp add: cmachine_state_relation_def)
      apply (simp add: h_t_valid_clift_Some_iff)
@@ -6656,7 +6609,6 @@ lemma receiveSignal_enqueue_ccorres_helper:
 lemma receiveSignal_ccorres [corres]:
   "ccorres dc xfdc (invs' and valid_cap' cap and st_tcb_at' simple' thread
                     and sch_act_not thread
-                    and (\<lambda>s. \<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))
                     and K (isNotificationCap cap))
      (UNIV \<inter> \<lbrace>\<acute>thread = tcb_ptr_to_ctcb_ptr thread\<rbrace>
            \<inter> \<lbrace>ccap_relation cap \<acute>cap\<rbrace>
diff --git a/proof/crefine/ARM_HYP/IsolatedThreadAction.thy b/proof/crefine/ARM_HYP/IsolatedThreadAction.thy
index fdf7abf47c..9defe6fa56 100644
--- a/proof/crefine/ARM_HYP/IsolatedThreadAction.thy
+++ b/proof/crefine/ARM_HYP/IsolatedThreadAction.thy
@@ -1152,9 +1152,11 @@ lemma oblivious_switchToThread_schact:
                    threadSet_def tcbSchedEnqueue_def unless_when asUser_def
                    getQueue_def setQueue_def storeWordUser_def setRegister_def
                    pointerInUserData_def isRunnable_def isStopped_def
-                   getThreadState_def tcbSchedDequeue_def bitmap_fun_defs)
+                   getThreadState_def tcbSchedDequeue_def tcbQueueRemove_def bitmap_fun_defs
+                   ksReadyQueues_asrt_def)
   apply (safe intro!: oblivious_bind
-         | simp_all add: oblivious_setVMRoot_schact  oblivious_vcpuSwitch_schact)+
+         | simp_all add: ready_qs_runnable_def idleThreadNotQueued_def oblivious_setVMRoot_schact
+                         oblivious_vcpuSwitch_schact)+
   done
 
 (* FIXME move *)
@@ -1195,9 +1197,8 @@ lemma tcbSchedEnqueue_tcbPriority[wp]:
   done
 
 crunch obj_at_prio[wp]: cteDeleteOne "obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t"
-  (wp: crunch_wps setEndpoint_obj_at_tcb'
-       setThreadState_obj_at_unchanged setNotification_tcb setBoundNotification_obj_at_unchanged
-        simp: crunch_simps unless_def)
+  (wp: crunch_wps setEndpoint_obj_at'_tcb setNotification_tcb
+   simp: crunch_simps unless_def setBoundNotification_def)
 
 lemma setThreadState_no_sch_change:
   "\<lbrace>\<lambda>s. P (ksSchedulerAction s) \<and> (runnable' st \<or> t \<noteq> ksCurThread s)\<rbrace>
@@ -1315,8 +1316,6 @@ lemma setCTE_assert_modify:
        apply (rule word_and_le2)
       apply (simp add: objBits_simps mask_def field_simps)
      apply (simp add: simpler_modify_def cong: option.case_cong if_cong)
-     apply (rule kernel_state.fold_congs[OF refl refl])
-     apply (clarsimp simp: projectKO_opt_tcb cong: if_cong)
     apply (clarsimp simp: lookupAround2_char1 word_and_le2)
     apply (rule ccontr, clarsimp)
     apply (erule(2) ps_clearD)
@@ -1455,11 +1454,14 @@ lemma thread_actions_isolatableD:
 lemma tcbSchedDequeue_rewrite:
   "monadic_rewrite True True (obj_at' (Not \<circ> tcbQueued) t) (tcbSchedDequeue t) (return ())"
   apply (simp add: tcbSchedDequeue_def)
-   apply (wp_pre, monadic_rewrite_symb_exec_l_known False, simp)
-    apply (rule monadic_rewrite_refl)
-   apply (wpsimp wp: threadGet_const)+
+  apply wp_pre
+  apply monadic_rewrite_symb_exec_l
+    apply (monadic_rewrite_symb_exec_l_known False, simp)
+     apply (rule monadic_rewrite_refl)
+    apply (wpsimp wp: threadGet_const)+
   done
 
+(* FIXME: improve automation here *)
 lemma switchToThread_rewrite:
   "monadic_rewrite True True
        (ct_in_state' (Not \<circ> runnable') and cur_tcb' and obj_at' (Not \<circ> tcbQueued) t)
@@ -1467,7 +1469,9 @@ lemma switchToThread_rewrite:
        (do Arch.switchToThread t; setCurThread t od)"
   apply (simp add: switchToThread_def Thread_H.switchToThread_def)
   apply (monadic_rewrite_l tcbSchedDequeue_rewrite, simp)
-   apply (rule monadic_rewrite_refl)
+   (* strip LHS of getters and asserts until LHS and RHS are the same *)
+   apply (repeat_unless \<open>rule monadic_rewrite_refl\<close> monadic_rewrite_symb_exec_l)
+      apply wpsimp+
   apply (clarsimp simp: comp_def)
   done
 
@@ -1509,9 +1513,33 @@ lemma switchToThread_isolatable:
                      split: tcb_state_regs.split)+
   done
 
+lemma tcbQueued_put_tcb_state_regs_tcb:
+  "tcbQueued (put_tcb_state_regs_tcb tsr tcb) = tcbQueued tcb"
+  apply (clarsimp simp: put_tcb_state_regs_tcb_def)
+  by (cases tsr; clarsimp)
+
+lemma idleThreadNotQueued_isolatable:
+  "thread_actions_isolatable idx (stateAssert idleThreadNotQueued [])"
+  apply (simp add: stateAssert_def2 stateAssert_def)
+  apply (intro thread_actions_isolatable_bind[OF _ _ hoare_pre(1)]
+               gets_isolatable
+               thread_actions_isolatable_if
+               thread_actions_isolatable_returns
+               thread_actions_isolatable_fail)
+    unfolding idleThreadNotQueued_def
+    apply (clarsimp simp: obj_at_partial_overwrite_If)
+    apply (clarsimp simp: obj_at'_def tcbQueued_put_tcb_state_regs_tcb)
+   apply wpsimp+
+  done
+
 lemma setCurThread_isolatable:
   "thread_actions_isolatable idx (setCurThread t)"
-  by (simp add: setCurThread_def modify_isolatable)
+  unfolding setCurThread_def
+  apply (rule thread_actions_isolatable_bind)
+    apply (rule idleThreadNotQueued_isolatable)
+   apply (fastforce intro: modify_isolatable)
+  apply wpsimp
+  done
 
 lemma isolate_thread_actions_tcbs_at:
   assumes f: "\<And>x. \<lbrace>tcb_at' (idx x)\<rbrace> f \<lbrace>\<lambda>rv. tcb_at' (idx x)\<rbrace>" shows
diff --git a/proof/crefine/ARM_HYP/Recycle_C.thy b/proof/crefine/ARM_HYP/Recycle_C.thy
index 2c5622949b..14ea1378ab 100644
--- a/proof/crefine/ARM_HYP/Recycle_C.thy
+++ b/proof/crefine/ARM_HYP/Recycle_C.thy
@@ -889,16 +889,6 @@ lemma cnotification_relation_q_cong:
   apply (auto intro: iffD1[OF tcb_queue_relation'_cong[OF refl refl refl]])
   done
 
-lemma tcbSchedEnqueue_ep_at:
-  "\<lbrace>obj_at' (P :: endpoint \<Rightarrow> bool) ep\<rbrace>
-      tcbSchedEnqueue t
-   \<lbrace>\<lambda>rv. obj_at' P ep\<rbrace>"
-  including no_pre
-  apply (simp add: tcbSchedEnqueue_def unless_def null_def)
-  apply (wp threadGet_wp, clarsimp, wp+)
-  apply (clarsimp split: if_split, wp)
-  done
-
 lemma ccorres_duplicate_guard:
   "ccorres r xf (P and P) Q hs f f' \<Longrightarrow> ccorres r xf P Q hs f f'"
   by (erule ccorres_guard_imp, auto)
@@ -918,10 +908,11 @@ lemma cancelBadgedSends_ccorres:
               (UNIV \<inter> {s. epptr_' s = Ptr ptr} \<inter> {s. badge_' s = bdg}) []
        (cancelBadgedSends ptr bdg) (Call cancelBadgedSends_'proc)"
   apply (cinit lift: epptr_' badge_' simp: whileAnno_def)
+   apply (rule ccorres_stateAssert)
    apply (simp add: list_case_return
               cong: list.case_cong Structures_H.endpoint.case_cong call_ignore_cong
                del: Collect_const)
-   apply (rule ccorres_pre_getEndpoint)
+   apply (rule ccorres_pre_getEndpoint, rename_tac ep)
    apply (rule_tac R="ko_at' ep ptr" and xf'="ret__unsigned_'"
                and val="case ep of RecvEP q \<Rightarrow> scast EPState_Recv | IdleEP \<Rightarrow> scast EPState_Idle
                                 | SendEP q \<Rightarrow> scast EPState_Send"
@@ -973,8 +964,9 @@ lemma cancelBadgedSends_ccorres:
                    st_tcb_at' (\<lambda>st. isBlockedOnSend st \<and> blockingObject st = ptr) x s)
                               \<and> distinct (xs @ list) \<and> ko_at' IdleEP ptr s
                               \<and> (\<forall>p. \<forall>x \<in> set (xs @ list). \<forall>rf. (x, rf) \<notin> {r \<in> state_refs_of' s p. snd r \<noteq> NTFNBound})
-                              \<and> valid_queues s \<and> pspace_aligned' s \<and> pspace_distinct' s
-                              \<and> sch_act_wf (ksSchedulerAction s) s \<and> valid_objs' s"
+                              \<and> pspace_aligned' s \<and> pspace_distinct' s
+                              \<and> sch_act_wf (ksSchedulerAction s) s \<and> valid_objs' s
+                              \<and> ksReadyQueues_head_end s \<and> ksReadyQueues_head_end_tcb_at' s"
                      and P'="\<lambda>xs. {s. ep_queue_relation' (cslift s) (xs @ list)
                                          (head_C (queue_' s)) (end_C (queue_' s))}
                                 \<inter> {s. thread_' s = (case list of [] \<Rightarrow> tcb_Ptr 0
@@ -1070,8 +1062,9 @@ lemma cancelBadgedSends_ccorres:
                    apply (rule_tac rrel=dc and xf=xfdc
                                and P="\<lambda>s. (\<forall>t \<in> set (x @ a # lista). tcb_at' t s)
                                           \<and> (\<forall>p. \<forall>t \<in> set (x @ a # lista). \<forall>rf. (t, rf) \<notin> {r \<in> state_refs_of' s p. snd r \<noteq> NTFNBound})
-                                          \<and> valid_queues s \<and> distinct (x @ a # lista)
-                                          \<and> pspace_aligned' s \<and> pspace_distinct' s"
+                                          \<and> distinct (x @ a # lista)
+                                          \<and> pspace_aligned' s \<and> pspace_distinct' s
+                                          \<and> ksReadyQueues_head_end s \<and> ksReadyQueues_head_end_tcb_at' s"
                               and P'="{s. ep_queue_relation' (cslift s) (x @ a # lista)
                                            (head_C (queue_' s)) (end_C (queue_' s))}"
                                in ccorres_from_vcg)
@@ -1087,8 +1080,7 @@ lemma cancelBadgedSends_ccorres:
                    apply (clarsimp simp: return_def rf_sr_def cstate_relation_def Let_def)
                    apply (rule conjI)
                     apply (clarsimp simp: cpspace_relation_def)
-                    apply (rule conjI, erule ctcb_relation_null_queue_ptrs)
-                     apply (rule null_ep_queue)
+                    apply (rule conjI, erule ctcb_relation_null_ep_ptrs)
                      subgoal by (simp add: o_def)
                     apply (rule conjI)
                      apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
@@ -1111,9 +1103,6 @@ lemma cancelBadgedSends_ccorres:
                     apply (clarsimp simp: image_iff)
                     apply (drule_tac x=p in spec)
                     subgoal by fastforce
-                   apply (rule conjI)
-                    apply (erule cready_queues_relation_not_queue_ptrs;
-                           fastforce dest: null_ep_schedD[unfolded o_def] simp: o_def)
                    apply (simp add: carch_state_relation_def
                                     cmachine_state_relation_def
                                     h_t_valid_clift_Some_iff)
@@ -1124,12 +1113,11 @@ lemma cancelBadgedSends_ccorres:
                  apply wp
                 apply simp
                 apply vcg
-               apply (wp hoare_vcg_const_Ball_lift tcbSchedEnqueue_ep_at
-                         sch_act_wf_lift)
+               apply (wp hoare_vcg_const_Ball_lift sch_act_wf_lift)
               apply simp
               apply (vcg exspec=tcbSchedEnqueue_cslift_spec)
              apply (wp hoare_vcg_const_Ball_lift sts_st_tcb_at'_cases
-                       sts_sch_act sts_valid_queues setThreadState_oa_queued)
+                       sts_sch_act sts_valid_objs')
             apply (vcg exspec=setThreadState_cslift_spec)
            apply (simp add: ccorres_cond_iffs)
            apply (rule ccorres_symb_exec_r2)
@@ -1153,14 +1141,11 @@ lemma cancelBadgedSends_ccorres:
            apply (clarsimp simp: cscheduler_action_relation_def st_tcb_at'_def
                           split: scheduler_action.split_asm)
            apply (rename_tac word)
-           apply (frule_tac x=word in tcbSchedEnqueue_cslift_precond_discharge)
-              apply simp
-             subgoal by clarsimp
-            subgoal by clarsimp
+           apply (frule_tac x=word in tcbSchedEnqueue_cslift_precond_discharge; simp?)
            subgoal by clarsimp
           apply clarsimp
           apply (rule conjI)
-           apply (frule(3) tcbSchedEnqueue_cslift_precond_discharge)
+           apply (frule tcbSchedEnqueue_cslift_precond_discharge; simp?)
            subgoal by clarsimp
           apply clarsimp
           apply (rule context_conjI)
@@ -1200,9 +1185,19 @@ lemma cancelBadgedSends_ccorres:
    apply (clarsimp split: if_split)
    apply (drule sym_refsD, clarsimp)
    apply (drule(1) bspec)+
-   by (auto simp: obj_at'_def projectKOs state_refs_of'_def pred_tcb_at'_def tcb_bound_refs'_def
-              dest!: symreftype_inverse')
-
+   apply (frule ksReadyQueues_asrt_ksReadyQueues_head_end)
+   apply (frule invs_pspace_aligned')
+   apply (frule invs_pspace_distinct')
+   apply (frule (2) ksReadyQueues_asrt_ksReadyQueues_head_end_tcb_at')
+   apply (fastforce simp: obj_at'_def projectKOs state_refs_of'_def pred_tcb_at'_def
+                          tcb_bound_refs'_def
+                   dest!: symreftype_inverse')
+  apply (frule ksReadyQueues_asrt_ksReadyQueues_head_end)
+  apply (frule invs_pspace_aligned')
+  apply (frule invs_pspace_distinct')
+  apply (frule (2) ksReadyQueues_asrt_ksReadyQueues_head_end_tcb_at')
+  apply fastforce
+  done
 
 lemma tcb_ptr_to_ctcb_ptr_force_fold:
   "x + 2 ^ ctcb_size_bits = ptr_val (tcb_ptr_to_ctcb_ptr x)"
diff --git a/proof/crefine/ARM_HYP/Refine_C.thy b/proof/crefine/ARM_HYP/Refine_C.thy
index 2d20a22fa7..90daae6955 100644
--- a/proof/crefine/ARM_HYP/Refine_C.thy
+++ b/proof/crefine/ARM_HYP/Refine_C.thy
@@ -60,7 +60,7 @@ proof -
          apply (rule allI, rule conseqPre, vcg)
          apply (clarsimp simp: return_def)
         apply (wp schedule_sch_act_wf schedule_invs'
-             | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+             | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
       apply simp
      apply vcg
     apply vcg
@@ -74,14 +74,13 @@ proof -
        apply (rule allI, rule conseqPre, vcg)
        apply (clarsimp simp: return_def)
       apply (wp schedule_sch_act_wf schedule_invs'
-             | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+             | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
    apply simp
    apply (rule_tac Q="\<lambda>rv s. invs' s \<and> (\<forall>x. rv = Some x \<longrightarrow> x \<le> ARM_HYP.maxIRQ) \<and> rv \<noteq> Some 0x3FF \<and>
-                             sch_act_not (ksCurThread s) s \<and>
-                             (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))" in hoare_post_imp)
+                             sch_act_not (ksCurThread s) s"
+                in hoare_post_imp)
     apply (clarsimp simp: Kernel_C.maxIRQ_def ARM_HYP.maxIRQ_def)
    apply (wp getActiveIRQ_le_maxIRQ getActiveIRQ_neq_Some0xFF | simp)+
-  apply (clarsimp simp: ct_not_ksQ)
   apply (clarsimp simp: invs'_def valid_state'_def)
   done
 qed
@@ -107,14 +106,12 @@ lemma handleUnknownSyscall_ccorres:
          apply (rule allI, rule conseqPre, vcg)
         apply (clarsimp simp: return_def)
        apply (wp schedule_sch_act_wf schedule_invs'
-              | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+              | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
     apply (clarsimp, vcg)
    apply (clarsimp, rule conseqPre, vcg, clarsimp)
   apply clarsimp
   apply (intro impI conjI allI)
-      apply fastforce
-     apply (clarsimp simp: ct_not_ksQ)
-    apply (clarsimp simp add: sch_act_simple_def split: scheduler_action.split)
+    apply fastforce
    apply (rule active_ex_cap')
     apply (erule active_from_running')
    apply (erule invs_iflive')
@@ -167,13 +164,13 @@ lemma handleVMFaultEvent_ccorres:
        apply (rule allI, rule conseqPre, vcg)
        apply (clarsimp simp: return_def)
       apply (wp schedule_sch_act_wf schedule_invs'
-             | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+             | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
      apply (case_tac x, clarsimp, wp)
      apply (clarsimp, wp, simp)
     apply wp
    apply (simp add: guard_is_UNIV_def)
   apply (clarsimp simp: simple_sane_strg[unfolded sch_act_sane_not])
-  by (auto simp: ct_in_state'_def cfault_rel_def is_cap_fault_def ct_not_ksQ
+  by (auto simp: ct_in_state'_def cfault_rel_def is_cap_fault_def
               elim: pred_tcb'_weakenE st_tcb_ex_cap''
               dest: st_tcb_at_idle_thread' rf_sr_ksCurThread)
 
@@ -199,16 +196,14 @@ lemma handleUserLevelFault_ccorres:
         apply (rule allI, rule conseqPre, vcg)
         apply (clarsimp simp: return_def)
        apply (wp schedule_sch_act_wf schedule_invs'
-              | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+              | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
     apply (clarsimp, vcg)
    apply (clarsimp, rule conseqPre, vcg, clarsimp)
   apply clarsimp
   apply (intro impI conjI allI)
-      apply (simp add: ct_in_state'_def)
-      apply (erule pred_tcb'_weakenE)
-      apply simp
-     apply (clarsimp simp: ct_not_ksQ)
-    apply (clarsimp simp add: sch_act_simple_def split: scheduler_action.split)
+    apply (simp add: ct_in_state'_def)
+    apply (erule pred_tcb'_weakenE)
+    apply simp
    apply (rule active_ex_cap')
     apply (erule active_from_running')
    apply (erule invs_iflive')
@@ -388,11 +383,10 @@ lemma handleSyscall_ccorres:
           apply wp[1]
          apply clarsimp
          apply wp
-         apply (rule_tac Q="\<lambda>rv s. ct_in_state' simple' s \<and> sch_act_sane s \<and>
-                            (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))"
+         apply (rule_tac Q="\<lambda>rv s. ct_in_state' simple' s \<and> sch_act_sane s"
                               in hoare_post_imp)
           apply (simp add: ct_in_state'_def)
-         apply (wp handleReply_sane handleReply_ct_not_ksQ)
+         apply (wp handleReply_sane)
         \<comment> \<open>SysYield\<close>
         apply (clarsimp simp: syscall_from_H_def syscall_defs)
         apply (rule ccorres_cond_empty |rule ccorres_cond_univ)+
@@ -418,14 +412,14 @@ lemma handleSyscall_ccorres:
        apply (rule_tac P=\<top> and P'=UNIV in ccorres_from_vcg_throws)
        apply (rule allI, rule conseqPre, vcg)
        apply (clarsimp simp: return_def)
-      apply (wp schedule_invs' schedule_sch_act_wf | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+      apply (wp schedule_invs' schedule_sch_act_wf
+             | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
      apply (wpsimp wp: hoare_vcg_if_lift3)
       apply (strengthen non_kernel_IRQs_strg[where Q=True, simplified])
       apply (wpsimp wp: hoare_drop_imps)
      apply (simp
           | wpc
           | wp hoare_drop_imp handleReply_sane handleReply_nonz_cap_to_ct schedule_invs'
-               handleReply_ct_not_ksQ[simplified]
           | strengthen ct_active_not_idle'_strengthen invs_valid_objs_strengthen)+
       apply (rule_tac  Q="\<lambda>rv. invs' and ct_active'" in hoare_post_imp, simp)
       apply (wp hy_invs')
@@ -443,7 +437,7 @@ lemma handleSyscall_ccorres:
    apply (frule active_ex_cap')
     apply (clarsimp simp: invs'_def valid_state'_def)
    apply (clarsimp simp: simple_sane_strg ct_in_state'_def st_tcb_at'_def obj_at'_def
-                         isReply_def ct_not_ksQ)
+                         isReply_def)
    apply (rule conjI, fastforce)
    prefer 2
    apply (cut_tac 'b=32 and x=a and n=10 and 'a=10 in ucast_leq_mask)
@@ -535,14 +529,15 @@ lemma handleVCPUFault_ccorres:
            apply (ctac (no_vcg) add: activateThread_ccorres)
           apply (clarsimp, assumption)
          apply assumption
-        apply (wp schedule_sch_act_wf schedule_invs'|strengthen invs_queues invs_valid_objs')+
+        apply (wp schedule_sch_act_wf schedule_invs'
+               | strengthen invs_valid_objs' invs_pspace_aligned' invs_pspace_distinct')+
       apply vcg
      apply (clarsimp, rule conseqPre, vcg)
      apply clarsimp
     apply vcg
    apply (clarsimp, rule conseqPre, vcg)
    apply clarsimp
-  apply (clarsimp simp: ct_not_ksQ ct_running_imp_simple' fastpathKernelAssertions_def)
+  apply (clarsimp simp: ct_running_imp_simple' fastpathKernelAssertions_def)
   apply (rule conjI, rule active_ex_cap', erule active_from_running', fastforce)
   apply (clarsimp simp: cfault_rel_def seL4_Fault_VCPUFault_lift is_cap_fault_def)
   done
@@ -662,6 +657,7 @@ lemma callKernel_withFastpath_corres_C:
   apply (clarsimp simp: typ_heap_simps' ct_in_state'_def
                         "StrictC'_register_defs" word_sle_def word_sless_def
                         st_tcb_at'_opeq_simp)
+  apply (frule ready_qs_runnable_cross, (fastforce simp: valid_sched_def)+)
   apply (rule conjI, fastforce simp: st_tcb_at'_def)
   apply (auto elim!: pred_tcb'_weakenE cnode_caps_gsCNodes_from_sr[rotated])
   done
@@ -678,10 +674,13 @@ lemma threadSet_all_invs_triv':
   apply (rule hoare_pre)
    apply (rule wp_from_corres_unit)
      apply (rule threadset_corresT [where f="tcb_arch_update (arch_tcb_context_set f)"])
-        apply (simp add: tcb_relation_def arch_tcb_context_set_def
-                         atcbContextSet_def arch_tcb_relation_def)
-       apply (simp add: tcb_cap_cases_def)
-      apply (simp add: tcb_cte_cases_def)
+            apply (simp add: tcb_relation_def arch_tcb_context_set_def
+                            atcbContextSet_def arch_tcb_relation_def)
+           apply (simp add: tcb_cap_cases_def)
+          apply (simp add: tcb_cte_cases_def)
+         apply fastforce
+        apply fastforce
+       apply fastforce
      apply (simp add: exst_same_def)
     apply (wp thread_set_invs_trivial thread_set_ct_running thread_set_not_state_valid_sched
               threadSet_invs_trivial threadSet_ct_running' hoare_weak_lift_imp
@@ -691,7 +690,7 @@ lemma threadSet_all_invs_triv':
            | wp (once) hoare_vcg_disj_lift)+
   apply clarsimp
   apply (rule exI, rule conjI, assumption)
-  apply (clarsimp simp: invs_def invs'_def cur_tcb_def cur_tcb'_def)
+  apply (clarsimp simp: invs_def valid_state_def valid_pspace_def invs'_def cur_tcb_def)
   apply (simp add: state_relation_def)
   done
 
@@ -903,17 +902,22 @@ lemma dmo_domain_user_mem'[wp]:
   done
 
 lemma do_user_op_corres_C:
-  "corres_underlying rf_sr False False (=) (invs' and ex_abs einvs) \<top>
-                     (doUserOp f tc) (doUserOp_C f tc)"
+  "corres_underlying rf_sr False False (=)
+     (invs' and ksReadyQueues_asrt and ex_abs einvs) \<top>
+     (doUserOp f tc) (doUserOp_C f tc)"
   apply (simp only: doUserOp_C_def doUserOp_def split_def)
   apply (rule corres_guard_imp)
     apply (rule_tac P=\<top> and P'=\<top> and r'="(=)" in corres_split)
        apply (clarsimp simp: simpler_gets_def getCurThread_def
                 corres_underlying_def rf_sr_def cstate_relation_def Let_def)
-      apply (rule_tac P=valid_state' and P'=\<top> and r'="(=)" in corres_split)
+      apply (rule_tac P="valid_state' and ksReadyQueues_asrt"
+                  and P'=\<top> and r'="(=)"
+                   in corres_split)
          apply (clarsimp simp: cstate_to_A_def absKState_def
                                rf_sr_def cstate_to_H_correct ptable_lift_def)
-        apply (rule_tac P=valid_state' and P'=\<top> and r'="(=)" in corres_split)
+        apply (rule_tac P="valid_state' and ksReadyQueues_asrt"
+                    and P'=\<top> and r'="(=)"
+                     in corres_split)
            apply (clarsimp simp: cstate_to_A_def absKState_def
                                  rf_sr_def cstate_to_H_correct ptable_rights_def)
           apply (rule_tac P=pspace_distinct' and P'=\<top> and r'="(=)"
@@ -1010,6 +1014,9 @@ lemma refinement2_both:
     apply (subst cstate_to_H_correct)
      apply (fastforce simp: full_invs'_def invs'_def)
     apply (clarsimp simp: rf_sr_def)
+    apply (clarsimp simp: lift_state_relation_def full_invs_def)
+    apply (rule ksReadyQueues_asrt_cross)
+    apply (erule state_relation_ready_queues_relation)
    apply (simp add:absKState_def observable_memory_def absExst_def)
    apply (rule MachineTypes.machine_state.equality,simp_all)[1]
    apply (rule ext)
@@ -1036,13 +1043,35 @@ lemma refinement2_both:
    apply (clarsimp simp add: do_user_op_C_def do_user_op_H_def monad_to_transition_def)
    apply (rule rev_mp, rule_tac f="uop" and tc=af in do_user_op_corres_C)
    apply (clarsimp simp: corres_underlying_def invs_def ex_abs_def)
-   apply (fastforce simp: full_invs'_def ex_abs_def)
+   apply (drule bspec)
+    apply fastforce
+   apply clarsimp
+   apply (elim impE)
+    apply (clarsimp simp: full_invs'_def ex_abs_def)
+    apply (intro conjI)
+     apply (rule ksReadyQueues_asrt_cross)
+     apply (erule state_relation_ready_queues_relation)
+    apply (clarsimp simp: lift_state_relation_def full_invs_def)
+    apply (frule state_relation_ready_queues_relation)
+    apply (fastforce simp: ready_queues_relation_def Let_def tcbQueueEmpty_def)
+   apply fastforce
 
   apply (erule_tac P="a \<and> b \<and> c \<and> (\<exists>x. e x)" for a b c d e in disjE)
    apply (clarsimp simp add: do_user_op_C_def do_user_op_H_def monad_to_transition_def)
    apply (rule rev_mp, rule_tac f="uop" and tc=af in do_user_op_corres_C)
    apply (clarsimp simp: corres_underlying_def invs_def ex_abs_def)
-   apply (fastforce simp: full_invs'_def ex_abs_def)
+   apply (drule bspec)
+    apply fastforce
+   apply clarsimp
+   apply (elim impE)
+    apply (clarsimp simp: full_invs'_def ex_abs_def)
+    apply (intro conjI)
+     apply (rule ksReadyQueues_asrt_cross)
+     apply (erule state_relation_ready_queues_relation)
+    apply (clarsimp simp: lift_state_relation_def full_invs_def)
+    apply (frule state_relation_ready_queues_relation)
+    apply (fastforce simp: ready_queues_relation_def Let_def tcbQueueEmpty_def)
+   apply fastforce
 
   apply (clarsimp simp: check_active_irq_C_def check_active_irq_H_def)
   apply (rule rev_mp, rule check_active_irq_corres_C)
diff --git a/proof/crefine/ARM_HYP/Retype_C.thy b/proof/crefine/ARM_HYP/Retype_C.thy
index 1b2921f73d..8f91f1589a 100644
--- a/proof/crefine/ARM_HYP/Retype_C.thy
+++ b/proof/crefine/ARM_HYP/Retype_C.thy
@@ -3054,7 +3054,6 @@ lemma cnc_tcb_helper:
   and      al: "is_aligned (ctcb_ptr_to_tcb_ptr p) (objBitsKO kotcb)"
   and ptr0: "ctcb_ptr_to_tcb_ptr p \<noteq> 0"
   and ptrlb: "2^ctcb_size_bits \<le> ptr_val p"
-  and vq:  "valid_queues \<sigma>"
   and pal: "pspace_aligned' (\<sigma>\<lparr>ksPSpace := ks\<rparr>)"
   and pno: "pspace_no_overlap' (ctcb_ptr_to_tcb_ptr p) (objBitsKO kotcb) (\<sigma>\<lparr>ksPSpace := ks\<rparr>)"
   and pds: "pspace_distinct' (\<sigma>\<lparr>ksPSpace := ks\<rparr>)"
@@ -3431,9 +3430,10 @@ proof -
                          apply (simp add: thread_state_lift_def eval_nat_numeral atcbContextGet_def)+
      apply (simp add: Kernel_Config.timeSlice_def)
     apply (simp add: cfault_rel_def seL4_Fault_lift_def seL4_Fault_get_tag_def Let_def
-        lookup_fault_lift_def lookup_fault_get_tag_def lookup_fault_invalid_root_def
-        eval_nat_numeral seL4_Fault_NullFault_def option_to_ptr_def option_to_0_def
-        split: if_split)+
+                     lookup_fault_lift_def lookup_fault_get_tag_def lookup_fault_invalid_root_def
+                     eval_nat_numeral seL4_Fault_NullFault_def option_to_ptr_def option_to_0_def
+                     option_to_ctcb_ptr_def
+              split: if_split)+
     done
 
   have pks: "ks (ctcb_ptr_to_tcb_ptr p) = None"
@@ -3484,15 +3484,6 @@ proof -
     apply (fastforce simp: dom_def)
     done
 
-  hence kstcb: "\<And>qdom prio. ctcb_ptr_to_tcb_ptr p \<notin> set (ksReadyQueues \<sigma> (qdom, prio))" using vq
-    apply (clarsimp simp add: valid_queues_def valid_queues_no_bitmap_def)
-    apply (drule_tac x = qdom in spec)
-    apply (drule_tac x = prio in spec)
-    apply clarsimp
-    apply (drule (1) bspec)
-    apply (simp add: obj_at'_def)
-    done
-
   have ball_subsetE:
     "\<And>P S R. \<lbrakk> \<forall>x \<in> S. P x; R \<subseteq> S \<rbrakk> \<Longrightarrow> \<forall>x \<in> R. P x"
     by blast
@@ -3606,7 +3597,7 @@ proof -
     apply (simp add: cl_cte [simplified] cl_tcb [simplified] cl_rest [simplified] tag_disj_via_td_name)
     apply (clarsimp simp add: cready_queues_relation_def Let_def
                               htd_safe[simplified] kernel_data_refs_domain_eq_rotate)
-    apply (simp add: kstcb tcb_queue_update_other' hrs_htd_update
+    apply (simp add: tcb_queue_update_other' hrs_htd_update
                      ptr_retyp_to_array[simplified] irq[simplified])
     done
 qed
@@ -4555,7 +4546,7 @@ declare replicate_numeral [simp del]
 lemma ccorres_placeNewObject_tcb:
   "ccorresG rf_sr \<Gamma> dc xfdc
    (pspace_aligned' and pspace_distinct' and pspace_no_overlap' regionBase tcbBlockSizeBits
-      and valid_queues and (\<lambda>s. sym_refs (state_refs_of' s))
+      and (\<lambda>s. sym_refs (state_refs_of' s))
       and (\<lambda>s. 2 ^ tcbBlockSizeBits \<le> gsMaxObjectSize s)
       and ret_zero regionBase (2 ^ tcbBlockSizeBits)
       and K (regionBase \<noteq> 0 \<and> range_cover regionBase tcbBlockSizeBits tcbBlockSizeBits 1
@@ -4892,7 +4883,7 @@ qed
 lemma placeNewObject_user_data:
   "ccorresG rf_sr \<Gamma> dc xfdc
   (pspace_aligned' and pspace_distinct' and pspace_no_overlap' regionBase (pageBits+us)
-  and valid_queues and valid_machine_state'
+  and valid_machine_state'
   and ret_zero regionBase (2 ^ (pageBits+us))
   and (\<lambda>s. sym_refs (state_refs_of' s))
   and (\<lambda>s. 2^(pageBits +  us) \<le> gsMaxObjectSize s)
@@ -5033,7 +5024,7 @@ lemma placeNewObject_user_data_device:
   "ccorresG rf_sr \<Gamma> dc xfdc
   (pspace_aligned' and pspace_distinct'
     and ret_zero regionBase (2 ^ (pageBits + us))
-    and pspace_no_overlap' regionBase (pageBits+us) and valid_queues
+    and pspace_no_overlap' regionBase (pageBits+us)
     and (\<lambda>s. sym_refs (state_refs_of' s))
     and (\<lambda>s. 2^(pageBits +  us) \<le> gsMaxObjectSize s)
     and K (regionBase \<noteq> 0 \<and> range_cover regionBase (pageBits + us) (pageBits+us) (Suc 0)
@@ -5843,7 +5834,7 @@ proof -
      apply clarify
      apply (intro conjI)
       apply (clarsimp simp: invs_pspace_aligned' invs_pspace_distinct' invs_valid_global'
-                            APIType_capBits_def invs_queues invs_valid_objs'
+                            APIType_capBits_def invs_valid_objs'
                             invs_urz)
      apply clarsimp
      apply (clarsimp simp: pageBits_def ccap_relation_def APIType_capBits_def
@@ -5999,11 +5990,6 @@ lemma threadSet_domain_ccorres [corres]:
   apply (simp add: map_to_ctes_upd_tcb_no_ctes map_to_tcbs_upd tcb_cte_cases_def)
   apply (simp add: cep_relations_drop_fun_upd
                    cvariable_relation_upd_const ko_at_projectKO_opt)
-  apply (rule conjI)
-   defer
-   apply (erule cready_queues_relation_not_queue_ptrs)
-    apply (rule ext, simp split: if_split)
-   apply (rule ext, simp split: if_split)
   apply (drule ko_at_projectKO_opt)
   apply (erule (2) cmap_relation_upd_relI)
     subgoal by (simp add: ctcb_relation_def)
@@ -6127,7 +6113,6 @@ proof -
                                createObject_c_preconds_def)
          apply (frule invs_pspace_aligned')
          apply (frule invs_pspace_distinct')
-         apply (frule invs_queues)
          apply (frule invs_sym')
          apply (simp add: getObjectSize_def objBits_simps word_bits_conv
                           ARM_HYP_H.getObjectSize_def apiGetObjectSize_def
@@ -6181,7 +6166,6 @@ proof -
         apply (clarsimp simp: createObject_hs_preconds_def isFrameType_def)
         apply (frule invs_pspace_aligned')
         apply (frule invs_pspace_distinct')
-        apply (frule invs_queues)
         apply (frule invs_sym')
         apply (auto simp: getObjectSize_def objBits_simps
                           ARM_HYP_H.getObjectSize_def apiGetObjectSize_def
@@ -6222,7 +6206,6 @@ proof -
        apply (clarsimp simp: createObject_hs_preconds_def isFrameType_def)
        apply (frule invs_pspace_aligned')
        apply (frule invs_pspace_distinct')
-       apply (frule invs_queues)
        apply (frule invs_sym')
        apply (auto simp: getObjectSize_def objBits_simps
                          ARM_HYP_H.getObjectSize_def apiGetObjectSize_def
@@ -6265,7 +6248,6 @@ proof -
        apply (clarsimp simp: createObject_hs_preconds_def isFrameType_def)
        apply (frule invs_pspace_aligned')
        apply (frule invs_pspace_distinct')
-       apply (frule invs_queues)
        apply (frule invs_sym')
        apply (frule(1) ghost_assertion_size_logic_no_unat)
        apply (clarsimp simp: objBits_simps ARM_HYP_H.getObjectSize_def apiGetObjectSize_def
diff --git a/proof/crefine/ARM_HYP/SR_lemmas_C.thy b/proof/crefine/ARM_HYP/SR_lemmas_C.thy
index 3de04ec5ea..1fd9818801 100644
--- a/proof/crefine/ARM_HYP/SR_lemmas_C.thy
+++ b/proof/crefine/ARM_HYP/SR_lemmas_C.thy
@@ -310,11 +310,15 @@ lemma cmdbnode_relation_mdb_node_to_H [simp]:
   unfolding cmdbnode_relation_def mdb_node_to_H_def mdb_node_lift_def cte_lift_def
   by (fastforce split: option.splits)
 
-definition
-  tcb_no_ctes_proj :: "tcb \<Rightarrow> Structures_H.thread_state \<times> word32 \<times> word32 \<times> arch_tcb \<times> bool \<times> word8 \<times> word8 \<times> word8 \<times> nat \<times> fault option \<times> word32 option"
+definition tcb_no_ctes_proj ::
+  "tcb \<Rightarrow> Structures_H.thread_state \<times> machine_word \<times> machine_word \<times> arch_tcb \<times> bool \<times> word8
+          \<times> word8 \<times> word8 \<times> nat \<times> fault option \<times> machine_word option
+          \<times> machine_word option \<times> machine_word option"
   where
-  "tcb_no_ctes_proj t \<equiv> (tcbState t, tcbFaultHandler t, tcbIPCBuffer t, tcbArch t, tcbQueued t,
-                            tcbMCP t, tcbPriority t, tcbDomain t, tcbTimeSlice t, tcbFault t, tcbBoundNotification t)"
+  "tcb_no_ctes_proj t \<equiv>
+     (tcbState t, tcbFaultHandler t, tcbIPCBuffer t, tcbArch t, tcbQueued t,
+      tcbMCP t, tcbPriority t, tcbDomain t, tcbTimeSlice t, tcbFault t, tcbBoundNotification t,
+      tcbSchedNext t, tcbSchedPrev t)"
 
 lemma tcb_cte_cases_proj_eq [simp]:
   "tcb_cte_cases p = Some (getF, setF) \<Longrightarrow>
@@ -1488,9 +1492,9 @@ lemma cmap_relation_cong:
    apply (erule imageI)
    done
 
-lemma ctcb_relation_null_queue_ptrs:
+lemma ctcb_relation_null_ep_ptrs:
   assumes rel: "cmap_relation mp mp' tcb_ptr_to_ctcb_ptr ctcb_relation"
-  and same: "map_option tcb_null_queue_ptrs \<circ> mp'' = map_option tcb_null_queue_ptrs \<circ> mp'"
+  and same: "map_option tcb_null_ep_ptrs \<circ> mp'' = map_option tcb_null_ep_ptrs \<circ> mp'"
   shows "cmap_relation mp mp'' tcb_ptr_to_ctcb_ptr ctcb_relation"
   using rel
   apply (rule iffD1 [OF cmap_relation_cong, OF _ map_option_eq_dom_eq, rotated -1])
@@ -1498,7 +1502,7 @@ lemma ctcb_relation_null_queue_ptrs:
    apply (rule same [symmetric])
   apply (drule compD [OF same])
   apply (case_tac b, case_tac b')
-  apply (simp add: ctcb_relation_def tcb_null_queue_ptrs_def)
+  apply (simp add: ctcb_relation_def tcb_null_ep_ptrs_def)
   done
 
 (* Levity: added (20090419 09:44:27) *)
@@ -2406,6 +2410,14 @@ lemma update_vcpu_map_to_vcpu:
              = (map_to_vcpus (ksPSpace s))(p \<mapsto> vcpu)"
   by (rule ext, clarsimp simp: projectKOs map_comp_def split: if_split)
 
+lemma rf_sr_ctcb_queue_relation:
+  "\<lbrakk> (s, s') \<in> rf_sr; d \<le> maxDomain; p \<le> maxPriority \<rbrakk>
+  \<Longrightarrow> ctcb_queue_relation (ksReadyQueues s (d, p))
+                          (index (ksReadyQueues_' (globals s')) (cready_queues_index_to_C d p))"
+  unfolding rf_sr_def cstate_relation_def cready_queues_relation_def
+  apply (clarsimp simp: Let_def seL4_MinPrio_def minDom_def maxDom_to_H maxPrio_to_H)
+  done
+
 lemma rf_sr_sched_action_relation:
   "(s, s') \<in> rf_sr
    \<Longrightarrow> cscheduler_action_relation (ksSchedulerAction s) (ksSchedulerAction_' (globals s'))"
@@ -2444,5 +2456,11 @@ lemma physBase_spec:
   apply (simp add: Kernel_Config.physBase_def)
   done
 
+lemma rf_sr_obj_update_helper:
+  "(s, s'\<lparr> globals := globals s' \<lparr> t_hrs_' := t_hrs_' (globals (undefined
+              \<lparr> globals := (undefined \<lparr> t_hrs_' := f (globals s') (t_hrs_' (globals s')) \<rparr>)\<rparr>))\<rparr>\<rparr>) \<in> rf_sr
+          \<Longrightarrow> (s, globals_update (\<lambda>v. t_hrs_'_update (f v) v) s') \<in> rf_sr"
+  by (simp cong: StateSpace.state.fold_congs globals.fold_congs)
+
 end
 end
diff --git a/proof/crefine/ARM_HYP/Schedule_C.thy b/proof/crefine/ARM_HYP/Schedule_C.thy
index 8e632b4fb6..4c0ca2714c 100644
--- a/proof/crefine/ARM_HYP/Schedule_C.thy
+++ b/proof/crefine/ARM_HYP/Schedule_C.thy
@@ -6,25 +6,11 @@
  *)
 
 theory Schedule_C
-imports Tcb_C
+imports Tcb_C Detype_C
 begin
 
 instance tcb              :: no_vcpu by intro_classes auto
 
-context begin interpretation Arch . (*FIXME: arch_split*)
-
-(* FIXME: Move to Refine *)
-crunches Arch.switchToThread
-  for valid_queues'[wp]: valid_queues'
-  (ignore: clearExMonitor wp: crunch_wps)
-crunches switchToIdleThread
-  for ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
-crunches switchToIdleThread, switchToThread
-  for valid_pspace'[wp]: valid_pspace'
-  (simp: whenE_def)
-
-end
-
 (*FIXME: arch_split: move up?*)
 context Arch begin
 context begin global_naming global
@@ -51,16 +37,17 @@ lemma switchToIdleThread_ccorres:
   "ccorres dc xfdc invs_no_cicd' UNIV hs
            switchToIdleThread (Call switchToIdleThread_'proc)"
   apply (cinit)
+   apply (rule ccorres_stateAssert)
    apply (rule ccorres_symb_exec_l)
       apply (ctac (no_vcg) add: Arch_switchToIdleThread_ccorres)
        apply (simp add: setCurThread_def)
+       apply (rule ccorres_stateAssert)
        apply (rule_tac P="\<lambda>s. thread = ksIdleThread s" and P'=UNIV in ccorres_from_vcg)
        apply (rule allI, rule conseqPre, vcg)
        apply (clarsimp simp: simpler_modify_def)
        apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
                              carch_state_relation_def cmachine_state_relation_def)
-      apply (wpsimp simp: ARM_HYP_H.switchToIdleThread_def
-                      wp: vcpuSwitch_it')+
+      apply (wpsimp simp: ARM_HYP_H.switchToIdleThread_def wp: hoare_drop_imps)+
   done
 
 lemma Arch_switchToThread_ccorres:
@@ -94,6 +81,13 @@ lemma Arch_switchToThread_ccorres:
   apply (clarsimp simp: typ_heap_simps ctcb_relation_def carch_tcb_relation_def)
   done
 
+lemma invs_no_cicd'_pspace_aligned':
+  "all_invs_but_ct_idle_or_in_cur_domain' s \<Longrightarrow> pspace_aligned' s"
+  by (simp add: all_invs_but_ct_idle_or_in_cur_domain'_def valid_pspace'_def)
+
+lemma invs_no_cicd'_pspace_distinct':
+  "all_invs_but_ct_idle_or_in_cur_domain' s \<Longrightarrow> pspace_distinct' s"
+  by (simp add: all_invs_but_ct_idle_or_in_cur_domain'_def valid_pspace'_def)
 
 (* FIXME: move *)
 lemma switchToThread_ccorres:
@@ -103,23 +97,28 @@ lemma switchToThread_ccorres:
            hs
            (switchToThread t)
            (Call switchToThread_'proc)"
-  apply (cinit lift: thread_')
+  apply (clarsimp simp: switchToThread_def)
+  apply (rule ccorres_symb_exec_l'[OF _ _ isRunnable_sp]; (solves wpsimp)?)
+  apply (rule ccorres_symb_exec_l'[OF _ _ assert_sp]; (solves wpsimp)?)
+  apply (rule ccorres_stateAssert_fwd)+
+  apply (cinit' lift: thread_')
    apply (ctac (no_vcg) add: Arch_switchToThread_ccorres)
     apply (ctac (no_vcg) add: tcbSchedDequeue_ccorres)
+     apply (simp add: setCurThread_def)
+     apply (rule ccorres_stateAssert)
      apply (rule_tac P=\<top> and P'=UNIV in ccorres_from_vcg)
      apply clarsimp
      apply (rule conseqPre, vcg)
-     apply (clarsimp simp: setCurThread_def simpler_modify_def)
-     apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
-                           carch_state_relation_def cmachine_state_relation_def)
-    apply wp+
-  apply (clarsimp simp: all_invs_but_ct_idle_or_in_cur_domain'_def valid_state'_def)
+     apply (clarsimp simp: setCurThread_def simpler_modify_def rf_sr_def cstate_relation_def
+                           Let_def carch_state_relation_def cmachine_state_relation_def)
+    apply (wpsimp wp: Arch_switchToThread_invs_no_cicd' hoare_drop_imps
+           | strengthen invs_no_cicd'_pspace_aligned' invs_no_cicd'_pspace_distinct')+
   done
 
 lemma activateThread_ccorres:
   "ccorres dc xfdc
            (ct_in_state' activatable' and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)
-                   and valid_queues and valid_objs')
+            and valid_objs' and pspace_aligned' and pspace_distinct')
            UNIV []
            activateThread
            (Call activateThread_'proc)"
@@ -209,12 +208,36 @@ lemma switchToThread_ccorres':
      apply auto
   done
 
+lemma ccorres_pre_getQueue:
+  assumes cc: "\<And>queue. ccorres r xf (P queue) (P' queue) hs (f queue) c"
+  shows   "ccorres r xf (\<lambda>s. P (ksReadyQueues s (d, p)) s \<and> d \<le> maxDomain \<and> p \<le> maxPriority)
+                        {s'. \<forall>queue. (let cqueue = index (ksReadyQueues_' (globals s'))
+                                                         (cready_queues_index_to_C d p) in
+                                      ctcb_queue_relation queue cqueue) \<longrightarrow> s' \<in> P' queue}
+           hs (getQueue d p >>= (\<lambda>queue. f queue)) c"
+  apply (rule ccorres_guard_imp2)
+  apply (rule ccorres_symb_exec_l2)
+     defer
+     defer
+     apply (rule gq_sp)
+    defer
+    apply (rule ccorres_guard_imp)
+    apply (rule cc)
+     apply clarsimp
+     apply assumption
+    apply assumption
+   apply (clarsimp simp: getQueue_def gets_exs_valid)
+  apply clarsimp
+  apply (drule spec, erule mp)
+  apply (erule rf_sr_ctcb_queue_relation)
+   apply (simp add: maxDom_to_H maxPrio_to_H)+
+  done
+
 lemma chooseThread_ccorres:
   "ccorres dc xfdc all_invs_but_ct_idle_or_in_cur_domain' UNIV [] chooseThread (Call chooseThread_'proc)"
 proof -
 
   note prio_and_dom_limit_helpers [simp]
-  note ksReadyQueuesL2Bitmap_nonzeroI [simp]
   note Collect_const_mem [simp]
   (* when numDomains = 1, array bounds checks would become _ = 0 rather than _ < 1, changing the
      shape of the proof compared to when numDomains > 1 *)
@@ -224,9 +247,22 @@ proof -
     "\<And>s. invs_no_cicd' s \<Longrightarrow> ksCurDomain s \<le> maxDomain"
     by (simp add: invs_no_cicd'_def)
 
+  have invs_no_cicd'_valid_bitmaps:
+    "\<And>s. invs_no_cicd' s \<Longrightarrow> valid_bitmaps s"
+    by (simp add: invs_no_cicd'_def)
+
+  have invs_no_cicd'_pspace_aligned':
+    "\<And>s. invs_no_cicd' s \<Longrightarrow> pspace_aligned' s"
+    by (simp add: invs_no_cicd'_def valid_pspace'_def)
+
+  have invs_no_cicd'_pspace_distinct':
+    "\<And>s. invs_no_cicd' s \<Longrightarrow> pspace_distinct' s"
+    by (simp add: invs_no_cicd'_def valid_pspace'_def)
+
   show ?thesis
     supply if_split[split del]
     apply (cinit)
+     apply (rule ccorres_stateAssert)+
      apply (simp add: numDomains_sge_1_simp)
      apply (rule_tac xf'=dom_' and r'="\<lambda>rv rv'. rv' = ucast rv" in ccorres_split_nothrow_novcg)
          apply (rule ccorres_from_vcg[where P=\<top> and P'=UNIV])
@@ -259,7 +295,7 @@ proof -
          apply (rule_tac P="curdom \<le> maxDomain" in ccorres_cross_over_guard_no_st)
          apply (rule_tac P="prio \<le> maxPriority" in ccorres_cross_over_guard_no_st)
          apply (rule ccorres_pre_getQueue)
-         apply (rule_tac P="queue \<noteq> []" in ccorres_cross_over_guard_no_st)
+         apply (rule_tac P="\<not> tcbQueueEmpty queue" in ccorres_cross_over_guard_no_st)
          apply (rule ccorres_symb_exec_l)
             apply (rule ccorres_assert)
             apply (rule ccorres_symb_exec_r)
@@ -274,37 +310,40 @@ proof -
              apply (rule conseqPre, vcg)
              apply (rule Collect_mono)
              apply clarsimp
-             apply (strengthen queue_in_range)
              apply assumption
             apply clarsimp
             apply (rule conseqPre, vcg)
             apply clarsimp
            apply (wp isRunnable_wp)+
        apply (clarsimp simp: Let_def guard_is_UNIV_def)
-       apply (drule invs_no_cicd'_queues)
-       apply (case_tac queue, simp)
-       apply (clarsimp simp: tcb_queue_relation'_def cready_queues_index_to_C_def numPriorities_def)
-       apply (clarsimp simp add: maxDom_to_H maxPrio_to_H
-                                 queue_in_range[where qdom=0, simplified, simplified maxPrio_to_H])
-       apply (clarsimp simp: le_maxDomain_eq_less_numDomains unat_trans_ucast_helper )
+       apply (rule conjI)
+        apply (clarsimp simp: le_maxDomain_eq_less_numDomains unat_trans_ucast_helper)
+       apply (intro conjI impI)
+        apply (clarsimp simp: cready_queues_index_to_C_def numPriorities_def ctcb_queue_relation_def
+                              tcbQueueEmpty_def option_to_ctcb_ptr_def)
+       apply (frule_tac qdom=curdom and prio=rv in cready_queues_index_to_C_in_range')
+        apply fastforce
+       apply (clarsimp simp: num_tcb_queues_val word_less_nat_alt cready_queues_index_to_C_def2)
       apply wpsimp
      apply (clarsimp simp: guard_is_UNIV_def le_maxDomain_eq_less_numDomains word_less_nat_alt
                            numDomains_less_numeric_explicit)
-    apply (frule invs_no_cicd'_queues)
+    apply clarsimp
     apply (frule invs_no_cicd'_max_CurDomain)
-    apply (frule invs_no_cicd'_queues)
-    apply (clarsimp simp: valid_queues_def lookupBitmapPriority_le_maxPriority)
+    apply (frule invs_no_cicd'_pspace_aligned')
+    apply (frule invs_no_cicd'_pspace_distinct')
+    apply (frule invs_no_cicd'_valid_bitmaps)
+    apply (frule valid_bitmaps_bitmapQ_no_L1_orphans)
+    apply (frule valid_bitmaps_valid_bitmapQ)
+    apply (clarsimp simp: ready_queue_relation_def ksReadyQueues_asrt_def cong: conj_cong)
     apply (intro conjI impI)
-       apply (fastforce dest: bitmapQ_from_bitmap_lookup simp: valid_bitmapQ_bitmapQ_simp)
-      apply (fastforce dest: lookupBitmapPriority_obj_at'
-                       simp: pred_conj_def obj_at'_def st_tcb_at'_def)
-     apply (fastforce dest: bitmapQ_from_bitmap_lookup simp: valid_bitmapQ_bitmapQ_simp)
-    apply (clarsimp simp: pred_conj_def obj_at'_def st_tcb_at'_def)
-    apply (clarsimp simp: not_less le_maxDomain_eq_less_numDomains)
-    apply (prop_tac "ksCurDomain s = 0")
-     using unsigned_eq_0_iff apply force
-    apply (cut_tac s=s in lookupBitmapPriority_obj_at'; simp?)
-    apply (clarsimp simp: pred_conj_def obj_at'_def st_tcb_at'_def)
+         apply (fastforce intro: lookupBitmapPriority_le_maxPriority)
+        apply (fastforce dest!: bitmapQ_from_bitmap_lookup valid_bitmapQ_bitmapQ_simp)
+       apply (fastforce dest!: lookupBitmapPriority_obj_at'
+                         simp: ready_queue_relation_def ksReadyQueues_asrt_def st_tcb_at'_def obj_at'_def)
+      apply (fastforce dest: lookupBitmapPriority_le_maxPriority)
+     apply (fastforce dest!: bitmapQ_from_bitmap_lookup valid_bitmapQ_bitmapQ_simp)
+    apply (fastforce dest!: lookupBitmapPriority_obj_at'
+                      simp: ready_queue_relation_def ksReadyQueues_asrt_def st_tcb_at'_def obj_at'_def)
     done
 qed
 
@@ -628,7 +667,7 @@ lemma schedule_ccorres:
           apply (wp (once) hoare_drop_imps)
            apply wp
           apply (strengthen strenghten_False_imp[where P="a = ResumeCurrentThread" for a])
-          apply (clarsimp simp: conj_ac invs_queues invs_valid_objs' cong: conj_cong)
+          apply (clarsimp simp: conj_ac invs_valid_objs' cong: conj_cong)
           apply wp
          apply (clarsimp, vcg exspec=tcbSchedEnqueue_modifies)
         apply (clarsimp, vcg exspec=tcbSchedEnqueue_modifies)
@@ -648,9 +687,11 @@ lemma schedule_ccorres:
     apply wp
    apply vcg
 
-  apply (clarsimp simp: tcb_at_invs' rf_sr_ksCurThread if_apply_def2 invs_queues invs_valid_objs')
+  apply (clarsimp simp: tcb_at_invs' rf_sr_ksCurThread if_apply_def2 invs_valid_objs')
   apply (frule invs_sch_act_wf')
   apply (frule tcb_at_invs')
+  apply (frule invs_pspace_aligned')
+  apply (frule invs_pspace_distinct')
   apply (rule conjI)
    apply (clarsimp dest!: rf_sr_cscheduler_relation simp: cscheduler_action_relation_def)
   apply (rule conjI; clarsimp)
@@ -699,11 +740,7 @@ lemma threadSet_timeSlice_ccorres [corres]:
                    map_to_tcbs_upd)
   apply (simp add: cep_relations_drop_fun_upd cvariable_relation_upd_const
                    ko_at_projectKO_opt)
-  apply (rule conjI)
    defer
-   apply (erule cready_queues_relation_not_queue_ptrs)
-    apply (rule ext, simp split: if_split)
-   apply (rule ext, simp split: if_split)
   apply (drule ko_at_projectKO_opt)
   apply (erule (2) cmap_relation_upd_relI)
     apply (simp add: ctcb_relation_def)
@@ -747,7 +784,7 @@ lemma timerTick_ccorres:
                apply simp
                apply (ctac (no_vcg) add: tcbSchedAppend_ccorres)
                 apply (ctac add: rescheduleRequired_ccorres)
-               apply (wp weak_sch_act_wf_lift_linear threadSet_valid_queues
+               apply (wp weak_sch_act_wf_lift_linear
                          threadSet_pred_tcb_at_state tcbSchedAppend_valid_objs' threadSet_valid_objs' threadSet_tcbDomain_triv
                     | clarsimp simp: st_tcb_at'_def o_def split: if_splits)+
              apply (vcg exspec=tcbSchedDequeue_modifies)
diff --git a/proof/crefine/ARM_HYP/StateRelation_C.thy b/proof/crefine/ARM_HYP/StateRelation_C.thy
index 085931cff3..6ede377ef7 100644
--- a/proof/crefine/ARM_HYP/StateRelation_C.thy
+++ b/proof/crefine/ARM_HYP/StateRelation_C.thy
@@ -16,8 +16,7 @@ definition
 definition
   "array_relation r n a c \<equiv> \<forall>i \<le> n. r (a i) (index c (unat i))"
 
-(* used for bound ntfn/tcb *)
-definition
+definition option_to_ctcb_ptr :: "machine_word option \<Rightarrow> tcb_C ptr" where
   "option_to_ctcb_ptr x \<equiv> case x of None \<Rightarrow> NULL | Some t \<Rightarrow> tcb_ptr_to_ctcb_ptr t"
 
 
@@ -371,7 +370,9 @@ where
      \<and> tcbTimeSlice atcb    = unat (tcbTimeSlice_C ctcb)
      \<and> cfault_rel (tcbFault atcb) (seL4_Fault_lift (tcbFault_C ctcb))
                   (lookup_fault_lift (tcbLookupFailure_C ctcb))
-     \<and> option_to_ptr (tcbBoundNotification atcb) = tcbBoundNotification_C ctcb"
+     \<and> option_to_ptr (tcbBoundNotification atcb) = tcbBoundNotification_C ctcb
+     \<and> option_to_ctcb_ptr (tcbSchedPrev atcb) = tcbSchedPrev_C ctcb
+     \<and> option_to_ctcb_ptr (tcbSchedNext atcb) = tcbSchedNext_C ctcb"
 
 abbreviation
   "ep_queue_relation' \<equiv> tcb_queue_relation' tcbEPNext_C tcbEPPrev_C"
@@ -600,17 +601,17 @@ definition
 where
   "cready_queues_index_to_C qdom prio \<equiv> (unat qdom) * numPriorities + (unat prio)"
 
-definition cready_queues_relation ::
-  "tcb_C typ_heap \<Rightarrow> (tcb_queue_C[num_tcb_queues]) \<Rightarrow> (domain \<times> priority \<Rightarrow> ready_queue) \<Rightarrow> bool"
-where
-  "cready_queues_relation h_tcb queues aqueues \<equiv>
-     \<forall>qdom prio. ((qdom \<ge> ucast minDom \<and> qdom \<le> ucast maxDom \<and>
-                  prio \<ge> ucast minPrio \<and> prio \<le> ucast maxPrio) \<longrightarrow>
-       (let cqueue = index queues (cready_queues_index_to_C qdom prio) in
-            sched_queue_relation' h_tcb (aqueues (qdom, prio)) (head_C cqueue) (end_C cqueue)))
-        \<and> (\<not> (qdom \<ge> ucast minDom \<and> qdom \<le> ucast maxDom \<and>
-                  prio \<ge> ucast minPrio \<and> prio \<le> ucast maxPrio) \<longrightarrow> aqueues (qdom, prio) = [])"
+definition ctcb_queue_relation :: "tcb_queue \<Rightarrow> tcb_queue_C \<Rightarrow> bool" where
+   "ctcb_queue_relation aqueue cqueue \<equiv>
+      head_C cqueue = option_to_ctcb_ptr (tcbQueueHead aqueue)
+      \<and> end_C cqueue = option_to_ctcb_ptr (tcbQueueEnd aqueue)"
 
+definition cready_queues_relation ::
+  "(domain \<times> priority \<Rightarrow> ready_queue) \<Rightarrow> (tcb_queue_C[num_tcb_queues]) \<Rightarrow>  bool"
+  where
+  "cready_queues_relation aqueues cqueues \<equiv>
+     \<forall>d p. d \<le> maxDomain \<and> p \<le> maxPriority
+           \<longrightarrow> ctcb_queue_relation (aqueues (d, p)) (index cqueues (cready_queues_index_to_C d p))"
 
 abbreviation
   "cte_array_relation astate cstate
@@ -748,9 +749,7 @@ where
   "cstate_relation astate cstate \<equiv>
      let cheap = t_hrs_' cstate in
        cpspace_relation (ksPSpace astate) (underlying_memory (ksMachineState astate)) cheap \<and>
-       cready_queues_relation (clift cheap)
-                             (ksReadyQueues_' cstate)
-                             (ksReadyQueues astate) \<and>
+       cready_queues_relation (ksReadyQueues astate) (ksReadyQueues_' cstate) \<and>
        zero_ranges_are_zero (gsUntypedZeroRanges astate) cheap \<and>
        cbitmap_L1_relation (ksReadyQueuesL1Bitmap_' cstate) (ksReadyQueuesL1Bitmap astate) \<and>
        cbitmap_L2_relation (ksReadyQueuesL2Bitmap_' cstate) (ksReadyQueuesL2Bitmap astate) \<and>
diff --git a/proof/crefine/ARM_HYP/SyscallArgs_C.thy b/proof/crefine/ARM_HYP/SyscallArgs_C.thy
index 9a6af32f0c..8ad4b332e5 100644
--- a/proof/crefine/ARM_HYP/SyscallArgs_C.thy
+++ b/proof/crefine/ARM_HYP/SyscallArgs_C.thy
@@ -48,9 +48,7 @@ lemma replyOnRestart_invs'[wp]:
   including no_pre
   apply (simp add: replyOnRestart_def)
   apply (wp setThreadState_nonqueued_state_update rfk_invs' hoare_weak_lift_imp)
-  apply (rule hoare_vcg_all_lift)
-  apply (wp setThreadState_nonqueued_state_update rfk_invs' hoare_vcg_all_lift rfk_ksQ)
-   apply (rule hoare_strengthen_post, rule gts_sp')
+  apply (rule hoare_strengthen_post, rule gts_sp')
   apply (clarsimp simp: pred_tcb_at')
   apply (auto elim!: pred_tcb'_weakenE st_tcb_ex_cap''
                dest: st_tcb_at_idle_thread')
diff --git a/proof/crefine/ARM_HYP/Syscall_C.thy b/proof/crefine/ARM_HYP/Syscall_C.thy
index 4fe21b768b..8608bfab4f 100644
--- a/proof/crefine/ARM_HYP/Syscall_C.thy
+++ b/proof/crefine/ARM_HYP/Syscall_C.thy
@@ -49,8 +49,7 @@ lemma cap_cases_one_on_true_sum:
 lemma performInvocation_Endpoint_ccorres:
   "ccorres (K (K \<bottom>) \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
        (invs' and st_tcb_at' simple' thread and ep_at' epptr
-              and sch_act_sane and (\<lambda>s. thread = ksCurThread s
-              \<and> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))))
+              and sch_act_sane and (\<lambda>s. thread = ksCurThread s))
        (UNIV \<inter> {s. block_' s = from_bool blocking}
              \<inter> {s. call_' s = from_bool do_call}
              \<inter> {s. badge_' s = badge}
@@ -123,7 +122,6 @@ lemma decodeInvocation_ccorres:
               and (\<lambda>s. \<forall>v \<in> set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s)
               and (\<lambda>s. \<forall>v \<in> set extraCaps. s \<turnstile>' fst v \<and> cte_at' (snd v) s)
               and (\<lambda>s. \<forall>v \<in> set extraCaps. \<forall>y \<in> zobj_refs' (fst v). ex_nonz_cap_to' y s)
-              and (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))
               and sysargs_rel args buffer)
        (UNIV \<inter> {s. call_' s = from_bool isCall}
              \<inter> {s. block_' s = from_bool isBlocking}
@@ -200,7 +198,7 @@ lemma decodeInvocation_ccorres:
       apply simp
       apply (rule hoare_use_eq[where f=ksCurThread])
        apply (wp sts_invs_minor' sts_st_tcb_at'_cases
-                 setThreadState_ct' hoare_vcg_all_lift sts_ksQ')+
+                 setThreadState_ct' hoare_vcg_all_lift)+
      apply simp
      apply (vcg exspec=setThreadState_modifies)
     apply vcg
@@ -522,7 +520,7 @@ lemma wordFromMessageInfo_spec:
 
 lemma handleDoubleFault_ccorres:
   "ccorres dc xfdc (invs' and  tcb_at' tptr and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and
-        sch_act_not tptr and (\<lambda>s. \<forall>p. tptr \<notin> set (ksReadyQueues s p)))
+        sch_act_not tptr)
       (UNIV \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr tptr})
       [] (handleDoubleFault tptr ex1 ex2)
          (Call handleDoubleFault_'proc)"
@@ -600,8 +598,7 @@ lemma hrs_mem_update_use_hrs_mem:
 
 lemma sendFaultIPC_ccorres:
   "ccorres  (cfault_rel2 \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
-      (invs' and st_tcb_at' simple' tptr and sch_act_not tptr and
-       (\<lambda>s. \<forall>p. tptr \<notin> set (ksReadyQueues s p)))
+      (invs' and st_tcb_at' simple' tptr and sch_act_not tptr)
       (UNIV \<inter> {s. (cfault_rel (Some fault) (seL4_Fault_lift(current_fault_' (globals s)))
                        (lookup_fault_lift(current_lookup_fault_' (globals s))))}
             \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr tptr})
@@ -679,8 +676,8 @@ lemma sendFaultIPC_ccorres:
               apply (ctac (no_vcg) add: sendIPC_ccorres)
                apply (ctac (no_vcg) add: ccorres_return_CE [unfolded returnOk_def comp_def])
               apply wp
-             apply (wp threadSet_pred_tcb_no_state threadSet_invs_trivial threadSet_typ_at_lifts
-                    | simp)+
+             apply (wpsimp wp: threadSet_invs_trivial)
+             apply (wpsimp wp: threadSet_pred_tcb_no_state threadSet_typ_at_lifts)
 
             apply (clarsimp simp: guard_is_UNIV_def)
             apply (subgoal_tac "capEPBadge epcap && mask 28 = capEPBadge epcap")
@@ -715,8 +712,7 @@ lemma sendFaultIPC_ccorres:
          apply vcg
         apply (clarsimp simp: inQ_def)
         apply (rule_tac Q="\<lambda>a b. invs' b \<and> st_tcb_at' simple' tptr b
-                                 \<and> sch_act_not tptr b \<and> valid_cap' a b
-                                 \<and> (\<forall>p. tptr \<notin> set (ksReadyQueues b p))"
+                                 \<and> sch_act_not tptr b \<and> valid_cap' a b"
                  and E="\<lambda> _. \<top>"
                  in hoare_post_impErr)
           apply (wp)
@@ -737,8 +733,7 @@ lemma sendFaultIPC_ccorres:
   done
 
 lemma handleFault_ccorres:
-  "ccorres dc xfdc (invs' and st_tcb_at' simple' t and
-        sch_act_not t and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p)))
+  "ccorres dc xfdc (invs' and st_tcb_at' simple' t and sch_act_not t)
       (UNIV \<inter> {s. (cfault_rel (Some flt) (seL4_Fault_lift(current_fault_' (globals s)))
                        (lookup_fault_lift(current_lookup_fault_' (globals s))) )}
             \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr t})
@@ -825,8 +820,7 @@ lemma getMessageInfo_msgLength':
 lemma handleInvocation_ccorres:
   "ccorres (K dc \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
        (invs' and (\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and
-        ct_active' and sch_act_simple and
-        (\<lambda>s. \<forall>x. ksCurThread s \<notin> set (ksReadyQueues s x)))
+        ct_active' and sch_act_simple)
        (UNIV \<inter> {s. isCall_' s = from_bool isCall}
              \<inter> {s. isBlocking_' s = from_bool isBlocking}) []
        (handleInvocation isCall isBlocking) (Call handleInvocation_'proc)"
@@ -955,7 +949,7 @@ lemma handleInvocation_ccorres:
                      apply (wp hoare_split_bind_case_sumE hoare_drop_imps
                                setThreadState_nonqueued_state_update
                                ct_in_state'_set setThreadState_st_tcb
-                               hoare_vcg_all_lift sts_ksQ'
+                               hoare_vcg_all_lift
                                  | wpc | wps)+
                     apply auto[1]
                    apply clarsimp
@@ -1217,9 +1211,6 @@ lemma ccorres_trim_redundant_throw_break:
 lemma invs_valid_objs_strengthen:
   "invs' s \<longrightarrow> valid_objs' s" by fastforce
 
-lemma ct_not_ksQ_strengthen:
-  "thread = ksCurThread s \<and> ksCurThread s \<notin> set (ksReadyQueues s p) \<longrightarrow> thread \<notin> set (ksReadyQueues s p)" by fastforce
-
 lemma option_to_ctcb_ptr_valid_ntfn:
   "valid_ntfn' ntfn s ==> (option_to_ctcb_ptr (ntfnBoundTCB ntfn) = NULL) = (ntfnBoundTCB ntfn = None)"
   apply (cases "ntfnBoundTCB ntfn", simp_all add: option_to_ctcb_ptr_def)
@@ -1253,8 +1244,7 @@ lemma handleRecv_ccorres:
   notes rf_sr_upd_safe[simp del] if_cong[cong]
   shows
   "ccorres dc xfdc
-       (\<lambda>s. invs' s \<and> st_tcb_at' simple' (ksCurThread s) s
-               \<and> sch_act_sane s \<and> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)))
+       (\<lambda>s. invs' s \<and> st_tcb_at' simple' (ksCurThread s) s \<and> sch_act_sane s)
        {s. isBlocking_' s = from_bool isBlocking}
        []
        (handleRecv isBlocking)
@@ -1317,7 +1307,7 @@ lemma handleRecv_ccorres:
             apply (rule_tac P="\<lambda>s. ksCurThread s = thread" in ccorres_cross_over_guard)
             apply (ctac add: receiveIPC_ccorres)
 
-           apply (wp deleteCallerCap_ksQ_ct' hoare_vcg_all_lift)
+           apply (wp hoare_vcg_all_lift)
           apply (rule conseqPost[where Q'=UNIV and A'="{}"], vcg exspec=deleteCallerCap_modifies)
            apply (clarsimp dest!: rf_sr_ksCurThread)
           apply simp
@@ -1440,13 +1430,11 @@ lemma handleRecv_ccorres:
       apply clarsimp
       apply (rename_tac thread epCPtr)
         apply (rule_tac Q'="(\<lambda>rv s. invs' s \<and> st_tcb_at' simple' thread s
-               \<and> sch_act_sane s \<and> (\<forall>p. thread \<notin> set (ksReadyQueues s p)) \<and> thread = ksCurThread s
+               \<and> sch_act_sane s \<and> thread = ksCurThread s
                \<and> valid_cap' rv s)" in hoare_post_imp_R[rotated])
-         apply (clarsimp simp: sch_act_sane_def)
-         apply (auto dest!: obj_at_valid_objs'[OF _ invs_valid_objs']
-                      simp: projectKOs valid_obj'_def,
-                auto simp: pred_tcb_at'_def obj_at'_def objBits_simps projectKOs ct_in_state'_def)[1]
-         apply wp
+       apply (intro conjI impI allI; clarsimp simp: sch_act_sane_def)
+       apply (fastforce dest: obj_at_valid_objs'[OF _ invs_valid_objs'] ko_at_valid_ntfn')
+      apply wp
      apply clarsimp
      apply (vcg exspec=isStopped_modifies exspec=lookupCap_modifies)
 
@@ -1495,7 +1483,7 @@ lemma handleYield_ccorres:
        apply (ctac add: rescheduleRequired_ccorres)
       apply (wp weak_sch_act_wf_lift_linear tcbSchedAppend_valid_objs')
      apply (vcg exspec= tcbSchedAppend_modifies)
-    apply (wp weak_sch_act_wf_lift_linear tcbSchedDequeue_valid_queues)
+    apply (wp weak_sch_act_wf_lift_linear)
    apply (vcg exspec= tcbSchedDequeue_modifies)
   apply (clarsimp simp: tcb_at_invs' invs_valid_objs'
                         valid_objs'_maxPriority valid_objs'_maxDomain)
@@ -1800,8 +1788,7 @@ lemma ccorres_vgicMaintenance:
   notes virq_virq_pending_set_virqEOIIRQEN_spec = virq_virq_pending_set_virqEOIIRQEN_spec'
   shows
   "ccorres dc xfdc
-     (\<lambda>s. invs' s \<and> sch_act_not (ksCurThread s) s
-          \<and> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)))
+     (\<lambda>s. invs' s \<and> sch_act_not (ksCurThread s) s)
      UNIV hs
      vgicMaintenance (Call VGICMaintenance_'proc)"
   (is "ccorres _ _ ?PRE _ _ _ _")
@@ -2136,7 +2123,6 @@ lemma ccorres_VPPIEvent:
   shows
   "ccorres dc xfdc
      (\<lambda>s. invs' s \<and> sch_act_not (ksCurThread s) s
-          \<and> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))
           \<and> irqVPPIEventIndex irq \<noteq> None)
      \<lbrace>\<acute>irq = ucast irq\<rbrace> hs
      (vppiEvent irq) (Call VPPIEvent_'proc)"
@@ -2218,8 +2204,7 @@ qed
 
 lemma ccorres_handleReservedIRQ:
   "ccorres dc xfdc
-    (invs' and (\<lambda>s. irq \<in> non_kernel_IRQs \<longrightarrow> sch_act_not (ksCurThread s) s \<and>
-                     (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))))
+    (invs' and (\<lambda>s. irq \<in> non_kernel_IRQs \<longrightarrow> sch_act_not (ksCurThread s) s))
     (UNIV \<inter> {s. irq_' s = ucast irq}) hs
     (handleReservedIRQ irq) (Call handleReservedIRQ_'proc)"
   supply Collect_const[simp del]
@@ -2257,10 +2242,8 @@ lemma ccorres_handleReservedIRQ:
 
 lemma handleInterrupt_ccorres:
   "ccorres dc xfdc
-     (invs' and (\<lambda>s. irq \<in> non_kernel_IRQs \<longrightarrow> sch_act_not (ksCurThread s) s \<and>
-                     (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))))
-     (UNIV \<inter> \<lbrace>\<acute>irq = ucast irq\<rbrace>)
-     hs
+     (invs' and (\<lambda>s. irq \<in> non_kernel_IRQs \<longrightarrow> sch_act_not (ksCurThread s) s))
+     \<lbrace>\<acute>irq = ucast irq\<rbrace> hs
      (handleInterrupt irq)
      (Call handleInterrupt_'proc)"
   apply (cinit lift: irq_' cong: call_ignore_cong)
diff --git a/proof/crefine/ARM_HYP/TcbQueue_C.thy b/proof/crefine/ARM_HYP/TcbQueue_C.thy
index 5b6dba4499..c83f759d51 100644
--- a/proof/crefine/ARM_HYP/TcbQueue_C.thy
+++ b/proof/crefine/ARM_HYP/TcbQueue_C.thy
@@ -891,49 +891,6 @@ lemma tcb_queue_relation'_prev_mask:
   shows "ptr_val (getPrev tcb) && ~~ mask bits = ptr_val (getPrev tcb)"
   by (rule tcb_queue_relation_prev_mask [OF tcb_queue_relation'_queue_rel], fact+)
 
-
-lemma cready_queues_relation_null_queue_ptrs:
-  assumes rel: "cready_queues_relation mp cq aq"
-  and same: "option_map tcb_null_ep_ptrs \<circ> mp' = option_map tcb_null_ep_ptrs \<circ> mp"
-  shows "cready_queues_relation mp' cq aq"
-  using rel
-  apply (clarsimp simp: cready_queues_relation_def Let_def all_conj_distrib)
-  apply (drule spec, drule spec, drule mp, (erule conjI)+, assumption)
-  apply (clarsimp simp: tcb_queue_relation'_def)
-  apply (erule iffD2 [OF tcb_queue_relation_only_next_prev, rotated -1])
-   apply (rule ext)
-   apply (case_tac "mp' x")
-    apply (frule compD [OF same])
-    apply simp
-   apply (frule compD [OF same])
-   apply (clarsimp simp: tcb_null_ep_ptrs_def)
-   apply (case_tac z, case_tac a)
-   apply simp
-  \<comment> \<open>clag\<close>
-  apply (rule ext)
-  apply (case_tac "mp' x")
-   apply (frule compD [OF same])
-   apply simp
-  apply (frule compD [OF same])
-  apply (clarsimp simp: tcb_null_ep_ptrs_def)
-  apply (case_tac z, case_tac a)
-  apply simp
-  done
-
-lemma cready_queues_relation_not_queue_ptrs:
-  assumes rel: "cready_queues_relation mp cq aq"
-  and same: "option_map tcbSchedNext_C \<circ> mp' = option_map tcbSchedNext_C \<circ> mp"
-  "option_map tcbSchedPrev_C \<circ> mp' = option_map tcbSchedPrev_C \<circ> mp"
-  shows "cready_queues_relation mp' cq aq"
-  using rel
-  apply (clarsimp simp: cready_queues_relation_def tcb_queue_relation'_def Let_def all_conj_distrib)
-  apply (drule spec, drule spec, drule mp, (erule conjI)+, assumption)
-  apply clarsimp
-  apply (erule iffD2 [OF tcb_queue_relation_only_next_prev, rotated -1])
-   apply (rule same)
-  apply (rule same)
-  done
-
 lemma ntfn_ep_disjoint:
   assumes  srs: "sym_refs (state_refs_of' s)"
   and     epat: "ko_at' ep epptr s"
@@ -1101,8 +1058,6 @@ lemma rf_sr_tcb_update_no_queue:
     (tcb_ptr_to_ctcb_ptr thread) ctcb) (t_hrs_' (globals s'));
   tcbEPNext_C ctcb = tcbEPNext_C (the (cslift s' (tcb_ptr_to_ctcb_ptr thread)));
   tcbEPPrev_C ctcb = tcbEPPrev_C (the (cslift s' (tcb_ptr_to_ctcb_ptr thread)));
-  tcbSchedNext_C ctcb = tcbSchedNext_C (the (cslift s' (tcb_ptr_to_ctcb_ptr thread)));
-  tcbSchedPrev_C ctcb = tcbSchedPrev_C (the (cslift s' (tcb_ptr_to_ctcb_ptr thread)));
   (\<forall>x\<in>ran tcb_cte_cases. (\<lambda>(getF, setF). getF tcb' = getF tcb) x);
   ctcb_relation tcb' ctcb
   \<rbrakk>
@@ -1116,31 +1071,22 @@ lemma rf_sr_tcb_update_no_queue:
   apply (clarsimp simp: map_comp_update projectKO_opt_tcb cvariable_relation_upd_const
                         typ_heap_simps')
   apply (intro conjI)
-       subgoal by (clarsimp simp: cmap_relation_def map_comp_update projectKO_opts_defs inj_eq)
-      apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-      apply simp
-      apply (rule cendpoint_relation_upd_tcb_no_queues, assumption+)
-       subgoal by (clarsimp intro!: ext)
-      subgoal by (clarsimp intro!: ext)
+      subgoal by (clarsimp simp: cmap_relation_def map_comp_update projectKO_opts_defs inj_eq)
      apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
      apply simp
-     apply (rule cnotification_relation_upd_tcb_no_queues, assumption+)
+     apply (rule cendpoint_relation_upd_tcb_no_queues, assumption+)
       subgoal by (clarsimp intro!: ext)
      subgoal by (clarsimp intro!: ext)
-    apply (erule cready_queues_relation_not_queue_ptrs)
+    apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+    apply simp
+    apply (rule cnotification_relation_upd_tcb_no_queues, assumption+)
      subgoal by (clarsimp intro!: ext)
     subgoal by (clarsimp intro!: ext)
    subgoal by (simp add: carch_state_relation_def typ_heap_simps')
   by (simp add: cmachine_state_relation_def)
 
-lemma rf_sr_tcb_update_no_queue_helper:
-  "(s, s'\<lparr> globals := globals s' \<lparr> t_hrs_' := t_hrs_' (globals (undefined
-              \<lparr> globals := (undefined \<lparr> t_hrs_' := f (globals s') (t_hrs_' (globals s')) \<rparr>)\<rparr>))\<rparr>\<rparr>) \<in> rf_sr
-          \<Longrightarrow> (s, globals_update (\<lambda>v. t_hrs_'_update (f v) v) s') \<in> rf_sr"
-  by (simp cong: StateSpace.state.fold_congs globals.fold_congs)
-
-lemmas rf_sr_tcb_update_no_queue2
-    = rf_sr_tcb_update_no_queue_helper [OF rf_sr_tcb_update_no_queue, simplified]
+lemmas rf_sr_tcb_update_no_queue2 =
+  rf_sr_obj_update_helper[OF rf_sr_tcb_update_no_queue, simplified]
 
 lemma tcb_queue_relation_not_in_q:
   "ctcb_ptr_to_tcb_ptr x \<notin> set xs \<Longrightarrow>
@@ -1170,31 +1116,24 @@ lemma rf_sr_tcb_update_not_in_queue:
    apply clarsimp
    apply (auto simp: obj_at'_def ko_wp_at'_def)[1]
   apply (intro conjI)
-       subgoal by (clarsimp simp: cmap_relation_def map_comp_update projectKO_opts_defs inj_eq)
-      apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-      apply clarsimp
-      apply (subgoal_tac "thread \<notin> (fst ` ep_q_refs_of' a)")
-       apply (clarsimp simp: cendpoint_relation_def Let_def split: Structures_H.endpoint.split)
-       subgoal by (intro conjI impI allI, simp_all add: image_def tcb_queue_relation_not_in_q)[1]
-      apply (drule(1) map_to_ko_atI')
-      apply (drule sym_refs_ko_atD', clarsimp+)
-      subgoal by blast
+      subgoal by (clarsimp simp: cmap_relation_def map_comp_update projectKO_opts_defs inj_eq)
      apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
      apply clarsimp
-     apply (subgoal_tac "thread \<notin> (fst ` ntfn_q_refs_of' (ntfnObj a))")
-      apply (clarsimp simp: cnotification_relation_def Let_def
-                     split: ntfn.splits)
-      subgoal by (simp add: image_def tcb_queue_relation_not_in_q)[1]
+     apply (subgoal_tac "thread \<notin> (fst ` ep_q_refs_of' a)")
+      apply (clarsimp simp: cendpoint_relation_def Let_def split: Structures_H.endpoint.split)
+      subgoal by (intro conjI impI allI, simp_all add: image_def tcb_queue_relation_not_in_q)[1]
      apply (drule(1) map_to_ko_atI')
      apply (drule sym_refs_ko_atD', clarsimp+)
      subgoal by blast
-    apply (simp add: cready_queues_relation_def, erule allEI)
-    apply (clarsimp simp: Let_def)
-    apply (subst tcb_queue_relation_not_in_q)
-     apply clarsimp
-     apply (drule valid_queues_obj_at'D, clarsimp)
-     apply (clarsimp simp: obj_at'_def projectKOs inQ_def)
-    subgoal by simp
+    apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+    apply clarsimp
+    apply (subgoal_tac "thread \<notin> (fst ` ntfn_q_refs_of' (ntfnObj a))")
+     apply (clarsimp simp: cnotification_relation_def Let_def
+                    split: ntfn.splits)
+     subgoal by (simp add: image_def tcb_queue_relation_not_in_q)[1]
+    apply (drule(1) map_to_ko_atI')
+    apply (drule sym_refs_ko_atD', clarsimp+)
+    subgoal by blast
    subgoal by (simp add: carch_state_relation_def carch_globals_def
                          typ_heap_simps')
   by (simp add: cmachine_state_relation_def)
diff --git a/proof/crefine/ARM_HYP/Tcb_C.thy b/proof/crefine/ARM_HYP/Tcb_C.thy
index 661b7aa95d..980cc69829 100644
--- a/proof/crefine/ARM_HYP/Tcb_C.thy
+++ b/proof/crefine/ARM_HYP/Tcb_C.thy
@@ -59,8 +59,6 @@ lemma doMachineOp_sched:
   done
 
 context begin interpretation Arch . (*FIXME: arch_split*)
-crunch queues[wp]: setupReplyMaster "valid_queues"
-  (simp: crunch_simps wp: crunch_wps)
 
 crunch curThread [wp]: restart "\<lambda>s. P (ksCurThread s)"
   (wp: crunch_wps simp: crunch_simps)
@@ -391,9 +389,10 @@ lemma hrs_mem_update_cong:
 
 lemma setPriority_ccorres:
   "ccorres dc xfdc
-      (\<lambda>s. tcb_at' t s \<and> Invariants_H.valid_queues s \<and>  ksCurDomain s \<le> maxDomain \<and>
-           valid_queues' s \<and> valid_objs' s \<and> weak_sch_act_wf (ksSchedulerAction s) s \<and> (priority \<le> maxPriority))
-      (UNIV \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr t} \<inter> {s. prio_' s = ucast priority})
+      (\<lambda>s. tcb_at' t s \<and> ksCurDomain s \<le> maxDomain \<and>
+           valid_objs' s \<and> weak_sch_act_wf (ksSchedulerAction s) s \<and> (priority \<le> maxPriority) \<and>
+           pspace_aligned' s \<and> pspace_distinct' s)
+      ({s. tptr_' s = tcb_ptr_to_ctcb_ptr t} \<inter> {s. prio_' s = ucast priority})
       [] (setPriority t priority) (Call setPriority_'proc)"
   apply (cinit lift: tptr_' prio_')
    apply (ctac(no_vcg) add: tcbSchedDequeue_ccorres)
@@ -416,7 +415,7 @@ lemma setPriority_ccorres:
         apply (ctac add: possibleSwitchTo_ccorres)
        apply (rule ccorres_return_Skip')
       apply (wp isRunnable_wp)
-     apply (wpsimp wp: hoare_drop_imps threadSet_valid_queues threadSet_valid_objs'
+     apply (wpsimp wp: hoare_drop_imps threadSet_valid_objs'
                        weak_sch_act_wf_lift_linear threadSet_pred_tcb_at_state
                        threadSet_tcbDomain_triv
                  simp: st_tcb_at'_def o_def split: if_splits)
@@ -425,18 +424,13 @@ lemma setPriority_ccorres:
                  where Q="\<lambda>rv s.
                           obj_at' (\<lambda>_. True) t s \<and>
                           priority \<le> maxPriority \<and>
-                          Invariants_H.valid_queues s \<and>
                           ksCurDomain s \<le> maxDomain \<and>
                           valid_objs' s \<and>
-                          valid_queues' s \<and>
                           weak_sch_act_wf (ksSchedulerAction s) s \<and>
-                          (\<forall>d p. \<not> t \<in> set (ksReadyQueues s (d, p)))"])
-    apply (wp weak_sch_act_wf_lift_linear tcbSchedDequeue_valid_queues tcbSchedDequeue_nonq)
+                          pspace_aligned' s \<and> pspace_distinct' s"])
+    apply (wp weak_sch_act_wf_lift_linear valid_tcb'_def)
    apply (clarsimp simp: valid_tcb'_tcbPriority_update)
   apply clarsimp
-  apply (frule (1) valid_objs'_maxDomain[where t=t])
-  apply (frule (1) valid_objs'_maxPriority[where t=t])
-  apply simp
   done
 
 lemma setMCPriority_ccorres:
@@ -674,12 +668,12 @@ lemma invokeTCB_ThreadControl_ccorres:
                         apply (clarsimp simp: guard_is_UNIV_def Collect_const_mem)
                        apply (rule hoare_strengthen_post [
                                     where Q= "\<lambda>rv s.
-                                              Invariants_H.valid_queues s \<and>
                                               valid_objs' s \<and>
                                               weak_sch_act_wf (ksSchedulerAction s) s \<and>
                                               ((\<exists>a b. priority = Some (a, b)) \<longrightarrow>
                                                    tcb_at' target s \<and> ksCurDomain s \<le> maxDomain \<and>
-                                                   valid_queues' s \<and>  fst (the priority) \<le> maxPriority)"])
+                                                   fst (the priority) \<le> maxPriority) \<and>
+                                              pspace_aligned' s \<and> pspace_distinct' s"])
                         apply (strengthen sch_act_wf_weak)
                         apply (wp hoare_weak_lift_imp)
                        apply (clarsimp split: if_splits)
@@ -764,12 +758,12 @@ lemma invokeTCB_ThreadControl_ccorres:
                apply (clarsimp simp: guard_is_UNIV_def Collect_const_mem)
               apply (simp cong: conj_cong)
               apply (rule hoare_strengthen_post[
-                            where Q="\<lambda>a b. (Invariants_H.valid_queues b \<and>
-                                       valid_objs' b \<and>
+                            where Q="\<lambda>a b. (valid_objs' b \<and>
                                        sch_act_wf (ksSchedulerAction b) b \<and>
+                                       pspace_aligned' b \<and> pspace_distinct' b \<and>
                                        ((\<exists>a b. priority = Some (a, b)) \<longrightarrow>
                                           tcb_at'  target b \<and>
-                                          ksCurDomain b \<le> maxDomain \<and> valid_queues' b \<and>
+                                          ksCurDomain b \<le> maxDomain \<and>
                                           fst (the priority) \<le> maxPriority)) \<and>
                                        ((case snd (the buf)
                                            of None \<Rightarrow> 0
@@ -792,15 +786,15 @@ lemma invokeTCB_ThreadControl_ccorres:
                prefer 2
                apply fastforce
               apply (strengthen cte_is_derived_capMasterCap_strg
-                                invs_queues invs_weak_sch_act_wf invs_sch_act_wf'
+                                invs_weak_sch_act_wf invs_sch_act_wf'
                                 invs_valid_objs' invs_mdb' invs_pspace_aligned',
                             simp add: o_def)
               apply (rule_tac P="is_aligned (fst (the buf)) msg_align_bits"
                        in hoare_gen_asm)
               apply (wp threadSet_ipcbuffer_trivial hoare_weak_lift_imp
                      | simp
-                     | strengthen invs_sch_act_wf' invs_valid_objs' invs_weak_sch_act_wf  invs_queues
-                                  invs_valid_queues' | wp hoare_drop_imps)+
+                     | strengthen invs_sch_act_wf' invs_valid_objs' invs_weak_sch_act_wf
+                     | wp hoare_drop_imps)+
              (* \<not> P *)
              apply (clarsimp simp: guard_is_UNIV_def Collect_const_mem
                                    option_to_0_def
@@ -810,7 +804,7 @@ lemma invokeTCB_ThreadControl_ccorres:
              apply (rule ccorres_return_C_errorE, simp+)[1]
             apply vcg
            apply (simp add: conj_comms cong: conj_cong)
-           apply (strengthen invs_ksCurDomain_maxDomain')
+           apply (strengthen invs_ksCurDomain_maxDomain' invs_pspace_distinct')
            apply (wp hoare_vcg_const_imp_lift_R cteDelete_invs')
           apply simp
           apply (rule ccorres_split_nothrow_novcg_dc)
@@ -827,8 +821,7 @@ lemma invokeTCB_ThreadControl_ccorres:
          apply (rule conjI)
           apply (clarsimp simp: case_option_If2 if_n_0_0 objBits_simps' valid_cap'_def
                                 capAligned_def word_bits_conv obj_at'_def projectKOs)
-         apply (clarsimp simp: invs_valid_objs' invs_valid_queues'
-                               Invariants_H.invs_queues invs_ksCurDomain_maxDomain')
+         apply (fastforce simp: invs_valid_objs' invs_ksCurDomain_maxDomain')
         apply (rule ccorres_Cond_rhs_Seq)
          apply (rule ccorres_rhs_assoc)+
          apply csymbr
@@ -1058,7 +1051,7 @@ lemma restart_ccorres:
         apply (ctac(no_vcg) add: tcbSchedEnqueue_ccorres)
          apply (ctac add: possibleSwitchTo_ccorres)
         apply (wp weak_sch_act_wf_lift)[1]
-       apply (wp sts_valid_queues setThreadState_st_tcb)[1]
+       apply (wp sts_valid_objs' setThreadState_st_tcb)[1]
       apply (simp add: valid_tcb_state'_def)
       apply wp
       apply (wp (once) sch_act_wf_lift, (wp tcb_in_cur_domain'_lift)+)
@@ -1668,7 +1661,7 @@ lemma invokeTCB_WriteRegisters_ccorres[where S=UNIV]:
   apply (clarsimp simp: frame_gp_registers_convs word_less_nat_alt
                         sysargs_rel_def n_frameRegisters_def n_msgRegisters_def
                   split: if_split_asm)
-  apply (simp add: invs_weak_sch_act_wf invs_valid_objs' invs_queues)
+  apply (simp add: invs_weak_sch_act_wf invs_valid_objs')
   apply (fastforce dest!: global'_no_ex_cap simp: invs'_def valid_state'_def)
   done
 
@@ -3193,7 +3186,8 @@ lemma decodeTCBConfigure_ccorres:
    apply (rule conjI, fastforce)
    apply (drule interpret_excaps_eq)
    apply (clarsimp simp: cte_wp_at_ctes_of valid_tcb_state'_def numeral_eqs le_ucast_ucast_le
-                         tcb_at_invs' invs_valid_objs' invs_queues invs_sch_act_wf'
+                         tcb_at_invs' invs_valid_objs' invs_sch_act_wf'
+                         invs_pspace_aligned' invs_pspace_distinct'
                          ct_in_state'_def pred_tcb_at'_def obj_at'_def tcb_st_refs_of'_def)
    apply (erule disjE; simp add: objBits_defs mask_def)
   apply (clarsimp simp: idButNot_def interpret_excaps_test_null
@@ -4450,9 +4444,9 @@ lemma invokeTCB_SetTLSBase_ccorres:
        apply (rule ccorres_return_CE, simp+)[1]
       apply (wpsimp wp: hoare_drop_imp simp: guard_is_UNIV_def)+
    apply vcg
-  apply (clarsimp simp: tlsBaseRegister_def ARM_HYP.tlsBaseRegister_def
-                        invs_weak_sch_act_wf invs_queues TLS_BASE_def TPIDRURW_def
-                 split: if_split)
+  apply (fastforce simp: tlsBaseRegister_def ARM_HYP.tlsBaseRegister_def
+                         invs_weak_sch_act_wf TLS_BASE_def TPIDRURW_def
+                  split: if_split)
   done
 
 lemma decodeSetTLSBase_ccorres:
diff --git a/proof/crefine/ARM_HYP/Wellformed_C.thy b/proof/crefine/ARM_HYP/Wellformed_C.thy
index d42a1b71e0..eba1590e20 100644
--- a/proof/crefine/ARM_HYP/Wellformed_C.thy
+++ b/proof/crefine/ARM_HYP/Wellformed_C.thy
@@ -170,10 +170,6 @@ where
 abbreviation
   "ep_queue_relation \<equiv> tcb_queue_relation tcbEPNext_C tcbEPPrev_C"
 
-abbreviation
-  "sched_queue_relation \<equiv> tcb_queue_relation tcbSchedNext_C tcbSchedPrev_C"
-
-
 definition
 wordSizeCase :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" where
 "wordSizeCase a b \<equiv> (if bitSize (undefined::word32) = 32
diff --git a/proof/crefine/Move_C.thy b/proof/crefine/Move_C.thy
index e0e8dae8cc..bef3026fc2 100644
--- a/proof/crefine/Move_C.thy
+++ b/proof/crefine/Move_C.thy
@@ -625,9 +625,7 @@ lemma tcbFault_submonad_args:
 lemma threadGet_stateAssert_gets:
   "threadGet ext t = do stateAssert (tcb_at' t) []; gets (thread_fetch ext t) od"
   apply (rule is_stateAssert_gets [OF _ _ empty_fail_threadGet no_fail_threadGet])
-    apply (clarsimp intro!: obj_at_ko_at'[where P="\<lambda>tcb :: tcb. True", simplified]
-           | wp threadGet_wp)+
-  apply (clarsimp simp: obj_at'_def thread_fetch_def projectKOs)
+  apply (wp threadGet_wp | clarsimp simp: obj_at'_def thread_fetch_def projectKOs)+
   done
 
 lemma threadGet_tcbFault_submonad_fn:
@@ -915,14 +913,6 @@ lemma ex_st_tcb_at'_simp[simp]:
   "(\<exists>ts. st_tcb_at' ((=) ts) dest s) = tcb_at' dest s"
   by (auto simp add: pred_tcb_at'_def obj_at'_def)
 
-lemma threadGet_wp:
-  "\<lbrace>\<lambda>s. \<forall>tcb. ko_at' tcb thread s \<longrightarrow> P (f tcb) s\<rbrace> threadGet f thread \<lbrace>P\<rbrace>"
-  apply (rule hoare_post_imp [OF _ tg_sp'])
-  apply clarsimp
-  apply (frule obj_at_ko_at')
-  apply (clarsimp elim: obj_atE')
-  done
-
 lemma threadGet_wp'':
   "\<lbrace>\<lambda>s. \<forall>v. obj_at' (\<lambda>tcb. f tcb = v) thread s \<longrightarrow> P v s\<rbrace> threadGet f thread \<lbrace>P\<rbrace>"
   apply (rule hoare_pre)
@@ -1029,10 +1019,6 @@ lemma st_tcb_at'_opeq_simp:
     = st_tcb_at' (\<lambda>st. st = Structures_H.thread_state.Running) (ksCurThread s) s"
   by (fastforce simp add: st_tcb_at'_def obj_at'_def)
 
-lemma invs_queues_imp:
-  "invs' s \<longrightarrow> valid_queues s"
-  by clarsimp
-
 lemma invs'_pspace_domain_valid:
   "invs' s \<Longrightarrow> pspace_domain_valid s"
   by (simp add: invs'_def valid_state'_def)
@@ -1042,45 +1028,6 @@ lemma and_eq_0_is_nth:
   shows "y = 1 << n \<Longrightarrow> ((x && y) = 0) = (\<not> (x !! n))"
   by (metis (poly_guards_query) and_eq_0_is_nth)
 
-lemma tcbSchedEnqueue_obj_at_unchangedT:
-  assumes y: "\<And>f. \<forall>tcb. P (tcbQueued_update f tcb) = P tcb"
-  shows  "\<lbrace>obj_at' P t\<rbrace> tcbSchedEnqueue t' \<lbrace>\<lambda>rv. obj_at' P t\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply (wp | simp add: y)+
-  done
-
-lemma rescheduleRequired_obj_at_unchangedT:
-  assumes y: "\<And>f. \<forall>tcb. P (tcbQueued_update f tcb) = P tcb"
-  shows  "\<lbrace>obj_at' P t\<rbrace> rescheduleRequired \<lbrace>\<lambda>rv. obj_at' P t\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp tcbSchedEnqueue_obj_at_unchangedT[OF y] | wpc)+
-  apply simp
-  done
-
-lemma setThreadState_obj_at_unchangedT:
-  assumes x: "\<And>f. \<forall>tcb. P (tcbState_update f tcb) = P tcb"
-  assumes y: "\<And>f. \<forall>tcb. P (tcbQueued_update f tcb) = P tcb"
-  shows "\<lbrace>obj_at' P t\<rbrace> setThreadState t' ts \<lbrace>\<lambda>rv. obj_at' P t\<rbrace>"
-  apply (simp add: setThreadState_def)
-  apply (wp rescheduleRequired_obj_at_unchangedT[OF y], simp)
-  apply (wp threadSet_obj_at'_strongish)
-  apply (clarsimp simp: obj_at'_def projectKOs x cong: if_cong)
-  done
-
-lemma setBoundNotification_obj_at_unchangedT:
-  assumes x: "\<And>f. \<forall>tcb. P (tcbBoundNotification_update f tcb) = P tcb"
-  shows "\<lbrace>obj_at' P t\<rbrace> setBoundNotification t' ts \<lbrace>\<lambda>rv. obj_at' P t\<rbrace>"
-  apply (simp add: setBoundNotification_def)
-  apply (wp threadSet_obj_at'_strongish)
-  apply (clarsimp simp: obj_at'_def projectKOs x cong: if_cong)
-  done
-
-lemmas setThreadState_obj_at_unchanged
-    = setThreadState_obj_at_unchangedT[OF all_tcbI all_tcbI]
-
-lemmas setBoundNotification_obj_at_unchanged
-    = setBoundNotification_obj_at_unchangedT[OF all_tcbI]
-
 lemma magnitudeCheck_assert2:
   "\<lbrakk> is_aligned x n; (1 :: machine_word) < 2 ^ n; ksPSpace s x = Some v \<rbrakk> \<Longrightarrow>
    magnitudeCheck x (snd (lookupAround2 x (ksPSpace (s :: kernel_state)))) n
@@ -1299,13 +1246,6 @@ lemma ksPSpace_update_eq_ExD:
      \<Longrightarrow> \<exists>ps. s = t \<lparr> ksPSpace := ps \<rparr>"
   by (erule exI)
 
-lemma tcbSchedEnqueue_queued_queues_inv:
-  "\<lbrace>\<lambda>s.  obj_at' tcbQueued t s \<and> P (ksReadyQueues s) \<rbrace> tcbSchedEnqueue t \<lbrace>\<lambda>_ s. P (ksReadyQueues s)\<rbrace>"
-  unfolding tcbSchedEnqueue_def unless_def
-  apply (wpsimp simp: if_apply_def2 wp: threadGet_wp)
-  apply normalise_obj_at'
-  done
-
 (* FIXME BV: generalise *)
 lemma word_clz_1[simp]:
   "word_clz (1::32 word) = 31"
diff --git a/proof/crefine/RISCV64/ADT_C.thy b/proof/crefine/RISCV64/ADT_C.thy
index 7b4ddd4efe..e4961e7853 100644
--- a/proof/crefine/RISCV64/ADT_C.thy
+++ b/proof/crefine/RISCV64/ADT_C.thy
@@ -77,8 +77,8 @@ lemma Basic_sem_eq:
 
 lemma setTCBContext_C_corres:
   "\<lbrakk> ccontext_relation tc tc'; t' = tcb_ptr_to_ctcb_ptr t \<rbrakk> \<Longrightarrow>
-  corres_underlying rf_sr nf nf' dc (pspace_domain_valid and tcb_at' t) \<top>
-    (threadSet (\<lambda>tcb. tcb \<lparr> tcbArch := atcbContextSet tc (tcbArch tcb)\<rparr>) t) (setTCBContext_C tc' t')"
+   corres_underlying rf_sr nf nf' dc (pspace_domain_valid and tcb_at' t) \<top>
+     (threadSet (\<lambda>tcb. tcb \<lparr> tcbArch := atcbContextSet tc (tcbArch tcb)\<rparr>) t) (setTCBContext_C tc' t')"
   apply (simp add: setTCBContext_C_def exec_C_def Basic_sem_eq corres_underlying_def)
   apply clarsimp
   apply (simp add: threadSet_def bind_assoc split_def exec_gets)
@@ -107,8 +107,6 @@ lemma setTCBContext_C_corres:
   apply (simp add: map_to_ctes_upd_tcb_no_ctes map_to_tcbs_upd tcb_cte_cases_def
                    cvariable_relation_upd_const ko_at_projectKO_opt cteSizeBits_def)
   apply (simp add: cep_relations_drop_fun_upd)
-  apply (apply_conjunct \<open>match conclusion in \<open>cready_queues_relation _ _ _\<close> \<Rightarrow>
-         \<open>erule cready_queues_relation_not_queue_ptrs; rule ext; simp split: if_split\<close>\<close>)
   apply (drule ko_at_projectKO_opt)
   apply (erule (2) cmap_relation_upd_relI)
     apply (simp add: ctcb_relation_def carch_tcb_relation_def)
@@ -591,25 +589,51 @@ lemma tcb_queue_rel'_unique:
   apply (erule(2) tcb_queue_rel_unique)
   done
 
-definition
-  cready_queues_to_H
-  :: "(tcb_C ptr \<rightharpoonup> tcb_C) \<Rightarrow> (tcb_queue_C[num_tcb_queues]) \<Rightarrow> word8 \<times> word8 \<Rightarrow> machine_word list"
+
+definition tcb_queue_C_to_tcb_queue :: "tcb_queue_C \<Rightarrow> tcb_queue" where
+  "tcb_queue_C_to_tcb_queue q \<equiv>
+     TcbQueue (if head_C q = NULL then None else Some (ctcb_ptr_to_tcb_ptr (head_C q)))
+              (if end_C q = NULL then None else Some (ctcb_ptr_to_tcb_ptr (end_C q)))"
+
+definition cready_queues_to_H ::
+  "tcb_queue_C[num_tcb_queues] \<Rightarrow> (domain \<times> priority \<Rightarrow> ready_queue)"
   where
-  "cready_queues_to_H h_tcb cs \<equiv> \<lambda>(qdom, prio). if ucast minDom \<le> qdom \<and> qdom \<le> ucast maxDom
-              \<and> ucast seL4_MinPrio \<le> prio \<and> prio \<le> ucast seL4_MaxPrio
-   then THE aq. let cqueue = index cs (cready_queues_index_to_C qdom prio)
-    in sched_queue_relation' h_tcb aq (head_C cqueue) (StateRelation_C.end_C cqueue)
-   else []"
+  "cready_queues_to_H cs \<equiv>
+     \<lambda>(qdom, prio).
+       if qdom \<le> maxDomain \<and> prio \<le> maxPriority
+       then let cqueue = index cs (cready_queues_index_to_C qdom prio)
+             in tcb_queue_C_to_tcb_queue cqueue
+       else TcbQueue None None"
 
 lemma cready_queues_to_H_correct:
-  "cready_queues_relation (clift s) cs as \<Longrightarrow>
-   cready_queues_to_H (clift s) cs = as"
-  apply (clarsimp simp: cready_queues_to_H_def cready_queues_relation_def
-                   fun_eq_iff)
-  apply (rule the_equality)
-   apply simp
-  apply (clarsimp simp: Let_def)
-  apply (rule_tac hp="clift s" in tcb_queue_rel'_unique, simp_all add: lift_t_NULL)
+  "\<lbrakk>cready_queues_relation (ksReadyQueues s) (ksReadyQueues_' ch);
+    no_0_obj' s; ksReadyQueues_asrt s; pspace_aligned' s; pspace_distinct' s\<rbrakk>
+   \<Longrightarrow> cready_queues_to_H (ksReadyQueues_' ch) = ksReadyQueues s"
+  apply (clarsimp simp: cready_queues_to_H_def cready_queues_relation_def Let_def)
+  apply (clarsimp simp: fun_eq_iff)
+  apply (rename_tac d p)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply (clarsimp simp: ready_queue_relation_def ksReadyQueues_asrt_def)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply clarsimp
+  apply (frule (3) obj_at'_tcbQueueHead_ksReadyQueues)
+  apply (frule (3) obj_at'_tcbQueueEnd_ksReadyQueues)
+  apply (frule tcbQueueHead_iff_tcbQueueEnd)
+  apply (rule conjI)
+   apply (clarsimp simp: tcb_queue_C_to_tcb_queue_def ctcb_queue_relation_def option_to_ctcb_ptr_def)
+   apply (case_tac "tcbQueueHead (ksReadyQueues s (d, p)) = None")
+    apply (clarsimp simp: tcb_queue.expand)
+   apply clarsimp
+   apply (rename_tac queue_head queue_end)
+   apply (prop_tac "tcb_at' queue_head s", fastforce simp: tcbQueueEmpty_def obj_at'_def)
+   apply (prop_tac "tcb_at' queue_end s", fastforce simp: tcbQueueEmpty_def obj_at'_def)
+   apply (drule kernel.tcb_at_not_NULL)+
+   apply (fastforce simp: tcb_queue.expand kernel.ctcb_ptr_to_ctcb_ptr)
+  apply (clarsimp simp: tcbQueueEmpty_def ctcb_queue_relation_def option_to_ctcb_ptr_def
+                 split: option.splits;
+         metis tcb_queue.exhaust_sel word_not_le)
   done
 
 (* showing that cpspace_relation is actually unique >>>*)
@@ -753,12 +777,15 @@ lemma cthread_state_rel_imp_eq:
   apply (cases y, simp_all add: ThreadState_defs)+
   done
 
-lemma ksPSpace_valid_objs_tcbBoundNotification_nonzero:
-  "\<exists>s. ksPSpace s = ah \<and> no_0_obj' s \<and> valid_objs' s
-     \<Longrightarrow> map_to_tcbs ah p = Some tcb \<Longrightarrow> tcbBoundNotification tcb \<noteq> Some 0"
+lemma map_to_tcbs_Some_refs_nonzero:
+  "\<lbrakk>map_to_tcbs (ksPSpace s) p = Some tcb; no_0_obj' s; valid_objs' s\<rbrakk>
+   \<Longrightarrow> tcbBoundNotification tcb \<noteq> Some 0
+       \<and> tcbSchedPrev tcb \<noteq> Some 0
+       \<and> tcbSchedNext tcb \<noteq> Some 0"
+  supply word_neq_0_conv[simp del]
   apply (clarsimp simp: map_comp_def split: option.splits)
-  apply (erule(1) valid_objsE')
-  apply (clarsimp simp: projectKOs valid_obj'_def valid_tcb'_def)
+  apply (erule (1) valid_objsE')
+  apply (fastforce simp: projectKOs valid_obj'_def valid_tcb'_def)
   done
 
 lemma atcbContextGet_inj[simp]:
@@ -769,34 +796,75 @@ lemma ccontext_relation_imp_eq2:
   "\<lbrakk>ccontext_relation (atcbContextGet t) x; ccontext_relation (atcbContextGet t') x\<rbrakk> \<Longrightarrow> t = t'"
   by (auto dest: ccontext_relation_imp_eq)
 
+lemma tcb_ptr_to_ctcb_ptr_inj:
+  "tcb_ptr_to_ctcb_ptr x = tcb_ptr_to_ctcb_ptr y \<Longrightarrow> x = y"
+  by (auto simp: tcb_ptr_to_ctcb_ptr_def ctcb_offset_def)
+
+lemma
+  assumes "pspace_aligned' as" "pspace_distinct' as" "valid_tcb' atcb as"
+  shows tcb_at'_tcbBoundNotification:
+    "bound (tcbBoundNotification atcb) \<longrightarrow> ntfn_at' (the (tcbBoundNotification atcb)) as"
+  and tcb_at'_tcbSchedPrev:
+    "tcbSchedPrev atcb \<noteq> None \<longrightarrow> tcb_at' (the (tcbSchedPrev atcb)) as"
+  and tcb_at'_tcbSchedNext:
+    "tcbSchedNext atcb \<noteq> None \<longrightarrow> tcb_at' (the (tcbSchedNext atcb)) as"
+  using assms
+  by (clarsimp simp: valid_tcb'_def obj_at'_def)+
+
 lemma cpspace_tcb_relation_unique:
-  assumes tcbs: "cpspace_tcb_relation ah ch" "cpspace_tcb_relation ah' ch"
-      and   vs: "\<exists>s. ksPSpace s = ah \<and> no_0_obj' s \<and> valid_objs' s"
-      and   vs': "\<exists>s. ksPSpace s = ah' \<and> no_0_obj' s \<and> valid_objs' s"
-  assumes ctes: " \<forall>tcb tcb'. (\<exists>p. map_to_tcbs ah p = Some tcb \<and>
-                                  map_to_tcbs ah' p = Some tcb') \<longrightarrow>
-                  (\<forall>x\<in>ran tcb_cte_cases. fst x tcb' = fst x tcb)"
-  shows "map_to_tcbs ah' = map_to_tcbs ah"
+  assumes tcbs: "cpspace_tcb_relation (ksPSpace as) ch" "cpspace_tcb_relation (ksPSpace as') ch"
+  assumes   vs: "no_0_obj' as" "valid_objs' as"
+  assumes  vs': "no_0_obj' as'" "valid_objs' as'"
+  assumes   ad: "pspace_aligned' as" "pspace_distinct' as"
+  assumes  ad': "pspace_aligned' as'" "pspace_distinct' as'"
+  assumes ctes: "\<forall>tcb tcb'. (\<exists>p. map_to_tcbs (ksPSpace as) p = Some tcb \<and>
+                                 map_to_tcbs (ksPSpace as') p = Some tcb') \<longrightarrow>
+                 (\<forall>x\<in>ran tcb_cte_cases. fst x tcb' = fst x tcb)"
+  shows "map_to_tcbs (ksPSpace as') = map_to_tcbs (ksPSpace as)"
   using tcbs(2) tcbs(1)
   apply (clarsimp simp add: cmap_relation_def)
   apply (drule inj_image_inv[OF inj_tcb_ptr_to_ctcb_ptr])+
   apply (simp add: tcb_ptr_to_ctcb_ptr_def[abs_def] ctcb_offset_def)
   apply (rule ext)
-  apply (case_tac "x:dom (map_to_tcbs ah)")
+  apply (case_tac "x \<in> dom (map_to_tcbs (ksPSpace as))")
    apply (drule bspec, assumption)+
    apply (simp add: dom_def Collect_eq, drule_tac x=x in spec)
    apply clarsimp
    apply (rename_tac p x y)
    apply (cut_tac ctes)
    apply (drule_tac x=x in spec, drule_tac x=y in spec, erule impE, fastforce)
-   apply (frule ksPSpace_valid_objs_tcbBoundNotification_nonzero[OF vs])
-   apply (frule ksPSpace_valid_objs_tcbBoundNotification_nonzero[OF vs'])
+   apply (frule map_to_tcbs_Some_refs_nonzero[OF _ vs])
+   apply (frule map_to_tcbs_Some_refs_nonzero[OF _ vs'])
+   apply (rename_tac atcb atcb')
+   apply (prop_tac "valid_tcb' atcb as")
+    apply (fastforce intro: vs ad map_to_ko_atI tcb_ko_at_valid_objs_valid_tcb')
+   apply (prop_tac "valid_tcb' atcb' as'")
+    apply (fastforce intro: vs' ad' map_to_ko_atI tcb_ko_at_valid_objs_valid_tcb')
+   apply (frule tcb_at'_tcbSchedPrev[OF ad])
+   apply (frule tcb_at'_tcbSchedPrev[OF ad'])
+   apply (frule tcb_at'_tcbSchedNext[OF ad])
+   apply (frule tcb_at'_tcbSchedNext[OF ad'])
    apply (thin_tac "map_to_tcbs x y = Some z" for x y z)+
-   apply (case_tac x, case_tac y, case_tac "the (clift ch (tcb_Ptr (p+0x200)))")
+   apply (case_tac "the (clift ch (tcb_Ptr (p + 2 ^ ctcb_size_bits)))")
    apply (clarsimp simp: ctcb_relation_def ran_tcb_cte_cases)
-   apply (clarsimp simp: option_to_ptr_def option_to_0_def split: option.splits)
-   apply (auto simp: cfault_rel_imp_eq cthread_state_rel_imp_eq carch_tcb_relation_def
-                     ccontext_relation_imp_eq2 up_ucast_inj_eq ctcb_size_bits_def)
+   apply (clarsimp simp: option_to_ctcb_ptr_def option_to_ptr_def option_to_0_def)
+   apply (rule tcb.expand)
+   apply clarsimp
+   apply (intro conjI)
+        apply (simp add: cthread_state_rel_imp_eq)
+       apply (simp add: cfault_rel_imp_eq)
+      apply (case_tac "tcbBoundNotification atcb'", case_tac "tcbBoundNotification atcb"; clarsimp)
+      apply (clarsimp split: option.splits)
+     apply (case_tac "tcbSchedPrev atcb'"; case_tac "tcbSchedPrev atcb"; clarsimp)
+       apply (force dest!: kernel.tcb_at_not_NULL)
+      apply (force dest!: kernel.tcb_at_not_NULL)
+     apply (force simp: tcb_ptr_to_ctcb_ptr_inj)
+    apply (case_tac "tcbSchedNext atcb'"; case_tac "tcbSchedNext atcb"; clarsimp)
+      apply (force dest!: kernel.tcb_at_not_NULL)
+     apply (force dest!: kernel.tcb_at_not_NULL)
+    apply (force simp: tcb_ptr_to_ctcb_ptr_inj)
+   apply (force simp: carch_tcb_relation_def ccontext_relation_imp_eq2)
+  apply auto
   done
 
 lemma tcb_queue_rel_clift_unique:
@@ -827,10 +895,6 @@ lemma ksPSpace_valid_pspace_ntfnBoundTCB_nonzero:
   apply (clarsimp simp: projectKOs valid_obj'_def valid_ntfn'_def)
   done
 
-lemma tcb_ptr_to_ctcb_ptr_inj:
-  "tcb_ptr_to_ctcb_ptr x = tcb_ptr_to_ctcb_ptr y \<Longrightarrow> x = y"
-  by (auto simp: tcb_ptr_to_ctcb_ptr_def ctcb_offset_def)
-
 lemma cpspace_ntfn_relation_unique:
   assumes ntfns: "cpspace_ntfn_relation ah ch" "cpspace_ntfn_relation ah' ch"
       and   vs: "\<exists>s. ksPSpace s = ah \<and> valid_pspace' s"
@@ -1078,8 +1142,8 @@ proof -
     apply (drule (1) cpspace_pte_relation_unique)
     apply (drule (1) cpspace_asidpool_relation_unique)
     apply (drule (1) cpspace_tcb_relation_unique)
-       apply (fastforce intro: no_0_objs no_0_objs' valid_objs valid_objs')
-      apply (fastforce intro: no_0_objs no_0_objs' valid_objs valid_objs')
+       apply (fastforce intro: no_0_objs no_0_objs' valid_objs valid_objs')+
+      apply (fastforce intro: aligned distinct aligned' distinct')+
      apply (intro allI impI,elim exE conjE)
      apply (rule_tac p=p in map_to_ctes_tcb_ctes, assumption)
       apply (frule (1) map_to_ko_atI[OF _ aligned distinct])
@@ -1132,7 +1196,7 @@ lemma ksPSpace_eq_imp_valid_tcb'_eq:
   by (auto simp: ksPSpace_eq_imp_obj_at'_eq[OF ksPSpace]
                  ksPSpace_eq_imp_valid_cap'_eq[OF ksPSpace]
                  ksPSpace_eq_imp_typ_at'_eq[OF ksPSpace]
-                 valid_tcb'_def valid_tcb_state'_def valid_bound_ntfn'_def
+                 valid_tcb'_def valid_tcb_state'_def valid_bound_ntfn'_def valid_bound_tcb'_def
           split: thread_state.splits option.splits)
 
 lemma ksPSpace_eq_imp_valid_objs'_eq:
@@ -1287,7 +1351,7 @@ where
     ksDomSchedule = cDomSchedule_to_H kernel_all_global_addresses.ksDomSchedule,
     ksCurDomain = ucast (ksCurDomain_' s),
     ksDomainTime = ksDomainTime_' s,
-    ksReadyQueues = cready_queues_to_H (clift (t_hrs_' s)) (ksReadyQueues_' s),
+    ksReadyQueues = cready_queues_to_H (ksReadyQueues_' s),
     ksReadyQueuesL1Bitmap = cbitmap_L1_to_H (ksReadyQueuesL1Bitmap_' s),
     ksReadyQueuesL2Bitmap = cbitmap_L2_to_H (ksReadyQueuesL2Bitmap_' s),
     ksCurThread = ctcb_ptr_to_tcb_ptr (ksCurThread_' s),
@@ -1309,16 +1373,16 @@ lemma trivial_eq_conj: "B = C \<Longrightarrow> (A \<and> B) = (A \<and> C)"
 lemma cstate_to_H_correct:
   assumes valid: "valid_state' as"
   assumes cstate_rel: "cstate_relation as cs"
+  assumes rdyqs: "ksReadyQueues_asrt as"
   shows "cstate_to_H cs = as \<lparr>ksMachineState:=  observable_memory (ksMachineState as) (user_mem' as)\<rparr>"
   apply (subgoal_tac "cstate_to_machine_H cs = observable_memory (ksMachineState as) (user_mem' as)")
    apply (rule kernel_state.equality, simp_all add: cstate_to_H_def)
-                      apply (rule cstate_to_pspace_H_correct)
+                    apply (rule cstate_to_pspace_H_correct)
                      using valid
                      apply (simp add: valid_state'_def)
                     using cstate_rel valid
                     apply (clarsimp simp: cstate_relation_def cpspace_relation_def Let_def
-                      observable_memory_def valid_state'_def
-                      valid_pspace'_def)
+                                          observable_memory_def valid_state'_def valid_pspace'_def)
                    using cstate_rel
                    apply (clarsimp simp: cstate_relation_def cpspace_relation_def Let_def prod_eq_iff)
                   using cstate_rel
@@ -1326,10 +1390,10 @@ lemma cstate_to_H_correct:
                  using valid cstate_rel
                  apply (rule mk_gsUntypedZeroRanges_correct)
                 subgoal
-                using cstate_rel
-                by (fastforce simp: cstate_relation_def cpspace_relation_def
-                                    Let_def ghost_size_rel_def unat_eq_0
-                            split: if_split)
+                  using cstate_rel
+                  by (fastforce simp: cstate_relation_def cpspace_relation_def
+                                      Let_def ghost_size_rel_def unat_eq_0
+                              split: if_split)
                using valid cstate_rel
                apply (rule cDomScheduleIdx_to_H_correct)
                using cstate_rel
@@ -1343,8 +1407,13 @@ lemma cstate_to_H_correct:
             using cstate_rel
             apply (clarsimp simp: cstate_relation_def Let_def)
            apply (rule cready_queues_to_H_correct)
-           using cstate_rel
-           apply (clarsimp simp: cstate_relation_def Let_def)
+               using cstate_rel rdyqs
+               apply (fastforce intro!: cready_queues_to_H_correct
+                                  simp: cstate_relation_def Let_def)
+              using valid apply (fastforce simp: valid_state'_def)
+             using rdyqs apply fastforce
+            using valid apply (fastforce simp: valid_state'_def)
+           using valid apply (fastforce simp: valid_state'_def)
           using cstate_rel
           apply (clarsimp simp: cstate_relation_def Let_def)
           using cstate_rel
diff --git a/proof/crefine/RISCV64/ArchMove_C.thy b/proof/crefine/RISCV64/ArchMove_C.thy
index a73eae0e85..ddbf18b54d 100644
--- a/proof/crefine/RISCV64/ArchMove_C.thy
+++ b/proof/crefine/RISCV64/ArchMove_C.thy
@@ -297,14 +297,8 @@ lemma obj_at_kernel_mappings':
    \<Longrightarrow> p \<in> kernel_mappings"
   by (clarsimp simp: pspace_in_kernel_mappings'_def obj_at'_def dom_def)
 
-crunches Arch.switchToThread
-  for valid_queues'[wp]: valid_queues'
-  (simp: crunch_simps wp: hoare_drop_imps)
 crunches switchToIdleThread
   for ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
-crunches switchToIdleThread, switchToThread
-  for valid_pspace'[wp]: valid_pspace'
-  (simp: whenE_def crunch_simps wp: hoare_drop_imps)
 
 lemma getMessageInfo_less_4:
   "\<lbrace>\<top>\<rbrace> getMessageInfo t \<lbrace>\<lambda>rv s. msgExtraCaps rv < 4\<rbrace>"
diff --git a/proof/crefine/RISCV64/Arch_C.thy b/proof/crefine/RISCV64/Arch_C.thy
index 49083a7bd3..5750c9fbca 100644
--- a/proof/crefine/RISCV64/Arch_C.thy
+++ b/proof/crefine/RISCV64/Arch_C.thy
@@ -1391,7 +1391,7 @@ lemma performPageGetAddress_ccorres:
    apply clarsimp
    apply (rule conseqPre, vcg)
    apply clarsimp
-  apply (clarsimp simp: invs_no_0_obj' tcb_at_invs' invs_queues invs_valid_objs' invs_sch_act_wf'
+  apply (clarsimp simp: invs_no_0_obj' tcb_at_invs' invs_valid_objs' invs_sch_act_wf'
                         rf_sr_ksCurThread msgRegisters_unfold
                         seL4_MessageInfo_lift_def message_info_to_H_def mask_def)
   apply (cases isCall)
@@ -2833,13 +2833,14 @@ lemma decodeRISCVMMUInvocation_ccorres:
     apply (rule conjI; clarsimp)
     apply (frule invs_arch_state')
     apply (rule conjI, clarsimp simp: valid_arch_state'_def valid_asid_table'_def)
-    apply (clarsimp simp: neq_Nil_conv excaps_map_def valid_tcb_state'_def invs_queues
-                          invs_sch_act_wf'
+    apply (clarsimp simp: neq_Nil_conv excaps_map_def valid_tcb_state'_def invs_sch_act_wf'
                           unat_lt2p[where 'a=machine_word_len, folded word_bits_def])
     apply (frule interpret_excaps_eq[rule_format, where n=1], simp)
     apply (rule conjI; clarsimp)+
     apply (rule conjI, erule ctes_of_valid', clarsimp)
     apply (intro conjI)
+            apply fastforce
+           apply fastforce
           apply fastforce
          apply (fastforce elim!: pred_tcb'_weakenE)
         apply (clarsimp simp: st_tcb_at'_def obj_at'_def)
@@ -2856,9 +2857,11 @@ lemma decodeRISCVMMUInvocation_ccorres:
      apply (clarsimp simp: le_mask_asid_bits_helper)
     apply (simp add: is_aligned_shiftl_self)
    (* RISCVASIDPoolAssign *)
-   apply (clarsimp simp: isCap_simps valid_tcb_state'_def invs_queues invs_sch_act_wf')
+   apply (clarsimp simp: isCap_simps valid_tcb_state'_def invs_sch_act_wf')
    apply (frule invs_arch_state', clarsimp)
    apply (intro conjI)
+          apply fastforce
+         apply fastforce
         apply fastforce
        apply (fastforce simp: ct_in_state'_def elim!: pred_tcb'_weakenE)
       apply (fastforce simp: ct_in_state'_def elim!: pred_tcb'_weakenE)
diff --git a/proof/crefine/RISCV64/Detype_C.thy b/proof/crefine/RISCV64/Detype_C.thy
index d53327927c..7e2c7a19ee 100644
--- a/proof/crefine/RISCV64/Detype_C.thy
+++ b/proof/crefine/RISCV64/Detype_C.thy
@@ -1680,35 +1680,11 @@ proof -
     done
 
   moreover
-  from invs have "valid_queues s" ..
-  hence "\<And>p. \<forall>t \<in> set (ksReadyQueues s p). tcb_at' t s \<and> ko_wp_at' live' t s"
-    apply (clarsimp simp: valid_queues_def valid_queues_no_bitmap_def)
-    apply (drule spec, drule spec)
-    apply clarsimp
-    apply (drule (1) bspec)
-    apply (rule conjI)
-    apply (erule obj_at'_weakenE)
-    apply simp
-    apply (simp add: obj_at'_real_def)
-    apply (erule ko_wp_at'_weakenE)
-    apply (clarsimp simp: inQ_def)
-    done
-  hence tat: "\<And>p. \<forall>t \<in> set (ksReadyQueues s p). tcb_at' t s"
-    and  tlive: "\<And>p. \<forall>t \<in> set (ksReadyQueues s p). ko_wp_at' live' t s"
-    by auto
   from sr have
-    "cready_queues_relation (clift ?th_s)
-        (ksReadyQueues_' (globals s')) (ksReadyQueues s)"
+    "cready_queues_relation (ksReadyQueues s) (ksReadyQueues_' (globals s'))"
     unfolding cready_queues_relation_def rf_sr_def cstate_relation_def
               cpspace_relation_def
     apply (clarsimp simp: Let_def all_conj_distrib)
-    apply (drule spec, drule spec, drule mp)
-    apply fastforce
-    apply ((subst lift_t_typ_region_bytes, rule cm_disj_tcb, assumption+,
-           simp_all add: objBits_simps pageBits_def)[1])+
-      \<comment> \<open>waiting ...\<close>
-    apply (simp add: tcb_queue_relation_live_restrict
-                     [OF D.valid_untyped tat tlive rl])
     done
 
   moreover
diff --git a/proof/crefine/RISCV64/Finalise_C.thy b/proof/crefine/RISCV64/Finalise_C.thy
index 6a51ca38f4..7eacd462ab 100644
--- a/proof/crefine/RISCV64/Finalise_C.thy
+++ b/proof/crefine/RISCV64/Finalise_C.thy
@@ -35,6 +35,108 @@ declare if_split [split del]
 definition
   "option_map2 f m = option_map f \<circ> m"
 
+definition ksReadyQueues_head_end_2 :: "(domain \<times> priority \<Rightarrow> ready_queue) \<Rightarrow> bool" where
+  "ksReadyQueues_head_end_2 qs \<equiv>
+     \<forall>d p. tcbQueueHead (qs (d, p)) \<noteq> None \<longleftrightarrow> tcbQueueEnd (qs (d, p)) \<noteq> None"
+
+abbreviation "ksReadyQueues_head_end s \<equiv> ksReadyQueues_head_end_2 (ksReadyQueues s)"
+
+lemmas ksReadyQueues_head_end_def = ksReadyQueues_head_end_2_def
+
+lemma ksReadyQueues_asrt_ksReadyQueues_head_end:
+  "ksReadyQueues_asrt s \<Longrightarrow> ksReadyQueues_head_end s"
+  by (fastforce dest: tcbQueueHead_iff_tcbQueueEnd
+                simp: ready_queue_relation_def ksReadyQueues_asrt_def ksReadyQueues_head_end_def)
+
+lemma tcbSchedEnqueue_ksReadyQueues_head_end[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>ksReadyQueues_head_end\<rbrace>"
+  unfolding tcbSchedEnqueue_def tcbQueuePrepend_def setQueue_def
+  apply (wpsimp wp: threadSet_wp threadGet_wp simp: bitmap_fun_defs)
+  apply (clarsimp simp: tcbQueueEmpty_def obj_at'_def ksReadyQueues_head_end_def split: if_splits)
+  done
+
+lemma ksReadyQueues_head_end_ksSchedulerAction_update[simp]:
+  "ksReadyQueues_head_end (s\<lparr>ksSchedulerAction := ChooseNewThread\<rparr>) = ksReadyQueues_head_end s"
+  by (simp add: ksReadyQueues_head_end_def)
+
+crunches rescheduleRequired
+  for ksReadyQueues_head_end[wp]: ksReadyQueues_head_end
+
+lemma setThreadState_ksReadyQueues_head_end[wp]:
+  "setThreadState ts tcbPtr \<lbrace>ksReadyQueues_head_end\<rbrace>"
+  unfolding setThreadState_def
+  by (wpsimp wp: threadSet_wp threadGet_wp simp: bitmap_fun_defs)
+
+definition ksReadyQueues_head_end_tcb_at'_2 ::
+  "(domain \<times> priority \<Rightarrow> ready_queue) \<Rightarrow> (obj_ref \<rightharpoonup> tcb) \<Rightarrow> bool" where
+  "ksReadyQueues_head_end_tcb_at'_2 qs tcbs \<equiv>
+     \<forall>d p. (\<forall>head. tcbQueueHead (qs (d, p)) = Some head \<longrightarrow> tcbs head \<noteq> None)
+           \<and> (\<forall>end. tcbQueueEnd (qs (d, p)) = Some end \<longrightarrow> tcbs end \<noteq> None)"
+
+abbreviation "ksReadyQueues_head_end_tcb_at' s \<equiv>
+  ksReadyQueues_head_end_tcb_at'_2 (ksReadyQueues s) (tcbs_of' s)"
+
+lemmas ksReadyQueues_head_end_tcb_at'_def = ksReadyQueues_head_end_tcb_at'_2_def
+
+lemma ksReadyQueues_asrt_ksReadyQueues_head_end_tcb_at':
+  "\<lbrakk>ksReadyQueues_asrt s; pspace_aligned' s; pspace_distinct' s\<rbrakk>
+   \<Longrightarrow> ksReadyQueues_head_end_tcb_at' s"
+  apply (clarsimp simp: ready_queue_relation_def ksReadyQueues_asrt_def
+                        ksReadyQueues_head_end_tcb_at'_def)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply (clarsimp simp: list_queue_relation_def)
+  apply (intro conjI impI allI)
+   apply (case_tac "ts = []", clarsimp)
+   apply (fastforce dest!: heap_path_head hd_in_set
+                     simp: opt_pred_def  tcbQueueEmpty_def split: option.splits)
+  apply (fastforce simp: queue_end_valid_def opt_pred_def tcbQueueEmpty_def
+                  split: option.splits)
+  done
+
+lemma tcbSchedEnqueue_ksReadyQueues_head_end_tcb_at'[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>ksReadyQueues_head_end_tcb_at'\<rbrace>"
+  unfolding tcbSchedEnqueue_def tcbQueuePrepend_def setQueue_def
+  apply (wpsimp wp: threadSet_wp threadGet_wp simp: bitmap_fun_defs)
+  apply (clarsimp simp: ksReadyQueues_head_end_tcb_at'_def split: if_splits)
+  done
+
+lemma ksReadyQueues_head_end_tcb_at'_ksSchedulerAction_update[simp]:
+  "ksReadyQueues_head_end_tcb_at' (s\<lparr>ksSchedulerAction := ChooseNewThread\<rparr>)
+   = ksReadyQueues_head_end_tcb_at' s"
+  by (simp add: ksReadyQueues_head_end_tcb_at'_def)
+
+crunches rescheduleRequired
+  for ksReadyQueues_head_end_tcb_at'[wp]: ksReadyQueues_head_end_tcb_at'
+
+lemma setThreadState_ksReadyQueues_head_end_tcb_at'[wp]:
+  "setThreadState ts tcbPtr \<lbrace>ksReadyQueues_head_end_tcb_at'\<rbrace>"
+  unfolding setThreadState_def
+  apply (wpsimp wp: threadSet_wp)
+  apply (fastforce simp: ksReadyQueues_head_end_tcb_at'_def split: if_splits)
+  done
+
+lemma head_end_ksReadyQueues_':
+  "\<lbrakk> (s, s') \<in> rf_sr; ksReadyQueues_head_end s; ksReadyQueues_head_end_tcb_at' s;
+     pspace_aligned' s; pspace_distinct' s;
+     d \<le> maxDomain; p \<le> maxPriority \<rbrakk>
+   \<Longrightarrow> head_C (index (ksReadyQueues_' (globals s')) (cready_queues_index_to_C d p)) = NULL
+       \<longleftrightarrow> end_C (index (ksReadyQueues_' (globals s')) (cready_queues_index_to_C d p)) = NULL"
+  apply (frule (2) rf_sr_ctcb_queue_relation[where d=d and p=p])
+  apply (clarsimp simp: ksReadyQueues_head_end_def)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply (clarsimp simp: ksReadyQueues_head_end_tcb_at'_def)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply (clarsimp simp: ctcb_queue_relation_def option_to_ctcb_ptr_def split: option.splits)
+  apply (rename_tac "end" head end_tcb head_tcb)
+  apply (prop_tac "tcb_at' head s \<and> tcb_at' end s")
+   apply (fastforce intro!: aligned'_distinct'_ko_wp_at'I
+                      simp: obj_at'_real_def opt_map_def split: option.splits)
+  apply (fastforce dest: tcb_at_not_NULL)
+  done
+
 lemma tcbSchedEnqueue_cslift_spec:
   "\<forall>s. \<Gamma>\<turnstile>\<^bsub>/UNIV\<^esub> \<lbrace>s. \<exists>d v. option_map2 tcbPriority_C (cslift s) \<acute>tcb = Some v
                        \<and> unat v \<le> numPriorities
@@ -46,7 +148,9 @@ lemma tcbSchedEnqueue_cslift_spec:
                                            \<noteq> None
                              \<and> option_map2 tcbDomain_C (cslift s)
                                    (head_C (index \<acute>ksReadyQueues (unat (d*0x100 + v))))
-                                           \<noteq> None)\<rbrace>
+                                           \<noteq> None)
+                       \<and> (head_C (index \<acute>ksReadyQueues (unat (d * 0x100 + v))) \<noteq> NULL
+                          \<longleftrightarrow> end_C (index \<acute>ksReadyQueues (unat (d * 0x100 + v))) \<noteq> NULL)\<rbrace>
        Call tcbSchedEnqueue_'proc
       {s'. option_map2 tcbEPNext_C (cslift s') = option_map2 tcbEPNext_C (cslift s)
            \<and> option_map2 tcbEPPrev_C (cslift s') = option_map2 tcbEPPrev_C (cslift s)
@@ -63,8 +167,8 @@ lemma tcbSchedEnqueue_cslift_spec:
   apply (rule conjI)
    apply (clarsimp simp: typ_heap_simps cong: if_cong)
    apply (simp split: if_split)
-  apply (clarsimp simp: typ_heap_simps if_Some_helper cong: if_cong)
-  by (simp split: if_split)
+  by (auto simp: typ_heap_simps' if_Some_helper numPriorities_def
+           cong: if_cong split: if_splits)
 
 lemma setThreadState_cslift_spec:
   "\<forall>s. \<Gamma>\<turnstile>\<^bsub>/UNIV\<^esub> \<lbrace>s. s \<Turnstile>\<^sub>c \<acute>tptr \<and> (\<forall>x. ksSchedulerAction_' (globals s) = tcb_Ptr x
@@ -160,8 +264,9 @@ lemma ctcb_relation_tcbPriority_maxPriority_numPriorities:
   done
 
 lemma tcbSchedEnqueue_cslift_precond_discharge:
-  "\<lbrakk> (s, s') \<in> rf_sr; obj_at' (P :: tcb \<Rightarrow> bool) x s;
-        valid_queues s; valid_objs' s \<rbrakk> \<Longrightarrow>
+  "\<lbrakk> (s, s') \<in> rf_sr; obj_at' (P :: tcb \<Rightarrow> bool) x s; valid_objs' s ;
+     ksReadyQueues_head_end s; ksReadyQueues_head_end_tcb_at' s;
+     pspace_aligned' s; pspace_distinct' s\<rbrakk> \<Longrightarrow>
    (\<exists>d v. option_map2 tcbPriority_C (cslift s') (tcb_ptr_to_ctcb_ptr x) = Some v
         \<and> unat v < numPriorities
         \<and> option_map2 tcbDomain_C (cslift s') (tcb_ptr_to_ctcb_ptr x) = Some d
@@ -172,31 +277,49 @@ lemma tcbSchedEnqueue_cslift_precond_discharge:
                                     \<noteq> None
                   \<and> option_map2 tcbDomain_C (cslift s')
                      (head_C (index (ksReadyQueues_' (globals s')) (unat (d*0x100 + v))))
-                                    \<noteq> None))"
+                                    \<noteq> None)
+        \<and> (head_C (index (ksReadyQueues_' (globals s')) (unat (d * 0x100 + v))) \<noteq> NULL
+           \<longleftrightarrow> end_C (index (ksReadyQueues_' (globals s')) (unat (d * 0x100 + v))) \<noteq> NULL))"
   apply (drule(1) obj_at_cslift_tcb)
   apply (clarsimp simp: typ_heap_simps' option_map2_def)
+  apply (rename_tac tcb tcb')
   apply (frule_tac t=x in valid_objs'_maxPriority, fastforce simp: obj_at'_def)
   apply (frule_tac t=x in valid_objs'_maxDomain, fastforce simp: obj_at'_def)
   apply (drule_tac P="\<lambda>tcb. tcbPriority tcb \<le> maxPriority" in obj_at_ko_at2', simp)
   apply (drule_tac P="\<lambda>tcb. tcbDomain tcb \<le> maxDomain" in obj_at_ko_at2', simp)
   apply (simp add: ctcb_relation_tcbDomain_maxDomain_numDomains
                    ctcb_relation_tcbPriority_maxPriority_numPriorities)
-  apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko"
-              in rf_sr_sched_queue_relation)
+  apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb" in rf_sr_ctcb_queue_relation)
     apply (simp add: maxDom_to_H maxPrio_to_H)+
+  apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb" in head_end_ksReadyQueues_', fastforce+)
   apply (simp add: cready_queues_index_to_C_def2 numPriorities_def le_maxDomain_eq_less_numDomains)
   apply (clarsimp simp: ctcb_relation_def)
   apply (frule arg_cong[where f=unat], subst(asm) unat_ucast_up_simp, simp)
-  apply (frule tcb_queue'_head_end_NULL)
-   apply (erule conjunct1[OF valid_queues_valid_q])
-  apply (frule(1) tcb_queue_relation_qhead_valid')
-   apply (simp add: valid_queues_valid_q)
-  apply (clarsimp simp: h_t_valid_clift_Some_iff)
+  apply (frule (3) head_end_ksReadyQueues_', fastforce+)
+  apply (clarsimp simp: ksReadyQueues_head_end_def)
+  apply (drule_tac x="tcbDomain tcb" in spec)
+  apply (drule_tac x="tcbPriority tcb" in spec)
+  apply (prop_tac "\<not> tcbQueueEmpty ((ksReadyQueues s (tcbDomain tcb, tcbPriority tcb)))")
+   apply (clarsimp simp: tcbQueueEmpty_def ctcb_queue_relation_def option_to_ctcb_ptr_def
+                  split: option.splits)
+  apply (clarsimp simp: ksReadyQueues_head_end_tcb_at'_def)
+  apply (drule_tac x="tcbDomain tcb" in spec)
+  apply (drule_tac x="tcbPriority tcb" in spec)
+  apply clarsimp
+  apply (clarsimp simp: tcbQueueEmpty_def)
+  apply (rename_tac head "end" head_tcb end_tcb)
+  apply (prop_tac "tcb_at' head s")
+   apply (fastforce intro: aligned'_distinct'_ko_wp_at'I
+                     simp: obj_at'_real_def opt_map_def split: option.splits)
+  apply (frule_tac thread=head in obj_at_cslift_tcb)
+   apply fastforce
+  apply (clarsimp dest: obj_at_cslift_tcb simp: ctcb_queue_relation_def option_to_ctcb_ptr_def)
   done
 
 lemma cancel_all_ccorres_helper:
   "ccorres dc xfdc
-      (\<lambda>s. valid_objs' s \<and> valid_queues s
+      (\<lambda>s. valid_objs' s \<and> pspace_aligned' s \<and> pspace_distinct' s
+             \<and> ksReadyQueues_head_end s \<and> ksReadyQueues_head_end_tcb_at' s
              \<and> (\<forall>t\<in>set ts. tcb_at' t s \<and> t \<noteq> 0)
              \<and> sch_act_wf (ksSchedulerAction s) s)
       {s'. \<exists>p. ep_queue_relation (cslift s') ts
@@ -251,11 +374,11 @@ next
            apply (erule cmap_relationE1 [OF cmap_relation_tcb])
             apply (erule ko_at_projectKO_opt)
            apply (fastforce intro: typ_heap_simps)
-          apply (wp sts_running_valid_queues | simp)+
+          apply (wp sts_valid_objs' | simp)+
         apply (rule ceqv_refl)
        apply (rule "Cons.hyps")
       apply (wp sts_valid_objs' sts_sch_act sch_act_wf_lift hoare_vcg_const_Ball_lift
-                sts_running_valid_queues sts_st_tcb' setThreadState_oa_queued | simp)+
+                sts_st_tcb' | simp)+
 
      apply (vcg exspec=setThreadState_cslift_spec exspec=tcbSchedEnqueue_cslift_spec)
     apply (clarsimp simp: tcb_at_not_NULL Collect_const_mem valid_tcb_state'_def
@@ -269,16 +392,13 @@ next
                            st_tcb_at'_def
                     split: scheduler_action.split_asm)
      apply (rename_tac word)
-     apply (frule_tac x=word in tcbSchedEnqueue_cslift_precond_discharge)
-        apply simp
-       apply clarsimp
-      apply clarsimp
-     apply clarsimp
+     apply (frule_tac x=word in tcbSchedEnqueue_cslift_precond_discharge; clarsimp?)
+     apply simp
     apply clarsimp
     apply (rule conjI)
      apply (frule(3) tcbSchedEnqueue_cslift_precond_discharge)
      apply clarsimp
-    apply clarsimp
+    apply clarsimp+
     apply (subst ep_queue_relation_shift, fastforce)
     apply (drule_tac x="tcb_ptr_to_ctcb_ptr thread"
                 in fun_cong)+
@@ -287,11 +407,17 @@ next
     done
 qed
 
+crunches setEndpoint, setNotification
+  for ksReadyQueues_head_end[wp]: ksReadyQueues_head_end
+  and ksReadyQueues_head_end_tcb_at'[wp]: ksReadyQueues_head_end_tcb_at'
+  (simp: updateObject_default_def)
+
 lemma cancelAllIPC_ccorres:
   "ccorres dc xfdc
-   (invs') (UNIV \<inter> {s. epptr_' s = Ptr epptr}) []
+   invs' (UNIV \<inter> {s. epptr_' s = Ptr epptr}) []
    (cancelAllIPC epptr) (Call cancelAllIPC_'proc)"
   apply (cinit lift: epptr_')
+   apply (rule ccorres_stateAssert)
    apply (rule ccorres_symb_exec_l [OF _ getEndpoint_inv _ empty_fail_getEndpoint])
     apply (rule_tac xf'=ret__unsigned_longlong_'
                 and val="case ep of IdleEP \<Rightarrow> scast EPState_Idle
@@ -306,7 +432,7 @@ lemma cancelAllIPC_ccorres:
        apply (simp add: cendpoint_relation_def Let_def
                  split: endpoint.split_asm)
       apply ceqv
-     apply (rule_tac A="invs' and ko_at' ep epptr"
+     apply (rule_tac A="invs' and ksReadyQueues_asrt and ko_at' ep epptr"
               in ccorres_guard_imp2[where A'=UNIV])
       apply wpc
         apply (rename_tac list)
@@ -347,12 +473,11 @@ lemma cancelAllIPC_ccorres:
              apply ceqv
             apply (ctac add: rescheduleRequired_ccorres)
            apply (wp weak_sch_act_wf_lift_linear
-                     cancelAllIPC_mapM_x_valid_queues
                   | simp)+
               apply (rule mapM_x_wp', wp)+
              apply (wp sts_st_tcb')
              apply (clarsimp split: if_split)
-            apply (rule mapM_x_wp', wp)+
+            apply (rule mapM_x_wp', wp sts_valid_objs')+
            apply (clarsimp simp: valid_tcb_state'_def)
           apply (simp add: guard_is_UNIV_def)
          apply (wp set_ep_valid_objs' hoare_vcg_const_Ball_lift
@@ -395,18 +520,21 @@ lemma cancelAllIPC_ccorres:
             apply (rule cancel_all_ccorres_helper)
            apply ceqv
           apply (ctac add: rescheduleRequired_ccorres)
-         apply (wp cancelAllIPC_mapM_x_valid_queues)
-         apply (wp mapM_x_wp' weak_sch_act_wf_lift_linear
+         apply (wp mapM_x_wp' weak_sch_act_wf_lift_linear sts_valid_objs'
                    sts_st_tcb' | clarsimp simp: valid_tcb_state'_def split: if_split)+
         apply (simp add: guard_is_UNIV_def)
        apply (wp set_ep_valid_objs' hoare_vcg_const_Ball_lift
                  weak_sch_act_wf_lift_linear)
       apply vcg
-     apply (clarsimp simp: valid_ep'_def invs_valid_objs' invs_queues)
+     apply (clarsimp simp: valid_ep'_def invs_valid_objs')
      apply (rule cmap_relationE1[OF cmap_relation_ep], assumption)
       apply (erule ko_at_projectKO_opt)
      apply (frule obj_at_valid_objs', clarsimp+)
      apply (clarsimp simp: valid_obj'_def valid_ep'_def)
+     apply (frule invs_pspace_aligned')
+     apply (frule invs_pspace_distinct')
+     apply (frule ksReadyQueues_asrt_ksReadyQueues_head_end)
+     apply (frule (2) ksReadyQueues_asrt_ksReadyQueues_head_end_tcb_at')
      subgoal by (auto simp: typ_heap_simps cendpoint_relation_def
                        Let_def tcb_queue_relation'_def
                        invs_valid_objs' valid_objs'_maxDomain valid_objs'_maxPriority
@@ -418,9 +546,10 @@ lemma cancelAllIPC_ccorres:
 
 lemma cancelAllSignals_ccorres:
   "ccorres dc xfdc
-   (invs') (UNIV \<inter> {s. ntfnPtr_' s = Ptr ntfnptr}) []
+   invs' (UNIV \<inter> {s. ntfnPtr_' s = Ptr ntfnptr}) []
    (cancelAllSignals ntfnptr) (Call cancelAllSignals_'proc)"
   apply (cinit lift: ntfnPtr_')
+   apply (rule ccorres_stateAssert)
    apply (rule ccorres_symb_exec_l [OF _ get_ntfn_inv' _ empty_fail_getNotification])
     apply (rule_tac xf'=ret__unsigned_longlong_'
                 and val="case ntfnObj ntfn of IdleNtfn \<Rightarrow> scast NtfnState_Idle
@@ -435,7 +564,7 @@ lemma cancelAllSignals_ccorres:
        apply (simp add: cnotification_relation_def Let_def
                  split: ntfn.split_asm)
       apply ceqv
-     apply (rule_tac A="invs' and ko_at' ntfn ntfnptr"
+     apply (rule_tac A="invs' and ksReadyQueues_asrt and ko_at' ntfn ntfnptr"
               in ccorres_guard_imp2[where A'=UNIV])
       apply wpc
         apply (simp add: notification_state_defs ccorres_cond_iffs)
@@ -475,8 +604,7 @@ lemma cancelAllSignals_ccorres:
             apply (rule cancel_all_ccorres_helper)
            apply ceqv
           apply (ctac add: rescheduleRequired_ccorres)
-         apply (wp cancelAllIPC_mapM_x_valid_queues)
-         apply (wp mapM_x_wp' weak_sch_act_wf_lift_linear
+         apply (wp mapM_x_wp' weak_sch_act_wf_lift_linear sts_valid_objs'
                    sts_st_tcb' | clarsimp simp: valid_tcb_state'_def split: if_split)+
         apply (simp add: guard_is_UNIV_def)
        apply (wp set_ntfn_valid_objs' hoare_vcg_const_Ball_lift
@@ -487,6 +615,10 @@ lemma cancelAllSignals_ccorres:
       apply (erule ko_at_projectKO_opt)
      apply (frule obj_at_valid_objs', clarsimp+)
      apply (clarsimp simp add: valid_obj'_def valid_ntfn'_def)
+     apply (frule invs_pspace_aligned')
+     apply (frule invs_pspace_distinct')
+     apply (frule ksReadyQueues_asrt_ksReadyQueues_head_end)
+     apply (frule (2) ksReadyQueues_asrt_ksReadyQueues_head_end_tcb_at')
      subgoal by (auto simp: typ_heap_simps cnotification_relation_def
                        Let_def tcb_queue_relation'_def
                        invs_valid_objs' valid_objs'_maxDomain valid_objs'_maxPriority
@@ -571,16 +703,16 @@ lemma tcb_queue_relation2_cong:
 
 context kernel_m begin
 
-lemma setThreadState_ccorres_valid_queues'_simple:
-  "ccorres dc xfdc (\<lambda>s. tcb_at' thread s \<and> valid_queues' s \<and> \<not> runnable' st \<and> sch_act_simple s)
+lemma setThreadState_ccorres_simple:
+  "ccorres dc xfdc (\<lambda>s. tcb_at' thread s \<and> \<not> runnable' st \<and> sch_act_simple s)
    ({s'. (\<forall>cl fl. cthread_state_relation_lifted st (cl\<lparr>tsType_CL := ts_' s' && mask 4\<rparr>, fl))}
     \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr thread}) []
          (setThreadState st thread) (Call setThreadState_'proc)"
   apply (cinit lift: tptr_' cong add: call_ignore_cong)
     apply (ctac (no_vcg) add: threadSet_tcbState_simple_corres)
    apply (ctac add: scheduleTCB_ccorres_valid_queues'_simple)
-  apply (wp threadSet_valid_queues'_and_not_runnable')
-  apply (clarsimp simp: weak_sch_act_wf_def valid_queues'_def)
+  apply (wp threadSet_tcbState_st_tcb_at')
+  apply (fastforce simp: weak_sch_act_wf_def)
   done
 
 lemma updateRestartPC_ccorres:
@@ -596,9 +728,7 @@ lemma updateRestartPC_ccorres:
   done
 
 crunches updateRestartPC
-  for valid_queues'[wp]: valid_queues'
-  and sch_act_simple[wp]: sch_act_simple
-  and valid_queues[wp]: Invariants_H.valid_queues
+  for sch_act_simple[wp]: sch_act_simple
   and valid_objs'[wp]: valid_objs'
   and tcb_at'[wp]: "tcb_at' p"
 
@@ -642,21 +772,12 @@ lemma suspend_ccorres:
           apply (ctac (no_vcg) add: updateRestartPC_ccorres)
          apply (rule ccorres_return_Skip)
         apply ceqv
-       apply (ctac(no_vcg) add: setThreadState_ccorres_valid_queues'_simple)
-        apply (ctac add: tcbSchedDequeue_ccorres')
-       apply (rule_tac Q="\<lambda>_.
-                           (\<lambda>s. \<forall>t' d p. (t' \<in> set (ksReadyQueues s (d, p)) \<longrightarrow>
-                                 obj_at' (\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d
-                                                              \<and> tcbPriority tcb = p) t' s \<and>
-                   (t' \<noteq> thread \<longrightarrow> st_tcb_at' runnable' t' s)) \<and>
-                   distinct (ksReadyQueues s (d, p))) and valid_queues' and valid_objs' and tcb_at' thread"
-                 in hoare_post_imp)
+       apply (ctac(no_vcg) add: setThreadState_ccorres_simple)
+        apply (ctac add: tcbSchedDequeue_ccorres)
+       apply (rule_tac Q="\<lambda>_. valid_objs' and tcb_at' thread and pspace_aligned' and pspace_distinct'"
+                    in hoare_post_imp)
         apply clarsimp
-        apply (drule_tac x="t" in spec)
-        apply (drule_tac x=d in spec)
-        apply (drule_tac x=p in spec)
-        apply (clarsimp elim!: obj_at'_weakenE simp: inQ_def)
-       apply (wp sts_valid_queues_partial)[1]
+       apply (wp sts_valid_objs')[1]
       apply clarsimp
       apply (wpsimp simp: valid_tcb_state'_def)
      apply clarsimp
@@ -671,8 +792,7 @@ lemma suspend_ccorres:
       apply (rule cancelIPC_sch_act_simple)
      apply (rule cancelIPC_tcb_at'[where t=thread])
     apply (rule delete_one_conc_fr.cancelIPC_invs)
-   apply (fastforce simp: invs_valid_queues' invs_queues invs_valid_objs'
-                          valid_tcb_state'_def)
+   apply (fastforce simp: invs_valid_objs' valid_tcb_state'_def)
   apply (auto simp: ThreadState_defs)
   done
 
@@ -857,8 +977,8 @@ lemma unbindMaybeNotification_ccorres:
   apply (clarsimp )
   apply (frule (1) ko_at_valid_ntfn'[OF _ invs_valid_objs'])
   by (auto simp: valid_ntfn'_def valid_bound_tcb'_def obj_at'_def
-                      objBitsKO_def is_aligned_def option_to_ctcb_ptr_def tcb_at_not_NULL
-             split: ntfn.splits)
+                 objBitsKO_def is_aligned_def option_to_ctcb_ptr_def tcb_at_not_NULL
+          split: ntfn.splits)
 
 (* TODO: move *)
 definition
@@ -1677,20 +1797,6 @@ lemma ep_queue_relation_shift2:
   apply (clarsimp split: option.split_asm)
   done
 
-lemma sched_queue_relation_shift:
-  "(option_map2 tcbSchedNext_C (f (cslift s))
-         = option_map2 tcbSchedNext_C (cslift s)
-    \<and> option_map2 tcbSchedPrev_C (f (cslift s))
-         = option_map2 tcbSchedPrev_C (cslift s))
-     \<Longrightarrow>  sched_queue_relation (f (cslift s)) ts qPrev qHead
-          =  sched_queue_relation (cslift s) ts qPrev qHead"
-  apply (induct ts arbitrary: qPrev qHead; clarsimp)
-  apply (simp add: option_map2_def fun_eq_iff
-                   map_option_case)
-  apply (drule_tac x=qHead in spec)+
-  apply (clarsimp split: option.split_asm)
-  done
-
 lemma cendpoint_relation_udpate_arch:
   "\<lbrakk> cslift x p = Some tcb ; cendpoint_relation (cslift x) v v' \<rbrakk>
     \<Longrightarrow> cendpoint_relation ((cslift x)(p \<mapsto> tcbArch_C_update f tcb)) v v'"
diff --git a/proof/crefine/RISCV64/Interrupt_C.thy b/proof/crefine/RISCV64/Interrupt_C.thy
index c23fb74d58..706f2d40ec 100644
--- a/proof/crefine/RISCV64/Interrupt_C.thy
+++ b/proof/crefine/RISCV64/Interrupt_C.thy
@@ -257,7 +257,7 @@ lemma decodeIRQHandlerInvocation_ccorres:
     apply (simp add: syscall_error_to_H_cases)
    apply simp
   apply (clarsimp simp: Collect_const_mem tcb_at_invs')
-  apply (clarsimp simp: invs_queues invs_valid_objs'
+  apply (clarsimp simp: invs_valid_objs'
                         ct_in_state'_def
                         ccap_rights_relation_def
                         mask_def[where n=4] ThreadState_defs)
@@ -273,7 +273,7 @@ lemma decodeIRQHandlerInvocation_ccorres:
                     excaps_map_def excaps_in_mem_def word_less_nat_alt hd_conv_nth
                     slotcap_in_mem_def valid_tcb_state'_def
              dest!: interpret_excaps_eq split: bool.splits)+
-     apply (auto dest: st_tcb_at_idle_thread' ctes_of_valid')[4]
+     apply (auto dest: st_tcb_at_idle_thread' ctes_of_valid')[6]
     apply (drule ctes_of_valid')
      apply fastforce
     apply (clarsimp simp add:valid_cap_simps' RISCV64.maxIRQ_def)
diff --git a/proof/crefine/RISCV64/Invoke_C.thy b/proof/crefine/RISCV64/Invoke_C.thy
index f650ef4f20..5da6ad0739 100644
--- a/proof/crefine/RISCV64/Invoke_C.thy
+++ b/proof/crefine/RISCV64/Invoke_C.thy
@@ -80,15 +80,14 @@ lemma setDomain_ccorres:
                             and (\<lambda>s. curThread = ksCurThread s)"
               in hoare_strengthen_post)
       apply (wp threadSet_all_invs_but_sch_extra)
-     apply (clarsimp simp: valid_pspace_valid_objs' st_tcb_at_def[symmetric]
-                           sch_act_simple_def st_tcb_at'_def weak_sch_act_wf_def
-                    split: if_splits)
+     apply (fastforce simp: valid_pspace_valid_objs' st_tcb_at_def[symmetric]
+                            sch_act_simple_def st_tcb_at'_def weak_sch_act_wf_def
+                     split: if_splits)
     apply (simp add: guard_is_UNIV_def)
-   apply (rule_tac Q="\<lambda>_. invs' and tcb_at' t and sch_act_simple
-                          and (\<lambda>s. curThread = ksCurThread s \<and> (\<forall>p. t \<notin> set (ksReadyQueues s p)))"
+   apply (rule_tac Q="\<lambda>_. invs' and tcb_at' t and sch_act_simple and (\<lambda>s. curThread = ksCurThread s)"
             in hoare_strengthen_post)
     apply (wp weak_sch_act_wf_lift_linear tcbSchedDequeue_not_queued
-              tcbSchedDequeue_not_in_queue hoare_vcg_imp_lift hoare_vcg_all_lift)
+              hoare_vcg_imp_lift hoare_vcg_all_lift)
    apply (clarsimp simp: invs'_def valid_pspace'_def valid_state'_def)
   apply (fastforce simp: valid_tcb'_def tcb_cte_cases_def
                          invs'_def valid_state'_def valid_pspace'_def)
@@ -196,8 +195,8 @@ lemma decodeDomainInvocation_ccorres:
    apply clarsimp
    apply (vcg exspec=getSyscallArg_modifies)
 
-  apply (clarsimp simp: valid_tcb_state'_def invs_valid_queues' invs_valid_objs'
-                        invs_queues invs_sch_act_wf' ct_in_state'_def pred_tcb_at'
+  apply (clarsimp simp: valid_tcb_state'_def invs_valid_objs'
+                        invs_sch_act_wf' ct_in_state'_def pred_tcb_at'
                         rf_sr_ksCurThread word_sle_def word_sless_def sysargs_rel_to_n
                         mask_eq_iff_w2p mask_eq_iff_w2p word_size ThreadState_defs)
   apply (rule conjI)
@@ -207,7 +206,7 @@ lemma decodeDomainInvocation_ccorres:
    apply (drule_tac x="extraCaps ! 0" and P="\<lambda>v. valid_cap' (fst v) s" in bspec)
     apply (clarsimp simp: nth_mem interpret_excaps_test_null excaps_map_def)
    apply (clarsimp simp: valid_cap_simps' pred_tcb'_weakenE active_runnable')
-   apply (rule conjI)
+   apply (intro conjI; fastforce?)
     apply (fastforce simp: tcb_st_refs_of'_def elim:pred_tcb'_weakenE)
    apply (simp add: word_le_nat_alt unat_ucast unat_numDomains_to_H le_maxDomain_eq_less_numDomains)
   apply (clarsimp simp: ccap_relation_def cap_to_H_simps cap_thread_cap_lift)
@@ -760,15 +759,15 @@ lemma decodeCNodeInvocation_ccorres:
                               apply simp
                               apply (wp injection_wp_E[OF refl])
                               apply (rule hoare_post_imp_R)
-                               apply (rule_tac Q'="\<lambda>rv. valid_pspace' and valid_queues
+                               apply (rule_tac Q'="\<lambda>rv. valid_pspace'
                                                     and valid_cap' rv and valid_objs'
                                                          and tcb_at' thread and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)"
                                            in hoare_vcg_R_conj)
                                 apply (rule deriveCap_Null_helper[OF deriveCap_derived])
                                apply wp
                               apply (clarsimp simp: cte_wp_at_ctes_of)
-                              apply (simp add: is_derived'_def badge_derived'_def
-                                               valid_tcb_state'_def)
+                              apply (fastforce simp: is_derived'_def badge_derived'_def
+                                                     valid_tcb_state'_def)
                              apply (simp add: Collect_const_mem all_ex_eq_helper)
                              apply (vcg exspec=deriveCap_modifies)
                             apply wp
@@ -836,14 +835,14 @@ lemma decodeCNodeInvocation_ccorres:
                                   apply (simp add: conj_comms valid_tcb_state'_def)
                                   apply (wp injection_wp_E[OF refl])
                                   apply (rule hoare_post_imp_R)
-                                   apply (rule_tac Q'="\<lambda>rv. valid_pspace' and valid_queues
+                                   apply (rule_tac Q'="\<lambda>rv. valid_pspace'
                                                         and valid_cap' rv and valid_objs'
                                                              and tcb_at' thread and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)"
                                                in hoare_vcg_R_conj)
                                     apply (rule deriveCap_Null_helper [OF deriveCap_derived])
                                    apply wp
                                   apply (clarsimp simp: cte_wp_at_ctes_of)
-                                  apply (simp add: is_derived'_def badge_derived'_def)
+                                  apply (fastforce simp: is_derived'_def badge_derived'_def)
                                  apply (simp add: Collect_const_mem all_ex_eq_helper)
                                  apply (vcg exspec=deriveCap_modifies)
                                 apply (simp add: Collect_const_mem)
@@ -951,12 +950,14 @@ lemma decodeCNodeInvocation_ccorres:
                      apply (rule_tac Q'="\<lambda>a b. cte_wp_at' (\<lambda>x. True) a b \<and> invs' b \<and>
                        tcb_at' thread b  \<and> sch_act_wf (ksSchedulerAction b) b \<and> valid_tcb_state' Restart b
                        \<and> Q2 b" for Q2 in  hoare_post_imp_R)
-                       prefer 2
-                       apply (clarsimp simp:cte_wp_at_ctes_of)
-                       apply (drule ctes_of_valid')
-                         apply (erule invs_valid_objs')
-                        apply (clarsimp simp:valid_updateCapDataI invs_queues invs_valid_objs' invs_valid_pspace')
-                       apply (assumption)
+                      prefer 2
+                      apply (clarsimp simp:cte_wp_at_ctes_of)
+                      apply (drule ctes_of_valid')
+                       apply (erule invs_valid_objs')
+                      apply (frule invs_pspace_aligned')
+                      apply (frule invs_pspace_distinct')
+                      apply (clarsimp simp:valid_updateCapDataI invs_valid_objs' invs_valid_pspace')
+                      apply assumption
                      apply (wp hoare_vcg_all_lift_R injection_wp_E[OF refl]
                                lsfco_cte_at' hoare_vcg_const_imp_lift_R
                            )+
@@ -1351,7 +1352,7 @@ lemma decodeCNodeInvocation_ccorres:
    apply simp
    apply (vcg exspec=getSyscallArg_modifies)
   apply (clarsimp simp: valid_tcb_state'_def invs_valid_objs' invs_valid_pspace'
-                        ct_in_state'_def pred_tcb_at' invs_queues
+                        ct_in_state'_def pred_tcb_at'
                         cur_tcb'_def word_sle_def word_sless_def
                         unat_lt2p[where 'a=machine_word_len, folded word_bits_def])
   apply (rule conjI)
@@ -1383,9 +1384,6 @@ end
 
 context begin interpretation Arch . (*FIXME: arch_split*)
 
-crunch valid_queues[wp]: insertNewCap "valid_queues"
-  (wp: crunch_wps)
-
 lemmas setCTE_def3 = setCTE_def2[THEN eq_reflection]
 
 lemma setCTE_sch_act_wf[wp]:
@@ -3273,7 +3271,7 @@ lemma decodeUntypedInvocation_ccorres_helper:
                       and sch_act_simple and ct_active'" in hoare_post_imp_R)
                    prefer 2
                    apply (clarsimp simp: invs_valid_objs' invs_mdb'
-                      invs_queues ct_in_state'_def pred_tcb_at')
+                                         ct_in_state'_def pred_tcb_at')
                    apply (subgoal_tac "ksCurThread s \<noteq> ksIdleThread sa")
                     prefer 2
                     apply clarsimp
diff --git a/proof/crefine/RISCV64/IpcCancel_C.thy b/proof/crefine/RISCV64/IpcCancel_C.thy
index 716f11e51f..b11da5071d 100644
--- a/proof/crefine/RISCV64/IpcCancel_C.thy
+++ b/proof/crefine/RISCV64/IpcCancel_C.thy
@@ -14,12 +14,12 @@ context kernel_m
 begin
 
 lemma cready_queues_index_to_C_in_range':
-  assumes prems: "qdom \<le> ucast maxDom" "prio \<le> ucast maxPrio"
+  assumes prems: "qdom \<le> maxDomain" "prio \<le> maxPriority"
   shows "cready_queues_index_to_C qdom prio < num_tcb_queues"
 proof -
   have P: "unat prio < numPriorities"
     using prems
-    by (simp add: numPriorities_def seL4_MaxPrio_def Suc_le_lessD unat_le_helper)
+    by (simp add: numPriorities_def Suc_le_lessD unat_le_helper maxDomain_def maxPriority_def)
   have Q: "unat qdom < numDomains"
     using prems
     by (simp add: maxDom_to_H le_maxDomain_eq_less_numDomains word_le_nat_alt)
@@ -33,36 +33,18 @@ lemmas cready_queues_index_to_C_in_range =
 
 lemma cready_queues_index_to_C_inj:
   "\<lbrakk> cready_queues_index_to_C qdom prio = cready_queues_index_to_C qdom' prio';
-     prio \<le> ucast maxPrio; prio' \<le> ucast maxPrio \<rbrakk> \<Longrightarrow> prio = prio' \<and> qdom = qdom'"
+     prio \<le> maxPriority; prio' \<le> maxPriority \<rbrakk> \<Longrightarrow> prio = prio' \<and> qdom = qdom'"
   apply (rule context_conjI)
-  apply (auto simp: cready_queues_index_to_C_def numPriorities_def
+  apply (auto simp: cready_queues_index_to_C_def numPriorities_def maxPriority_def
                     seL4_MaxPrio_def word_le_nat_alt dest: arg_cong[where f="\<lambda>x. x mod 256"])
   done
 
 lemma cready_queues_index_to_C_distinct:
-  "\<lbrakk> qdom = qdom' \<longrightarrow> prio \<noteq> prio'; prio \<le> ucast maxPrio; prio' \<le> ucast maxPrio \<rbrakk>
+  "\<lbrakk> qdom = qdom' \<longrightarrow> prio \<noteq> prio'; prio \<le> maxPriority; prio' \<le> maxPriority \<rbrakk>
    \<Longrightarrow> cready_queues_index_to_C qdom prio \<noteq> cready_queues_index_to_C qdom' prio'"
   apply (auto simp: cready_queues_index_to_C_inj)
   done
 
-lemma cstate_relation_ksReadyQueues_update:
-  "\<lbrakk> cstate_relation hs cs; arr = ksReadyQueues_' cs;
-     sched_queue_relation' (clift (t_hrs_' cs)) v (head_C v') (end_C v');
-     qdom \<le> ucast maxDom; prio \<le> ucast maxPrio \<rbrakk>
-    \<Longrightarrow> cstate_relation (ksReadyQueues_update (\<lambda>qs. qs ((qdom, prio) := v)) hs)
-                        (ksReadyQueues_'_update (\<lambda>_. Arrays.update arr
-                                                        (cready_queues_index_to_C qdom prio) v') cs)"
-  apply (clarsimp simp: cstate_relation_def Let_def
-                        cmachine_state_relation_def
-                        carch_state_relation_def carch_globals_def
-                        cready_queues_relation_def seL4_MinPrio_def minDom_def)
-  apply (frule cready_queues_index_to_C_in_range, assumption)
-  apply clarsimp
-  apply (frule_tac qdom=qdoma and prio=prioa in cready_queues_index_to_C_in_range, assumption)
-  apply (frule cready_queues_index_to_C_distinct, assumption+)
-  apply clarsimp
-  done
-
 lemma cmap_relation_drop_fun_upd:
   "\<lbrakk> cm x = Some v; \<And>v''. rel v'' v = rel v'' v' \<rbrakk>
       \<Longrightarrow> cmap_relation am (cm (x \<mapsto> v')) f rel
@@ -73,16 +55,6 @@ lemma cmap_relation_drop_fun_upd:
   apply (auto split: if_split)
   done
 
-lemma valid_queuesD':
-  "\<lbrakk> obj_at' (inQ d p) t s; valid_queues' s \<rbrakk>
-        \<Longrightarrow> t \<in> set (ksReadyQueues s (d, p))"
-  by (simp add: valid_queues'_def)
-
-lemma invs_valid_queues'[elim!]:
-  "invs' s \<Longrightarrow> valid_queues' s"
-  by (simp add: invs'_def valid_state'_def)
-
-
 lemma ntfn_ptr_get_queue_spec:
   "\<forall>s. \<Gamma> \<turnstile> {\<sigma>. s = \<sigma> \<and> \<sigma> \<Turnstile>\<^sub>c \<^bsup>\<sigma>\<^esup>ntfnPtr} \<acute>ret__struct_tcb_queue_C :== PROC ntfn_ptr_get_queue(\<acute>ntfnPtr)
        \<lbrace>head_C \<acute>ret__struct_tcb_queue_C = Ptr (ntfnQueue_head_CL (notification_lift (the (cslift s \<^bsup>s\<^esup>ntfnPtr)))) \<and>
@@ -227,22 +199,19 @@ lemma cancelSignal_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-            \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-           apply simp
-           apply (rule cendpoint_relation_ntfn_queue [OF invs_sym'], assumption+)
-           apply simp
-           apply (erule (1) map_to_ko_atI')
-          \<comment> \<open>ntfn relation\<close>
-          apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
-          apply (simp add: cnotification_relation_def Let_def NtfnState_Idle_def)
-          apply (simp add: carch_state_relation_def carch_globals_def)
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         apply (clarsimp simp: comp_def)
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+          apply simp
+          apply (rule cendpoint_relation_ntfn_queue [OF invs_sym'], assumption+)
+          apply simp
+          apply (erule (1) map_to_ko_atI')
+         \<comment> \<open>ntfn relation\<close>
+         apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
+         apply (simp add: cnotification_relation_def Let_def NtfnState_Idle_def)
+         apply (simp add: carch_state_relation_def carch_globals_def)
         apply (clarsimp simp: carch_state_relation_def carch_globals_def
                               typ_heap_simps' packed_heap_update_collapse_hrs)
        apply (simp add: cmachine_state_relation_def)
@@ -263,34 +232,31 @@ lemma cancelSignal_ccorres_helper:
                        typ_heap_simps')
       apply (elim conjE)
       apply (intro conjI)
-           \<comment> \<open>tcb relation\<close>
-           apply (erule ctcb_relation_null_queue_ptrs)
-           apply (clarsimp simp: comp_def)
-          \<comment> \<open>ep relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-          apply simp
-          apply (rule cendpoint_relation_ntfn_queue)
-              apply fastforce
-             apply assumption+
-          apply simp
-          apply (erule (1) map_to_ko_atI')
-         \<comment> \<open>ntfn relation\<close>
-         apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
-          apply (simp add: cnotification_relation_def Let_def isWaitingNtfn_def
-                    split: ntfn.splits split del: if_split)
-          apply (erule iffD1 [OF tcb_queue_relation'_cong [OF refl _ _ refl], rotated -1])
-           apply (clarsimp simp add: h_t_valid_clift_Some_iff)
-           apply (subst tcb_queue_relation'_next_sign; assumption?)
-            apply fastforce
-           apply (simp add: notification_lift_def sign_extend_sign_extend_eq canonical_bit_def)
-          apply (clarsimp simp: h_t_valid_clift_Some_iff notification_lift_def sign_extend_sign_extend_eq)
-          apply (subst tcb_queue_relation'_prev_sign; assumption?)
-           apply fastforce
-          apply (simp add: canonical_bit_def)
+          \<comment> \<open>tcb relation\<close>
+          apply (erule ctcb_relation_null_ep_ptrs)
+          apply (clarsimp simp: comp_def)
+         \<comment> \<open>ep relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
          apply simp
-        \<comment> \<open>queue relation\<close>
-        apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-        apply (clarsimp simp: comp_def)
+         apply (rule cendpoint_relation_ntfn_queue)
+             apply fastforce
+            apply assumption+
+         apply simp
+         apply (erule (1) map_to_ko_atI')
+        \<comment> \<open>ntfn relation\<close>
+        apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
+         apply (simp add: cnotification_relation_def Let_def isWaitingNtfn_def
+                   split: ntfn.splits split del: if_split)
+         apply (erule iffD1 [OF tcb_queue_relation'_cong [OF refl _ _ refl], rotated -1])
+          apply (clarsimp simp add: h_t_valid_clift_Some_iff)
+          apply (subst tcb_queue_relation'_next_sign; assumption?)
+           apply fastforce
+          apply (simp add: notification_lift_def sign_extend_sign_extend_eq canonical_bit_def)
+         apply (clarsimp simp: h_t_valid_clift_Some_iff notification_lift_def sign_extend_sign_extend_eq)
+         apply (subst tcb_queue_relation'_prev_sign; assumption?)
+          apply fastforce
+         apply (simp add: canonical_bit_def)
+        apply simp
        subgoal by (clarsimp simp: carch_state_relation_def carch_globals_def)
       subgoal by (simp add: cmachine_state_relation_def)
      subgoal by (simp add: h_t_valid_clift_Some_iff)
@@ -456,68 +422,6 @@ lemma isRunnable_ccorres [corres]:
        apply (simp add: ThreadState_defs)+
   done
 
-
-
-lemma tcb_queue_relation_update_head:
-  fixes getNext_update :: "(tcb_C ptr \<Rightarrow> tcb_C ptr) \<Rightarrow> tcb_C \<Rightarrow> tcb_C" and
-  getPrev_update :: "(tcb_C ptr \<Rightarrow> tcb_C ptr) \<Rightarrow> tcb_C \<Rightarrow> tcb_C"
-  assumes qr: "tcb_queue_relation getNext getPrev mp queue NULL qhead"
-  and     qh': "qhead' \<notin> tcb_ptr_to_ctcb_ptr ` set queue"
-  and  cs_tcb: "mp qhead' = Some tcb"
-  and valid_ep: "\<forall>t\<in>set queue. tcb_at' t s" "distinct queue"
-  and     qhN: "qhead' \<noteq> NULL"
-  and     fgN: "fg_cons getNext (getNext_update \<circ> (\<lambda>x _. x))"
-  and     fgP: "fg_cons getPrev (getPrev_update \<circ> (\<lambda>x _. x))"
-  and     npu: "\<And>f t. getNext (getPrev_update f t) = getNext t"
-  and     pnu: "\<And>f t. getPrev (getNext_update f t) = getPrev t"
-  shows   "tcb_queue_relation getNext getPrev
-                 (upd_unless_null qhead (getPrev_update (\<lambda>_. qhead') (the (mp qhead)))
-                       (mp(qhead' := Some (getPrev_update (\<lambda>_. NULL) (getNext_update (\<lambda>_. qhead)  tcb)))))
-                 (ctcb_ptr_to_tcb_ptr qhead' # queue) NULL qhead'"
-  using qr qh' cs_tcb valid_ep qhN
-  apply (subgoal_tac "qhead \<noteq> qhead'")
-  apply (clarsimp simp: pnu upd_unless_null_def fg_consD1 [OF fgN] fg_consD1 [OF fgP] npu)
-  apply (cases queue)
-    apply simp
-   apply (frule (2) tcb_queue_relation_next_not_NULL)
-    apply simp
-   apply (clarsimp simp: fg_consD1 [OF fgN] fg_consD1 [OF fgP] pnu npu)
-   apply (subst tcb_queue_relation_cong [OF refl refl refl, where mp' = mp])
-    apply (clarsimp simp: inj_eq)
-    apply (intro impI conjI)
-     apply (frule_tac x = x in imageI [where f = tcb_ptr_to_ctcb_ptr])
-     apply simp
-    apply simp
-   apply simp
-  apply clarsimp
-  apply (cases queue)
-   apply simp
-  apply simp
-  done
-
-lemma tcbSchedEnqueue_update:
-  assumes sr: "sched_queue_relation' mp queue qhead qend"
-  and     qh': "qhead' \<notin> tcb_ptr_to_ctcb_ptr ` set queue"
-  and  cs_tcb: "mp qhead' = Some tcb"
-  and valid_ep: "\<forall>t\<in>set queue. tcb_at' t s" "distinct queue"
-  and     qhN: "qhead' \<noteq> NULL"
-  shows
-  "sched_queue_relation'
-                   (upd_unless_null qhead (tcbSchedPrev_C_update (\<lambda>_. qhead') (the (mp qhead)))
-                (mp(qhead' \<mapsto> tcb\<lparr>tcbSchedNext_C := qhead, tcbSchedPrev_C := NULL\<rparr>)))
-            (ctcb_ptr_to_tcb_ptr qhead' # queue) qhead' (if qend = NULL then qhead' else qend)"
-  using sr qh' cs_tcb valid_ep qhN
-  apply -
-  apply (erule tcb_queue_relationE')
-  apply (rule tcb_queue_relationI')
-   apply (erule (5) tcb_queue_relation_update_head
-        [where getNext_update = tcbSchedNext_C_update and getPrev_update = tcbSchedPrev_C_update], simp_all)[1]
-  apply simp
-  apply (intro impI)
-  apply (erule (1) tcb_queue_relation_not_NULL')
-  apply simp
-  done
-
 lemma tcb_ptr_to_ctcb_ptr_imageD:
   "x \<in> tcb_ptr_to_ctcb_ptr ` S \<Longrightarrow> ctcb_ptr_to_tcb_ptr x \<in> S"
   apply (erule imageE)
@@ -530,93 +434,6 @@ lemma ctcb_ptr_to_tcb_ptr_imageI:
   apply simp
   done
 
-lemma tcb_queue'_head_end_NULL:
-  assumes qr: "tcb_queue_relation' getNext getPrev mp queue qhead qend"
-  and   tat: "\<forall>t\<in>set queue. tcb_at' t s"
-  shows "(qend = NULL) = (qhead = NULL)"
-  using qr tat
-  apply -
-  apply (erule tcb_queue_relationE')
-  apply (simp add: tcb_queue_head_empty_iff)
-  apply (rule impI)
-  apply (rule tcb_at_not_NULL)
-  apply (erule bspec)
-  apply simp
-  done
-
-lemma tcb_queue_relation_qhead_mem:
-  "\<lbrakk> tcb_queue_relation getNext getPrev mp queue NULL qhead;
-  (\<forall>tcb\<in>set queue. tcb_at' tcb t) \<rbrakk>
-  \<Longrightarrow> qhead \<noteq> NULL \<longrightarrow> ctcb_ptr_to_tcb_ptr qhead \<in> set queue"
-  by (clarsimp simp: tcb_queue_head_empty_iff tcb_queue_relation_head_hd)
-
-lemma tcb_queue_relation_qhead_valid:
-  "\<lbrakk> tcb_queue_relation getNext getPrev (cslift s') queue NULL qhead;
-  (s, s') \<in> rf_sr; (\<forall>tcb\<in>set queue. tcb_at' tcb s) \<rbrakk>
-  \<Longrightarrow> qhead \<noteq> NULL \<longrightarrow> s' \<Turnstile>\<^sub>c qhead"
-  apply (frule (1) tcb_queue_relation_qhead_mem)
-  apply clarsimp
-  apply(drule (3) tcb_queue_memberD)
-  apply (simp add: h_t_valid_clift_Some_iff)
-  done
-
-lemmas tcb_queue_relation_qhead_mem' = tcb_queue_relation_qhead_mem [OF tcb_queue_relation'_queue_rel]
-lemmas tcb_queue_relation_qhead_valid' = tcb_queue_relation_qhead_valid [OF tcb_queue_relation'_queue_rel]
-
-
-lemma valid_queues_valid_q:
-  "valid_queues s \<Longrightarrow> (\<forall>tcb\<in>set (ksReadyQueues s (qdom, prio)). tcb_at' tcb s) \<and> distinct (ksReadyQueues s (qdom, prio))"
-  apply (clarsimp simp: valid_queues_def valid_queues_no_bitmap_def)
-  apply (drule spec [where x = qdom])
-  apply (drule spec [where x = prio])
-  apply clarsimp
-  apply (drule (1) bspec, erule obj_at'_weakenE)
-  apply simp
-  done
-
-lemma invs_valid_q:
-  "invs' s \<Longrightarrow> (\<forall>tcb\<in>set (ksReadyQueues s (qdom, prio)). tcb_at' tcb s) \<and> distinct (ksReadyQueues s (qdom, prio))"
-  apply (rule valid_queues_valid_q)
-  apply (clarsimp simp: invs'_def valid_state'_def)
-  done
-
-lemma tcbQueued_not_in_queues:
-  assumes vq: "valid_queues s"
-  and    objat: "obj_at' (Not \<circ> tcbQueued) thread s"
-  shows   "thread \<notin> set (ksReadyQueues s (d, p))"
-  using vq objat
-  apply -
-  apply clarsimp
-  apply (drule (1) valid_queues_obj_at'D)
-  apply (erule obj_atE')+
-  apply (clarsimp simp: inQ_def)
-  done
-
-
-lemma rf_sr_sched_queue_relation:
-  "\<lbrakk> (s, s') \<in> rf_sr; d \<le> ucast maxDom; p \<le> ucast maxPrio \<rbrakk>
-  \<Longrightarrow> sched_queue_relation' (cslift s') (ksReadyQueues s (d, p))
-                                        (head_C (index (ksReadyQueues_' (globals s'))
-                                                       (cready_queues_index_to_C d p)))
-                                        (end_C (index (ksReadyQueues_' (globals s'))
-                                                      (cready_queues_index_to_C d p)))"
-  unfolding rf_sr_def cstate_relation_def cready_queues_relation_def
-  apply (clarsimp simp: Let_def seL4_MinPrio_def minDom_def)
-  done
-
-lemma ready_queue_not_in:
-  assumes  vq: "valid_queues s"
-  and     inq: "t \<in> set (ksReadyQueues s (d, p))"
-  and     neq: "d \<noteq> d' \<or> p \<noteq> p'"
-  shows   "t \<notin> set (ksReadyQueues s (d', p'))"
-proof
-  assume "t \<in> set (ksReadyQueues s (d', p'))"
-  hence "obj_at' (inQ d' p') t s" using vq by (rule valid_queues_obj_at'D)
-  moreover have "obj_at' (inQ d p) t s" using inq vq by (rule valid_queues_obj_at'D)
-  ultimately show False using neq
-    by (clarsimp elim!: obj_atE' simp: inQ_def)
-qed
-
 lemma ctcb_relation_unat_prio_eq:
   "ctcb_relation tcb tcb' \<Longrightarrow> unat (tcbPriority tcb) = unat (tcbPriority_C tcb')"
   apply (clarsimp simp: ctcb_relation_def)
@@ -650,137 +467,6 @@ lemma threadSet_queued_ccorres [corres]:
   apply (clarsimp simp: typ_heap_simps)
   done
 
-lemma ccorres_pre_getQueue:
-  assumes cc: "\<And>queue. ccorres r xf (P queue) (P' queue) hs (f queue) c"
-  shows   "ccorres r xf (\<lambda>s. P (ksReadyQueues s (d, p)) s \<and> d \<le> maxDomain \<and> p \<le> maxPriority)
-                        {s'. \<forall>queue. (let cqueue = index (ksReadyQueues_' (globals s'))
-                                                         (cready_queues_index_to_C d p) in
-                                      sched_queue_relation' (cslift s') queue (head_C cqueue) (end_C cqueue)) \<longrightarrow> s' \<in> P' queue}
-           hs (getQueue d p >>= (\<lambda>queue. f queue)) c"
-  apply (rule ccorres_guard_imp2)
-  apply (rule ccorres_symb_exec_l2)
-     defer
-     defer
-     apply (rule gq_sp)
-    defer
-    apply (rule ccorres_guard_imp)
-    apply (rule cc)
-     apply clarsimp
-     apply assumption
-    apply assumption
-   apply (clarsimp simp: getQueue_def gets_exs_valid)
-  apply clarsimp
-  apply (drule spec, erule mp)
-  apply (simp add: Let_def)
-  apply (erule rf_sr_sched_queue_relation)
-   apply (simp add: maxDom_to_H maxPrio_to_H)+
-  done
-
-lemma state_relation_queue_update_helper':
-  "\<lbrakk> (s, s') \<in> rf_sr;
-     (\<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s)
-                                       \<and> distinct (ksReadyQueues s (d, p)));
-          globals t = ksReadyQueues_'_update
-             (\<lambda>_. Arrays.update (ksReadyQueues_' (globals s')) prio' q')
-             (t_hrs_'_update f (globals s'));
-          sched_queue_relation' (cslift t) q (head_C q') (end_C q');
-          cslift t |` ( - tcb_ptr_to_ctcb_ptr ` S )
-             = cslift s' |` ( - tcb_ptr_to_ctcb_ptr ` S );
-          option_map tcb_null_sched_ptrs \<circ> cslift t
-            = option_map tcb_null_sched_ptrs \<circ> cslift s';
-          cslift_all_but_tcb_C t s';
-          zero_ranges_are_zero (gsUntypedZeroRanges s) (f (t_hrs_' (globals s')))
-              = zero_ranges_are_zero (gsUntypedZeroRanges s) (t_hrs_' (globals s'));
-          hrs_htd (t_hrs_' (globals t)) = hrs_htd (t_hrs_' (globals s'));
-          prio' = cready_queues_index_to_C qdom prio;
-          \<forall>x \<in> S. obj_at' (inQ qdom prio) x s
-                   \<or> (obj_at' (\<lambda>tcb. tcbPriority tcb = prio) x s
-                       \<and> obj_at' (\<lambda>tcb. tcbDomain tcb = qdom) x s)
-                   \<or> (tcb_at' x s \<and> (\<forall>d' p'. (d' \<noteq> qdom \<or> p' \<noteq> prio)
-                                         \<longrightarrow> x \<notin> set (ksReadyQueues s (d', p'))));
-          S \<noteq> {}; qdom \<le> ucast maxDom; prio \<le> ucast maxPrio \<rbrakk>
-      \<Longrightarrow> (s \<lparr>ksReadyQueues := (ksReadyQueues s)((qdom, prio) := q)\<rparr>, t) \<in> rf_sr"
-  apply (subst(asm) disj_imp_rhs)
-   apply (subst obj_at'_and[symmetric])
-   apply (rule disjI1, erule obj_at'_weakenE, simp add: inQ_def)
-  apply (subst(asm) disj_imp_rhs)
-   apply (subst(asm) obj_at'_and[symmetric])
-   apply (rule conjI, erule obj_at'_weakenE, simp)
-   apply (rule allI, rule allI)
-   apply (drule_tac x=d' in spec)
-   apply (drule_tac x=p' in spec)
-   apply clarsimp
-   apply (drule(1) bspec)
-   apply (clarsimp simp: inQ_def obj_at'_def)
-  apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def)
-  apply (intro conjI)
-      \<comment> \<open>cpspace_relation\<close>
-     apply (erule nonemptyE, drule(1) bspec)
-     apply (clarsimp simp: cpspace_relation_def)
-     apply (drule obj_at_ko_at', clarsimp)
-     apply (rule cmap_relationE1, assumption,
-            erule ko_at_projectKO_opt)
-     apply (frule null_sched_queue)
-     apply (frule null_sched_epD)
-     apply (intro conjI)
-       \<comment> \<open>tcb relation\<close>
-       apply (drule ctcb_relation_null_queue_ptrs,
-              simp_all)[1]
-      \<comment> \<open>endpoint relation\<close>
-      apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-      apply simp
-      apply (erule cendpoint_relation_upd_tcb_no_queues, simp+)
-     \<comment> \<open>ntfn relation\<close>
-     apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-     apply simp
-     apply (erule cnotification_relation_upd_tcb_no_queues, simp+)
-    \<comment> \<open>ready queues\<close>
-    apply (simp add: cready_queues_relation_def Let_def cready_queues_index_to_C_in_range
-                     seL4_MinPrio_def minDom_def)
-    apply clarsimp
-    apply (frule cready_queues_index_to_C_distinct, assumption+)
-    apply (clarsimp simp: cready_queues_index_to_C_in_range all_conj_distrib)
-    apply (rule iffD1 [OF tcb_queue_relation'_cong[OF refl], rotated -1],
-           drule spec, drule spec, erule mp, simp+)
-    apply clarsimp
-    apply (drule_tac x="tcb_ptr_to_ctcb_ptr x" in fun_cong)+
-    apply (clarsimp simp: restrict_map_def
-                   split: if_split_asm)
-   by (auto simp: carch_state_relation_def cmachine_state_relation_def)
-
-lemma state_relation_queue_update_helper:
-  "\<lbrakk> (s, s') \<in> rf_sr; valid_queues s;
-          globals t = ksReadyQueues_'_update
-             (\<lambda>_. Arrays.update (ksReadyQueues_' (globals s')) prio' q')
-             (t_hrs_'_update f (globals s'));
-          sched_queue_relation' (cslift t) q (head_C q') (end_C q');
-          cslift t |` ( - tcb_ptr_to_ctcb_ptr ` S )
-             = cslift s' |` ( - tcb_ptr_to_ctcb_ptr ` S );
-          option_map tcb_null_sched_ptrs \<circ> cslift t
-            = option_map tcb_null_sched_ptrs \<circ> cslift s';
-          cslift_all_but_tcb_C t s';
-          zero_ranges_are_zero (gsUntypedZeroRanges s) (f (t_hrs_' (globals s')))
-              = zero_ranges_are_zero (gsUntypedZeroRanges s) (t_hrs_' (globals s'));
-          hrs_htd (t_hrs_' (globals t)) = hrs_htd (t_hrs_' (globals s'));
-          prio' = cready_queues_index_to_C qdom prio;
-          \<forall>x \<in> S. obj_at' (inQ qdom prio) x s
-                   \<or> (obj_at' (\<lambda>tcb. tcbPriority tcb = prio) x s
-                       \<and> obj_at' (\<lambda>tcb. tcbDomain tcb = qdom) x s)
-                   \<or> (tcb_at' x s \<and> (\<forall>d' p'. (d' \<noteq> qdom \<or> p' \<noteq> prio)
-                                         \<longrightarrow> x \<notin> set (ksReadyQueues s (d', p'))));
-          S \<noteq> {}; qdom \<le> ucast maxDom; prio \<le> ucast maxPrio \<rbrakk>
-      \<Longrightarrow> (s \<lparr>ksReadyQueues := (ksReadyQueues s)((qdom, prio) := q)\<rparr>, t) \<in> rf_sr"
-  apply (subgoal_tac "\<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s)
-                           \<and> distinct(ksReadyQueues s (d, p))")
-   apply (erule(5) state_relation_queue_update_helper', simp_all)
-  apply (clarsimp simp: valid_queues_def valid_queues_no_bitmap_def)
-  apply (drule_tac x=d in spec)
-  apply (drule_tac x=p in spec)
-  apply (clarsimp)
-  apply (drule(1) bspec)
-  apply (erule obj_at'_weakenE, clarsimp)
-  done
-
 (* FIXME: move *)
 lemma cmap_relation_no_upd:
   "\<lbrakk> cmap_relation a c f rel; a p = Some ko; rel ko v; inj f \<rbrakk> \<Longrightarrow> cmap_relation a (c(f p \<mapsto> v)) f rel"
@@ -825,8 +511,8 @@ lemma cready_queues_index_to_C_def2:
 lemma ready_queues_index_spec:
   "\<forall>s. \<Gamma> \<turnstile> {s'. s' = s \<and> (Kernel_Config.numDomains \<le> 1 \<longrightarrow> dom_' s' = 0)}
        Call ready_queues_index_'proc
-       \<lbrace>\<acute>ret__unsigned_long = (dom_' s) * 0x100 + (prio_' s)\<rbrace>"
-  by vcg (simp add: numDomains_sge_1_simp)
+       \<lbrace>\<acute>ret__unsigned_long = (dom_' s) * word_of_nat numPriorities + (prio_' s)\<rbrace>"
+  by vcg (simp add: numDomains_sge_1_simp numPriorities_def)
 
 lemma prio_to_l1index_spec:
   "\<forall>s. \<Gamma> \<turnstile> {s} Call prio_to_l1index_'proc
@@ -921,56 +607,6 @@ lemma cbitmap_L2_relation_bit_set:
   apply (case_tac "da = d" ; clarsimp simp: num_domains_index_updates)
   done
 
-lemma carch_state_relation_enqueue_simp:
-  "carch_state_relation (ksArchState \<sigma>)
-    (t_hrs_'_update f
-      (globals \<sigma>' \<lparr>ksReadyQueuesL1Bitmap_' := l1upd, ksReadyQueuesL2Bitmap_' := l2upd \<rparr>)
-      \<lparr>ksReadyQueues_' := rqupd \<rparr>) =
-   carch_state_relation (ksArchState \<sigma>) (t_hrs_'_update f (globals \<sigma>'))"
-  unfolding carch_state_relation_def
-  by clarsimp
-
-lemma t_hrs_ksReadyQueues_upd_absorb:
-  "t_hrs_'_update f (g s) \<lparr>ksReadyQueues_' := rqupd \<rparr> =
-   t_hrs_'_update f (g s \<lparr>ksReadyQueues_' := rqupd\<rparr>)"
-  by simp
-
-lemma rf_sr_drop_bitmaps_enqueue_helper:
-  "\<lbrakk> (\<sigma>,\<sigma>') \<in> rf_sr ;
-     cbitmap_L1_relation ksqL1upd' ksqL1upd ; cbitmap_L2_relation ksqL2upd' ksqL2upd \<rbrakk>
-   \<Longrightarrow>
-   ((\<sigma>\<lparr>ksReadyQueues := ksqupd, ksReadyQueuesL1Bitmap := ksqL1upd, ksReadyQueuesL2Bitmap := ksqL2upd\<rparr>,
-     \<sigma>'\<lparr>idx_' := i', queue_' := queue_upd',
-        globals := t_hrs_'_update f
-          (globals \<sigma>'
-             \<lparr>ksReadyQueuesL1Bitmap_' := ksqL1upd',
-              ksReadyQueuesL2Bitmap_' := ksqL2upd',
-              ksReadyQueues_' := ksqupd'\<rparr>)\<rparr>) \<in> rf_sr) =
-   ((\<sigma>\<lparr>ksReadyQueues := ksqupd\<rparr>,
-     \<sigma>'\<lparr>idx_' := i', queue_' := queue_upd',
-        globals := t_hrs_'_update f
-          (globals \<sigma>' \<lparr>ksReadyQueues_' := ksqupd'\<rparr>)\<rparr>) \<in> rf_sr)"
-  unfolding rf_sr_def cstate_relation_def Let_def
-             carch_state_relation_def cmachine_state_relation_def
-  by (clarsimp simp: rf_sr_cbitmap_L1_relation rf_sr_cbitmap_L2_relation)
-
-lemma cmachine_state_relation_enqueue_simp:
-  "cmachine_state_relation (ksMachineState \<sigma>)
-    (t_hrs_'_update f
-      (globals \<sigma>' \<lparr>ksReadyQueuesL1Bitmap_' := l1upd, ksReadyQueuesL2Bitmap_' := l2upd \<rparr>)
-      \<lparr>ksReadyQueues_' := rqupd \<rparr>) =
-   cmachine_state_relation (ksMachineState \<sigma>) (t_hrs_'_update f (globals \<sigma>'))"
-  unfolding cmachine_state_relation_def
-  by clarsimp
-
-lemma tcb_queue_relation'_empty_ksReadyQueues:
-  "\<lbrakk> sched_queue_relation' (cslift x) (q s) NULL NULL ; \<forall>t\<in> set (q s). tcb_at' t s  \<rbrakk> \<Longrightarrow> q s = []"
-  apply (clarsimp simp add: tcb_queue_relation'_def)
-  apply (subst (asm) eq_commute)
-  apply (cases "q s" rule: rev_cases, simp)
-  apply (clarsimp simp: tcb_at_not_NULL)
-  done
-
 lemma invert_prioToL1Index_c_simp:
   "p \<le> maxPriority
    \<Longrightarrow>
@@ -984,13 +620,247 @@ lemma c_invert_assist: "3 - (ucast (p :: priority) >> 6 :: machine_word) < 4"
   using prio_ucast_shiftr_wordRadix_helper'[simplified wordRadix_def]
   by - (rule word_less_imp_diff_less, simp_all)
 
+lemma addToBitmap_ccorres:
+  "ccorres dc xfdc
+     (K (tdom \<le> maxDomain \<and> prio \<le> maxPriority)) (\<lbrace>\<acute>dom = ucast tdom\<rbrace> \<inter> \<lbrace>\<acute>prio = ucast prio\<rbrace>) hs
+     (addToBitmap tdom prio) (Call addToBitmap_'proc)"
+  supply prio_and_dom_limit_helpers[simp] invert_prioToL1Index_c_simp[simp]
+  apply (rule ccorres_from_vcg)
+  apply (rule allI, rule conseqPre, vcg)
+  apply clarsimp
+  apply (frule maxDomain_le_unat_ucast_explicit)
+  apply (clarsimp simp: getQueue_def gets_def get_def setQueue_def modify_def
+                        put_def bind_def return_def bitmap_fun_defs)
+  apply (intro conjI impI allI)
+   apply (fastforce simp: c_invert_assist l2BitmapSize_def' wordRadix_def)
+  apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
+                        carch_state_relation_def cmachine_state_relation_def)
+  apply (rule conjI)
+   apply (clarsimp intro!: cbitmap_L1_relation_bit_set)
+  apply (fastforce dest!: cbitmap_L2_relation_bit_set simp: wordRadix_def mask_def)
+  done
+
+lemma rf_sr_tcb_update_twice:
+  "h_t_valid (hrs_htd (hrs2 (globals s') (t_hrs_' (gs2 (globals s'))))) c_guard
+      (ptr (t_hrs_' (gs2 (globals s'))) (globals s'))
+    \<Longrightarrow> ((s, globals_update (\<lambda>gs. t_hrs_'_update (\<lambda>ths.
+        hrs_mem_update (heap_update (ptr ths gs :: tcb_C ptr) (v ths gs))
+            (hrs_mem_update (heap_update (ptr ths gs) (v' ths gs)) (hrs2 gs ths))) (gs2 gs)) s') \<in> rf_sr)
+    = ((s, globals_update (\<lambda>gs. t_hrs_'_update (\<lambda>ths.
+        hrs_mem_update (heap_update (ptr ths gs) (v ths gs)) (hrs2 gs ths)) (gs2 gs)) s') \<in> rf_sr)"
+  by (simp add: rf_sr_def cstate_relation_def Let_def
+                cpspace_relation_def typ_heap_simps'
+                carch_state_relation_def cmachine_state_relation_def
+                packed_heap_update_collapse_hrs)
+
+lemmas rf_sr_tcb_update_no_queue_gen2 =
+  rf_sr_obj_update_helper[OF rf_sr_tcb_update_no_queue_gen, simplified]
+
+lemma tcb_queue_prepend_ccorres:
+  "ccorres ctcb_queue_relation ret__struct_tcb_queue_C_'
+     (\<lambda>s. tcb_at' tcbPtr s
+          \<and> (tcbQueueHead queue \<noteq> None \<longleftrightarrow> tcbQueueEnd queue \<noteq> None)
+          \<and> (\<forall>head. tcbQueueHead queue = Some head \<longrightarrow> tcb_at' head s))
+     (\<lbrace>ctcb_queue_relation queue \<acute>queue\<rbrace> \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr tcbPtr\<rbrace>) hs
+     (tcbQueuePrepend queue tcbPtr) (Call tcb_queue_prepend_'proc)"
+  (is "ccorres _ _ ?abs _ _ _ _")
+  supply if_split[split del]
+  apply (cinit lift: tcb_')
+   \<comment> \<open>cinit is not able to lift queue_' because queue_' is later modified in the C program\<close>
+   apply (rule_tac xf'=queue_' in ccorres_abstract, ceqv, rename_tac cqueue)
+   apply (rule_tac P="ctcb_queue_relation queue cqueue" in ccorres_gen_asm2)
+   apply (rule_tac xf'=ret__unsigned_long_'
+               and val="from_bool (tcbQueueEmpty queue)"
+               and R="?abs"
+               and R'="\<lbrace>\<acute>queue = cqueue\<rbrace>"
+                in ccorres_symb_exec_r_known_rv)
+      apply (rule conseqPre, vcg)
+      apply (fastforce dest: tcb_at_not_NULL
+                       simp: ctcb_queue_relation_def option_to_ctcb_ptr_def tcbQueueEmpty_def)
+     apply ceqv
+    apply (rule_tac r'=ctcb_queue_relation and xf'=queue_' in ccorres_split_nothrow)
+        apply (rule_tac Q="?abs"
+                    and Q'="\<lambda>s'. queue_' s' = cqueue"
+                     in ccorres_cond_both')
+          apply fastforce
+         apply clarsimp
+         apply (rule ccorres_return[where R=\<top>])
+         apply (rule conseqPre, vcg)
+         apply (fastforce simp: ctcb_queue_relation_def option_to_ctcb_ptr_def)
+        apply (rule ccorres_seq_skip'[THEN iffD1])
+        apply (rule ccorres_rhs_assoc)+
+        apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+            apply (rule ccorres_Guard)
+            apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb tcbPtr s
+                                            \<and> head_C cqueue = option_to_ctcb_ptr (tcbQueueHead queue)}"
+                        and R="\<lbrace>head_C cqueue = option_to_ctcb_ptr (tcbQueueHead queue)\<rbrace>"
+                         in threadSet_ccorres_lemma4[where P=\<top> and P'=\<top>])
+             apply (rule conseqPre, vcg)
+             apply clarsimp
+             apply (frule (1) obj_at_cslift_tcb)
+             apply (fastforce intro!: rf_sr_tcb_update_no_queue_gen2
+                                simp: typ_heap_simps' tcb_cte_cases_def cteSizeBits_def
+                                      ctcb_relation_def option_to_ctcb_ptr_def)
+            apply (clarsimp simp: ctcb_relation_def option_to_ctcb_ptr_def split: if_splits)
+           apply ceqv
+          apply simp
+          apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+              apply (rule ccorres_Guard)
+              apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr
+                                              \<and> ko_at' tcb (the (tcbQueueHead queue)) s
+                                              \<and> head_C cqueue = option_to_ctcb_ptr (tcbQueueHead queue)}"
+                          and R="\<lbrace>head_C cqueue = option_to_ctcb_ptr (tcbQueueHead queue)\<rbrace>"
+                           in threadSet_ccorres_lemma4[where P=\<top> and P'=\<top>])
+               apply (rule conseqPre, vcg)
+               apply clarsimp
+               apply (frule (1) obj_at_cslift_tcb)
+               apply (fastforce intro!: rf_sr_tcb_update_no_queue_gen2
+                                  simp: typ_heap_simps' tcb_cte_cases_def cteSizeBits_def
+                                        ctcb_relation_def option_to_ctcb_ptr_def tcbQueueEmpty_def)
+              apply fastforce
+             apply ceqv
+            apply (rule ccorres_return_Skip')
+           apply wpsimp
+          apply vcg
+         apply wpsimp
+        apply vcg
+       apply ceqv
+      apply csymbr
+      apply (fastforce intro: ccorres_return_C')
+     apply wpsimp
+    apply vcg
+   apply clarsimp
+   apply (vcg exspec=tcb_queue_empty_modifies)
+  apply clarsimp
+  apply (frule (1) tcb_at_h_t_valid)
+  by (force dest: tcb_at_h_t_valid
+            simp: ctcb_queue_relation_def option_to_ctcb_ptr_def tcbQueueEmpty_def)
+
+lemma tcb_queue_append_ccorres:
+  "ccorres ctcb_queue_relation ret__struct_tcb_queue_C_'
+     (\<lambda>s. tcb_at' tcbPtr s
+          \<and> (tcbQueueHead queue \<noteq> None \<longleftrightarrow> tcbQueueEnd queue \<noteq> None)
+          \<and> (\<forall>head. tcbQueueHead queue = Some head \<longrightarrow> tcb_at' head s)
+          \<and> (\<forall>end. tcbQueueEnd queue = Some end \<longrightarrow> tcb_at' end s))
+     (\<lbrace>ctcb_queue_relation queue \<acute>queue\<rbrace> \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr tcbPtr\<rbrace>) hs
+     (tcbQueueAppend queue tcbPtr) (Call tcb_queue_append_'proc)"
+  (is "ccorres _ _ ?abs _ _ _ _")
+  supply if_split[split del]
+  apply (cinit lift: tcb_')
+   \<comment> \<open>cinit is not able to lift queue_' because queue_' is later modified in the C program\<close>
+   apply (rule_tac xf'=queue_' in ccorres_abstract, ceqv, rename_tac cqueue)
+   apply (rule_tac P="ctcb_queue_relation queue cqueue
+                      \<and> (tcbQueueHead queue \<noteq> None \<longleftrightarrow> tcbQueueEnd queue \<noteq> None)"
+                in ccorres_gen_asm2)
+   apply (rule_tac xf'=ret__unsigned_long_'
+               and val="from_bool (tcbQueueEmpty queue)"
+               and R="?abs"
+               and R'="\<lbrace>\<acute>queue = cqueue\<rbrace>"
+                in ccorres_symb_exec_r_known_rv)
+      apply (rule conseqPre, vcg)
+      apply (fastforce dest: tcb_at_not_NULL
+                       simp: ctcb_queue_relation_def option_to_ctcb_ptr_def tcbQueueEmpty_def)
+     apply ceqv
+    apply (rule_tac r'=ctcb_queue_relation and xf'=queue_' in ccorres_split_nothrow)
+        apply (rule_tac Q="?abs"
+                    and Q'="\<lambda>s'. queue_' s' = cqueue"
+                     in ccorres_cond_both')
+          apply (fastforce dest: tcb_at_not_NULL
+                           simp: ctcb_queue_relation_def option_to_ctcb_ptr_def)
+         apply clarsimp
+         apply (rule ccorres_return[where R=\<top>])
+         apply (rule conseqPre, vcg)
+         apply (fastforce simp: ctcb_queue_relation_def option_to_ctcb_ptr_def)
+        apply (rule ccorres_seq_skip'[THEN iffD1])
+        apply (rule ccorres_rhs_assoc)+
+        apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+            apply (rule ccorres_Guard)
+            apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb tcbPtr s
+                                            \<and> end_C cqueue = option_to_ctcb_ptr (tcbQueueEnd queue)}"
+                        and R="\<lbrace>end_C cqueue = option_to_ctcb_ptr (tcbQueueEnd queue)\<rbrace>"
+                         in threadSet_ccorres_lemma4[where P=\<top> and P'=\<top>])
+             apply (rule conseqPre, vcg)
+             apply clarsimp
+             apply (frule (1) obj_at_cslift_tcb)
+             apply (fastforce intro!: rf_sr_tcb_update_no_queue_gen2
+                                simp: typ_heap_simps' tcb_cte_cases_def cteSizeBits_def
+                                      ctcb_relation_def option_to_ctcb_ptr_def)
+            apply (clarsimp simp: ctcb_relation_def option_to_ctcb_ptr_def split: if_splits)
+           apply ceqv
+          apply simp
+          apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+              apply (rule ccorres_Guard)
+              apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr
+                                              \<and> ko_at' tcb (the (tcbQueueEnd queue)) s
+                                              \<and> end_C cqueue = option_to_ctcb_ptr (tcbQueueEnd queue)}"
+                          and R="\<lbrace>end_C cqueue = option_to_ctcb_ptr (tcbQueueEnd queue)\<rbrace>"
+                           in threadSet_ccorres_lemma4[where P=\<top> and P'=\<top>])
+               apply (rule conseqPre, vcg)
+               apply clarsimp
+               apply (frule (1) obj_at_cslift_tcb)
+               apply (fastforce intro!: rf_sr_tcb_update_no_queue_gen2
+                                  simp: typ_heap_simps' tcb_cte_cases_def cteSizeBits_def
+                                        ctcb_relation_def option_to_ctcb_ptr_def tcbQueueEmpty_def)
+              apply fastforce
+             apply ceqv
+            apply (rule ccorres_return_Skip')
+           apply wpsimp
+          apply vcg
+         apply wpsimp
+        apply vcg
+       apply ceqv
+      apply csymbr
+      apply (fastforce intro: ccorres_return_C')
+     apply wpsimp
+    apply vcg
+   apply (vcg exspec=tcb_queue_empty_modifies)
+  apply clarsimp
+  apply (frule (1) tcb_at_h_t_valid)
+  by (force dest: tcb_at_h_t_valid
+            simp: ctcb_queue_relation_def option_to_ctcb_ptr_def tcbQueueEmpty_def)
+
+lemma getQueue_ccorres:
+  "ccorres ctcb_queue_relation queue_'
+     (K (tdom \<le> maxDomain \<and> prio \<le> maxPriority))
+     \<lbrace>\<acute>idx = word_of_nat (cready_queues_index_to_C tdom prio)\<rbrace> hs
+     (getQueue tdom prio) (\<acute>queue :== \<acute>ksReadyQueues.[unat \<acute>idx])"
+  apply (rule ccorres_from_vcg)
+  apply (rule allI, rule conseqPre, vcg)
+  apply (clarsimp simp: getQueue_def gets_def get_def bind_def return_def)
+  apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def)
+  apply (frule (1) cready_queues_index_to_C_in_range)
+  apply (clarsimp simp: unat_of_nat_eq cready_queues_relation_def)
+  done
+
+lemma setQueue_ccorres:
+  "ctcb_queue_relation queue cqueue \<Longrightarrow>
+   ccorres dc xfdc
+     (K (tdom \<le> maxDomain \<and> prio \<le> maxPriority))
+     \<lbrace>\<acute>idx = word_of_nat (cready_queues_index_to_C tdom prio)\<rbrace> hs
+     (setQueue tdom prio queue)
+     (Basic (\<lambda>s. globals_update
+                  (ksReadyQueues_'_update
+                   (\<lambda>_. Arrays.update (ksReadyQueues_' (globals s)) (unat (idx_' s)) cqueue)) s))"
+  apply (rule ccorres_from_vcg)
+  apply (rule allI, rule conseqPre, vcg)
+  apply (clarsimp simp: setQueue_def get_def modify_def put_def bind_def)
+  apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
+                        carch_state_relation_def cmachine_state_relation_def)
+  apply (frule (1) cready_queues_index_to_C_in_range)
+  apply (clarsimp simp: unat_of_nat_eq cready_queues_relation_def)
+  apply (frule cready_queues_index_to_C_distinct, assumption+)
+  apply (frule_tac qdom=d and prio=p in cready_queues_index_to_C_in_range)
+   apply fastforce
+  apply clarsimp
+  done
+
+crunch (empty_fail) empty_fail[wp]: isRunnable
+
 lemma tcbSchedEnqueue_ccorres:
   "ccorres dc xfdc
-           (valid_queues and tcb_at' t and valid_objs')
-           (UNIV \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace>)
-           hs
-           (tcbSchedEnqueue t)
-           (Call tcbSchedEnqueue_'proc)"
+     (tcb_at' t and valid_objs' and pspace_aligned' and pspace_distinct')
+     \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace> hs
+     (tcbSchedEnqueue t) (Call tcbSchedEnqueue_'proc)"
 proof -
   note prio_and_dom_limit_helpers[simp] word_sle_def[simp] maxDom_to_H[simp] maxPrio_to_H[simp]
   note invert_prioToL1Index_c_simp[simp]
@@ -1001,24 +871,12 @@ proof -
 
   show ?thesis
     apply (cinit lift: tcb_')
-     apply (rule_tac r'="\<lambda>rv rv'. rv = to_bool rv'" and xf'="ret__unsigned_longlong_'"
-              in ccorres_split_nothrow)
-         apply (rule threadGet_vcg_corres)
-         apply (rule allI, rule conseqPre, vcg)
-         apply clarsimp
-         apply (drule obj_at_ko_at', clarsimp)
-         apply (drule spec, drule(1) mp, clarsimp)
-         apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-        apply ceqv
-       apply (simp add: when_def unless_def del: Collect_const split del: if_split)
-       apply (rule ccorres_cond[where R=\<top>])
-         apply (simp add: to_bool_def)
-        apply (rule ccorres_rhs_assoc)+
-        apply csymbr
-        apply csymbr
-        apply csymbr
-        apply csymbr
-        apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="dom_'" in ccorres_split_nothrow)
+     apply (rule ccorres_stateAssert)+
+     apply (rule ccorres_symb_exec_l)
+        apply (rule ccorres_assert)
+        apply (thin_tac runnable)
+        apply (rule_tac r'="\<lambda>rv rv'. rv = to_bool rv'" and xf'="ret__unsigned_longlong_'"
+                     in ccorres_split_nothrow)
             apply (rule threadGet_vcg_corres)
             apply (rule allI, rule conseqPre, vcg)
             apply clarsimp
@@ -1026,244 +884,246 @@ proof -
             apply (drule spec, drule(1) mp, clarsimp)
             apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
            apply ceqv
-          apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="prio_'" in ccorres_split_nothrow)
-              apply (rule threadGet_vcg_corres)
-              apply (rule allI, rule conseqPre, vcg)
-              apply clarsimp
-              apply (drule obj_at_ko_at', clarsimp)
-              apply (drule spec, drule(1) mp, clarsimp)
-              apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-             apply ceqv
-            apply (rule ccorres_rhs_assoc2)+
-            apply (simp only: bind_assoc[symmetric])
-            apply (rule ccorres_split_nothrow_novcg_dc)
-               prefer 2
-               apply (rule ccorres_move_c_guard_tcb)
-               apply simp
-               apply ctac
-              prefer 2
-              apply (wp, clarsimp, wp+)
-             apply (rule_tac P="\<lambda>s. valid_queues s \<and> (\<forall>p. t \<notin> set (ksReadyQueues s p))
-                                  \<and> (\<exists>tcb. ko_at' tcb t s \<and> tcbDomain tcb =rva
-                                  \<and> tcbPriority tcb = rvb \<and> valid_tcb' tcb s)"
-                         and P'=UNIV in ccorres_from_vcg)
-             apply (rule allI, rule conseqPre, vcg)
-             apply (clarsimp simp: getQueue_def gets_def get_def setQueue_def modify_def
-                                   put_def bind_def return_def bitmap_fun_defs null_def)
-             apply (clarsimp simp: queue_in_range valid_tcb'_def)
-             apply (rule conjI; clarsimp simp: queue_in_range)
-              (* queue is empty, set t to be new queue *)
-              apply (drule (1) obj_at_cslift_tcb)
-              apply clarsimp
-              apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb"
-                       in rf_sr_sched_queue_relation)
-                apply clarsimp
-               apply clarsimp
-              apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL)
-               apply (simp add: valid_queues_valid_q)
-              apply (subgoal_tac
-                      "head_C (ksReadyQueues_' (globals x)
-                         .[cready_queues_index_to_C (tcbDomain tcb) (tcbPriority tcb)]) = NULL")
-               prefer 2
-               apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL; simp add: valid_queues_valid_q)
-              apply (subgoal_tac
-                       "end_C (ksReadyQueues_' (globals x)
-                          .[cready_queues_index_to_C (tcbDomain tcb) (tcbPriority tcb)]) = NULL")
-               prefer 2
-               apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL[symmetric]; simp add: valid_queues_valid_q)
-              apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                        unat_trans_ucast_helper\<close>)
-              apply (frule maxDomain_le_unat_ucast_explicit)
-              apply (clarsimp simp: cready_queues_index_to_C_def numPriorities_def)
-              apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-              apply (simp add: t_hrs_ksReadyQueues_upd_absorb)
-
-              apply (rule conjI)
-               apply (clarsimp simp: l2BitmapSize_def' wordRadix_def c_invert_assist)
-              apply (subst rf_sr_drop_bitmaps_enqueue_helper, assumption)
-                apply (fastforce intro: cbitmap_L1_relation_bit_set)
-               apply (fastforce intro: cbitmap_L2_relation_bit_set simp: wordRadix_def mask_def)
-
-              apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb" in rf_sr_sched_queue_relation)
-                apply clarsimp
-               apply clarsimp
-              apply (drule_tac qhead'="tcb_ptr_to_ctcb_ptr t" and s=\<sigma> in tcbSchedEnqueue_update,
-                     simp_all add: valid_queues_valid_q)[1]
-               apply (rule tcb_at_not_NULL, erule obj_at'_weakenE, simp)
-              apply (erule(1) state_relation_queue_update_helper[where S="{t}"],
-                     (simp | rule globals.equality)+,
-                     simp_all add: cready_queues_index_to_C_def2 numPriorities_def
-                                   t_hrs_ksReadyQueues_upd_absorb upd_unless_null_def
-                                   typ_heap_simps)[1]
-               apply (fastforce simp: tcb_null_sched_ptrs_def typ_heap_simps c_guard_clift
-                                elim: obj_at'_weaken)+
-             apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                       unat_trans_ucast_helper\<close>)
-             apply clarsimp
-             apply (rule conjI; clarsimp simp: queue_in_range)
-              (* invalid, disagreement between C and Haskell on emptiness of queue *)
-              apply (drule (1) obj_at_cslift_tcb)
-              apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-              apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb" in rf_sr_sched_queue_relation)
-                apply clarsimp
-               apply clarsimp
-              apply (clarsimp simp: cready_queues_index_to_C_def numPriorities_def)
-              apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL)
-               apply (simp add: valid_queues_valid_q)
-              apply clarsimp
-              apply (drule tcb_queue_relation'_empty_ksReadyQueues; simp add: valid_queues_valid_q)
-             (* queue was not empty, add t to queue and leave bitmaps alone *)
-             apply (drule (1) obj_at_cslift_tcb)
-             apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-             apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb" in rf_sr_sched_queue_relation)
-               apply clarsimp
-              apply clarsimp
-             apply (clarsimp simp: cready_queues_index_to_C_def numPriorities_def)
-             apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL)
-              apply (simp add: valid_queues_valid_q)
-             apply clarsimp
-             apply (frule_tac t=\<sigma> in tcb_queue_relation_qhead_mem')
-              apply (simp add: valid_queues_valid_q)
-             apply (frule(1) tcb_queue_relation_qhead_valid')
-              apply (simp add: valid_queues_valid_q)
-             apply (clarsimp simp: typ_heap_simps h_t_valid_clift_Some_iff numPriorities_def
-                                   cready_queues_index_to_C_def2)
-             apply (drule_tac qhead'="tcb_ptr_to_ctcb_ptr t" and s=\<sigma> in tcbSchedEnqueue_update,
-                    simp_all add: valid_queues_valid_q)[1]
+          apply (simp add: when_def unless_def del: Collect_const split del: if_split)
+          apply (rule ccorres_cond[where R=\<top>])
+            apply (simp add: to_bool_def)
+           apply (rule ccorres_rhs_assoc)+
+           apply csymbr
+           apply csymbr
+           apply csymbr
+           apply csymbr
+           apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="dom_'" in ccorres_split_nothrow)
+               apply (rule threadGet_vcg_corres)
+               apply (rule allI, rule conseqPre, vcg)
                apply clarsimp
-
-              apply (rule tcb_at_not_NULL, erule obj_at'_weakenE, simp)
-             apply (frule(2) obj_at_cslift_tcb[OF valid_queues_obj_at'D])
-             apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-             apply (erule_tac S="{t, v}" for v in state_relation_queue_update_helper,
-                    (simp | rule globals.equality)+,
-                    simp_all add: typ_heap_simps if_Some_helper numPriorities_def
-                                  cready_queues_index_to_C_def2 upd_unless_null_def
-                             del: fun_upd_restrict_conv
-                             cong: if_cong
-                             split del: if_split)[1]
-                apply simp
-                apply (rule conjI)
+               apply (drule obj_at_ko_at', clarsimp)
+               apply (drule spec, drule(1) mp, clarsimp)
+               apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+              apply ceqv
+             apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="prio_'" in ccorres_split_nothrow)
+                 apply (rule threadGet_vcg_corres)
+                 apply (rule allI, rule conseqPre, vcg)
                  apply clarsimp
-                 apply (drule_tac s="tcb_ptr_to_ctcb_ptr t" in sym, simp)
-                apply (clarsimp simp add: fun_upd_twist)
-               prefer 3
-               apply (simp add: obj_at'_weakenE[OF _ TrueI])
-               apply (rule disjI1, erule (1) valid_queues_obj_at'D)
-              apply clarsimp
-             apply (fastforce simp: tcb_null_sched_ptrs_def)
-            apply (simp add: typ_heap_simps c_guard_clift)
-            apply (simp add: guard_is_UNIV_def)
-           apply simp
-           apply (wp threadGet_wp)
-          apply vcg
-         apply simp
-         apply (wp threadGet_wp)
-        apply vcg
-       apply (rule ccorres_return_Skip)
-      apply simp
-      apply (wp threadGet_wp)
-     apply vcg
-    apply (fastforce simp: valid_objs'_def obj_at'_def ran_def projectKOs typ_at'_def
-                           valid_obj'_def inQ_def
-                    dest!: valid_queues_obj_at'D)
-  done
+                 apply (drule obj_at_ko_at', clarsimp)
+                 apply (drule spec, drule(1) mp, clarsimp)
+                 apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+                apply ceqv
+               apply (rule ccorres_rhs_assoc2)+
+               apply (simp only: bind_assoc[symmetric])
+               apply (rule ccorres_split_nothrow_novcg_dc)
+                  prefer 2
+                  apply (rule ccorres_move_c_guard_tcb)
+                  apply (simp only: dc_def[symmetric])
+                  apply ctac
+                 apply (rule ccorres_rhs_assoc)+
+                 apply (rule ccorres_symb_exec_r)
+                   apply (rule ccorres_Guard_Seq)
+                   apply (simp add: bind_assoc)
+                   apply (ctac add: getQueue_ccorres)
+                     apply (rename_tac queue cqueue)
+                     apply (rule_tac xf'=ret__unsigned_long_'
+                                 and val="from_bool (tcbQueueEmpty queue)"
+                                 and R="\<lambda>s. \<not> tcbQueueEmpty queue \<longrightarrow> tcb_at' (the (tcbQueueHead queue)) s
+                                            \<and> (tcbQueueHead queue \<noteq> None \<longleftrightarrow> tcbQueueEnd queue \<noteq> None)"
+                                 and R'="{s'. queue_' s' = cqueue}"
+                                  in ccorres_symb_exec_r_known_rv)
+                        apply (rule conseqPre, vcg)
+                        apply (fastforce dest: tcb_at_not_NULL
+                                         simp: ctcb_queue_relation_def option_to_ctcb_ptr_def
+                                               tcbQueueEmpty_def)
+                       apply ceqv
+                      apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                          apply (rule ccorres_cond[where R=\<top>])
+                            apply fastforce
+                           apply (ctac add: addToBitmap_ccorres)
+                          apply (rule ccorres_return_Skip)
+                         apply ceqv
+                        apply (ctac add: tcb_queue_prepend_ccorres)
+                          apply (rule ccorres_Guard)
+                          apply (rule setQueue_ccorres)
+                          apply fastforce
+                         apply wpsimp
+                        apply (vcg exspec=tcb_queue_prepend_modifies)
+                       apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift')
+                      apply (vcg exspec=addToBitmap_modifies)
+                     apply vcg
+                    apply wpsimp
+                   apply vcg
+                  apply clarsimp
+                  apply vcg
+                 apply (rule conseqPre, vcg)
+                 apply clarsimp
+                apply wpsimp
+               apply (clarsimp simp: guard_is_UNIV_def)
+              apply (wpsimp wp: threadGet_wp)
+             apply vcg
+            apply clarsimp
+            apply (wpsimp wp: threadGet_wp)
+           apply vcg
+          apply (rule ccorres_return_Skip)
+         apply (wpsimp wp: threadGet_wp)
+        apply (vcg expsec=thread_state_get_tcbQueued_modifies)
+       apply wpsimp
+      apply (wpsimp wp: isRunnable_wp)
+     apply wpsimp
+    apply normalise_obj_at'
+    apply (rename_tac tcb)
+    apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+    apply (clarsimp simp: valid_tcb'_def)
+    apply (frule (1) obj_at_cslift_tcb)
+    apply (rule conjI)
+     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
+     apply (frule (3) obj_at'_tcbQueueHead_ksReadyQueues)
+     apply (force dest!: tcbQueueHead_iff_tcbQueueEnd simp: tcbQueueEmpty_def obj_at'_def)
+    apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+    apply (rule conjI)
+     apply (clarsimp simp: maxDomain_def)
+    apply (cut_tac qdom="tcbDomain tcb" and prio="tcbPriority tcb"
+                in cready_queues_index_to_C_in_range)
+      apply fastforce
+     apply fastforce
+    apply (clarsimp simp: word_less_nat_alt cready_queues_index_to_C_def2)
+    done
 qed
 
-lemmas tcbSchedDequeue_update
-    = tcbDequeue_update[where tn=tcbSchedNext_C and tn_update=tcbSchedNext_C_update
-                          and tp'=tcbSchedPrev_C and tp_update=tcbSchedPrev_C_update,
-                        simplified]
-
-lemma tcb_queue_relation_prev_next:
-  "\<lbrakk> tcb_queue_relation tn tp' mp queue qprev qhead;
-     tcbp \<in> set queue; distinct (ctcb_ptr_to_tcb_ptr qprev # queue);
-     \<forall>t \<in> set queue. tcb_at' t s; qprev \<noteq> tcb_Ptr 0 \<longrightarrow> mp qprev \<noteq> None;
-     mp (tcb_ptr_to_ctcb_ptr tcbp) = Some tcb \<rbrakk>
-      \<Longrightarrow> (tn tcb \<noteq> tcb_Ptr 0 \<longrightarrow> tn tcb \<in> tcb_ptr_to_ctcb_ptr ` set queue
-                       \<and> mp (tn tcb) \<noteq> None \<and> tn tcb \<noteq> tcb_ptr_to_ctcb_ptr tcbp)
-        \<and> (tp' tcb \<noteq> tcb_Ptr 0 \<longrightarrow> (tp' tcb \<in> tcb_ptr_to_ctcb_ptr ` set queue
-                                         \<or> tp' tcb = qprev)
-                       \<and> mp (tp' tcb) \<noteq> None \<and> tp' tcb \<noteq> tcb_ptr_to_ctcb_ptr tcbp)
-        \<and> (tn tcb \<noteq> tcb_Ptr 0 \<longrightarrow> tn tcb \<noteq> tp' tcb)"
-  apply (induct queue arbitrary: qprev qhead)
-   apply simp
-  apply simp
-  apply (erule disjE)
-   apply clarsimp
-   apply (case_tac "queue")
-    apply clarsimp
-   apply clarsimp
-   apply (rule conjI)
-    apply clarsimp
-   apply clarsimp
-   apply (drule_tac f=ctcb_ptr_to_tcb_ptr in arg_cong[where y="tp' tcb"], simp)
-  apply clarsimp
-  apply fastforce
-  done
+lemma tcbSchedAppend_ccorres:
+  "ccorres dc xfdc
+     (tcb_at' t and valid_objs' and pspace_aligned' and pspace_distinct')
+     \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace> hs
+     (tcbSchedAppend t) (Call tcbSchedAppend_'proc)"
+proof -
+  note prio_and_dom_limit_helpers[simp] word_sle_def[simp] maxDom_to_H[simp] maxPrio_to_H[simp]
+  note invert_prioToL1Index_c_simp[simp]
 
-lemma tcb_queue_relation_prev_next':
-  "\<lbrakk> tcb_queue_relation' tn tp' mp queue qhead qend; tcbp \<in> set queue; distinct queue;
-       \<forall>t \<in> set queue. tcb_at' t s; mp (tcb_ptr_to_ctcb_ptr tcbp) = Some tcb \<rbrakk>
-      \<Longrightarrow> (tn tcb \<noteq> tcb_Ptr 0 \<longrightarrow> tn tcb \<in> tcb_ptr_to_ctcb_ptr ` set queue
-                       \<and> mp (tn tcb) \<noteq> None \<and> tn tcb \<noteq> tcb_ptr_to_ctcb_ptr tcbp)
-        \<and> (tp' tcb \<noteq> tcb_Ptr 0 \<longrightarrow> tp' tcb \<in> tcb_ptr_to_ctcb_ptr ` set queue
-                       \<and> mp (tp' tcb) \<noteq> None \<and> tp' tcb \<noteq> tcb_ptr_to_ctcb_ptr tcbp)
-        \<and> (tn tcb \<noteq> tcb_Ptr 0 \<longrightarrow> tn tcb \<noteq> tp' tcb)"
-  apply (clarsimp simp: tcb_queue_relation'_def split: if_split_asm)
-  apply (drule(1) tcb_queue_relation_prev_next, simp_all)
-   apply (fastforce dest: tcb_at_not_NULL)
-  apply clarsimp
-  done
+  (* when numDomains = 1, array bounds checks would become _ = 0 rather than _ < 1, changing the
+     shape of the proof compared to when numDomains > 1 *)
+  note word_less_1[simp del]
 
-(* L1 bitmap only updated if L2 entry bits end up all zero *)
-lemma rf_sr_drop_bitmaps_dequeue_helper_L2:
-  "\<lbrakk> (\<sigma>,\<sigma>') \<in> rf_sr ;
-     cbitmap_L2_relation ksqL2upd' ksqL2upd \<rbrakk>
-   \<Longrightarrow>
-((\<sigma>\<lparr>ksReadyQueues := ksqupd,
-   ksReadyQueuesL2Bitmap := ksqL2upd\<rparr>,
- \<sigma>'\<lparr>idx_' := i',
-   queue_' := queue_upd',
-   globals := globals \<sigma>'
-     \<lparr>ksReadyQueuesL2Bitmap_' := ksqL2upd',
-      ksReadyQueues_' := ksqupd'\<rparr>\<rparr>)
-         \<in> rf_sr)
- =
-((\<sigma>\<lparr>ksReadyQueues := ksqupd\<rparr>,
- \<sigma>'\<lparr>idx_' := i',
-   queue_' := queue_upd',
-   globals := globals \<sigma>'
-     \<lparr>ksReadyQueues_' := ksqupd'\<rparr>\<rparr>) \<in> rf_sr)
-"
-  unfolding rf_sr_def cstate_relation_def Let_def
-             carch_state_relation_def cmachine_state_relation_def
-  by (clarsimp simp: rf_sr_cbitmap_L1_relation rf_sr_cbitmap_L2_relation)
-
-lemma rf_sr_drop_bitmaps_dequeue_helper:
-  "\<lbrakk> (\<sigma>,\<sigma>') \<in> rf_sr ;
-     cbitmap_L1_relation ksqL1upd' ksqL1upd ; cbitmap_L2_relation ksqL2upd' ksqL2upd \<rbrakk>
-   \<Longrightarrow>
-((\<sigma>\<lparr>ksReadyQueues := ksqupd,
-   ksReadyQueuesL2Bitmap := ksqL2upd,
-   ksReadyQueuesL1Bitmap := ksqL1upd\<rparr>,
- \<sigma>'\<lparr>idx_' := i',
-   queue_' := queue_upd',
-   globals := globals \<sigma>'
-     \<lparr>ksReadyQueuesL2Bitmap_' := ksqL2upd',
-      ksReadyQueuesL1Bitmap_' := ksqL1upd',
-      ksReadyQueues_' := ksqupd'\<rparr>\<rparr>)
-         \<in> rf_sr)
- =
-((\<sigma>\<lparr>ksReadyQueues := ksqupd\<rparr>,
- \<sigma>'\<lparr>idx_' := i',
-   queue_' := queue_upd',
-   globals := globals \<sigma>'
-     \<lparr>ksReadyQueues_' := ksqupd'\<rparr>\<rparr>) \<in> rf_sr)
-"
-  unfolding rf_sr_def cstate_relation_def Let_def
-             carch_state_relation_def cmachine_state_relation_def
-  by (clarsimp simp: rf_sr_cbitmap_L1_relation rf_sr_cbitmap_L2_relation)
+  show ?thesis
+    apply (cinit lift: tcb_')
+     apply (rule ccorres_stateAssert)+
+     apply (rule ccorres_symb_exec_l)
+        apply (rule ccorres_assert)
+        apply (thin_tac "runnable")
+        apply (rule_tac r'="\<lambda>rv rv'. rv = to_bool rv'" and xf'="ret__unsigned_longlong_'"
+                     in ccorres_split_nothrow)
+            apply (rule threadGet_vcg_corres)
+            apply (rule allI, rule conseqPre, vcg)
+            apply clarsimp
+            apply (drule obj_at_ko_at', clarsimp)
+            apply (drule spec, drule(1) mp, clarsimp)
+            apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+           apply ceqv
+          apply (simp add: when_def unless_def del: Collect_const split del: if_split)
+          apply (rule ccorres_cond[where R=\<top>])
+            apply (simp add: to_bool_def)
+           apply (rule ccorres_rhs_assoc)+
+           apply csymbr
+           apply csymbr
+           apply csymbr
+           apply csymbr
+           apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="dom_'" in ccorres_split_nothrow)
+               apply (rule threadGet_vcg_corres)
+               apply (rule allI, rule conseqPre, vcg)
+               apply clarsimp
+               apply (drule obj_at_ko_at', clarsimp)
+               apply (drule spec, drule(1) mp, clarsimp)
+               apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+              apply ceqv
+             apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="prio_'" in ccorres_split_nothrow)
+                 apply (rule threadGet_vcg_corres)
+                 apply (rule allI, rule conseqPre, vcg)
+                 apply clarsimp
+                 apply (drule obj_at_ko_at', clarsimp)
+                 apply (drule spec, drule(1) mp, clarsimp)
+                 apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+                apply ceqv
+               apply (rule ccorres_rhs_assoc2)+
+               apply (simp only: bind_assoc[symmetric])
+               apply (rule ccorres_split_nothrow_novcg_dc)
+                  prefer 2
+                  apply (rule ccorres_move_c_guard_tcb)
+                  apply (simp only: dc_def[symmetric])
+                  apply ctac
+                 apply (rule ccorres_rhs_assoc)+
+                 apply (rule ccorres_symb_exec_r)
+                   apply (rule ccorres_Guard_Seq)
+                   apply (simp add: bind_assoc)
+                   apply (ctac add: getQueue_ccorres)
+                     apply (rename_tac queue cqueue)
+                     apply (rule_tac xf'=ret__unsigned_long_'
+                                 and val="from_bool (tcbQueueEmpty queue)"
+                                 and R="\<lambda>s. \<not> tcbQueueEmpty queue \<longrightarrow> tcb_at' (the (tcbQueueHead queue)) s
+                                            \<and> (tcbQueueHead queue \<noteq> None \<longleftrightarrow> tcbQueueEnd queue \<noteq> None)"
+                                 and R'="{s'. queue_' s' = cqueue}"
+                                  in ccorres_symb_exec_r_known_rv)
+                        apply (rule conseqPre, vcg)
+                        apply (fastforce dest: tcb_at_not_NULL
+                                         simp: ctcb_queue_relation_def option_to_ctcb_ptr_def
+                                               tcbQueueEmpty_def)
+                       apply ceqv
+                      apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                          apply (rule ccorres_cond[where R=\<top>])
+                            apply (fastforce dest!: tcb_at_not_NULL
+                                              simp: ctcb_queue_relation_def option_to_ctcb_ptr_def)
+                           apply (ctac add: addToBitmap_ccorres)
+                          apply (rule ccorres_return_Skip)
+                         apply ceqv
+                        apply (ctac add: tcb_queue_append_ccorres)
+                          apply (rule ccorres_Guard)
+                          apply (rule setQueue_ccorres)
+                          apply fastforce
+                         apply wpsimp
+                        apply (vcg exspec=tcb_queue_prepend_modifies)
+                       apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift')
+                      apply (vcg exspec=addToBitmap_modifies)
+                     apply vcg
+                    apply wpsimp
+                   apply vcg
+                  apply clarsimp
+                  apply vcg
+                 apply (rule conseqPre, vcg)
+                 apply clarsimp
+                apply wpsimp
+               apply (clarsimp simp: guard_is_UNIV_def)
+              apply (wpsimp wp: threadGet_wp)
+             apply vcg
+            apply clarsimp
+            apply (wpsimp wp: threadGet_wp)
+           apply clarsimp
+           apply vcg
+          apply (rule ccorres_return_Skip)
+         apply (wpsimp wp: threadGet_wp)
+        apply (vcg expsec=thread_state_get_tcbQueued_modifies)
+       apply wpsimp
+      apply (wpsimp wp: isRunnable_wp)
+     apply wpsimp
+    apply normalise_obj_at'
+    apply (rename_tac tcb)
+    apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+    apply (clarsimp simp: valid_tcb'_def)
+    apply (frule (1) obj_at_cslift_tcb)
+    apply (rule conjI)
+     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
+     apply (frule (3) obj_at'_tcbQueueHead_ksReadyQueues)
+     apply (frule (3) obj_at'_tcbQueueEnd_ksReadyQueues)
+     apply (force dest!: tcbQueueHead_iff_tcbQueueEnd simp: tcbQueueEmpty_def obj_at'_def)
+    apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+    apply (rule conjI)
+     apply (clarsimp simp: maxDomain_def)
+    apply (cut_tac qdom="tcbDomain tcb" and prio="tcbPriority tcb"
+                in cready_queues_index_to_C_in_range)
+      apply fastforce
+     apply fastforce
+    apply (clarsimp simp: word_less_nat_alt cready_queues_index_to_C_def2 tcbQueueEmpty_def)
+    done
+qed
 
 (* FIXME same proofs as bit_set, maybe can generalise? *)
 lemma cbitmap_L1_relation_bit_clear:
@@ -1280,27 +1140,6 @@ lemma cbitmap_L1_relation_bit_clear:
                      invertL1Index_def l2BitmapSize_def'
                      le_maxDomain_eq_less_numDomains word_le_nat_alt num_domains_index_updates)
 
-lemma cready_queues_relation_empty_queue_helper:
-  "\<lbrakk> tcbDomain ko \<le> maxDomain ; tcbPriority ko \<le> maxPriority ;
-     cready_queues_relation (cslift \<sigma>') (ksReadyQueues_' (globals \<sigma>')) (ksReadyQueues \<sigma>)\<rbrakk>
-   \<Longrightarrow>
-   cready_queues_relation (cslift \<sigma>')
-          (Arrays.update (ksReadyQueues_' (globals \<sigma>')) (unat (tcbDomain ko) * 256 + unat (tcbPriority ko))
-            (tcb_queue_C.end_C_update (\<lambda>_. NULL)
-              (head_C_update (\<lambda>_. NULL)
-                (ksReadyQueues_' (globals \<sigma>').[unat (tcbDomain ko) * 256 + unat (tcbPriority ko)]))))
-          ((ksReadyQueues \<sigma>)((tcbDomain ko, tcbPriority ko) := []))"
-  unfolding cready_queues_relation_def Let_def
-  using maxPrio_to_H[simp] maxDom_to_H[simp]
-  apply clarsimp
-  apply (frule (1) cready_queues_index_to_C_in_range[simplified maxDom_to_H maxPrio_to_H])
-  apply (fold cready_queues_index_to_C_def[simplified numPriorities_def])
-  apply (case_tac "qdom = tcbDomain ko",
-          simp_all add: prio_and_dom_limit_helpers seL4_MinPrio_def
-                        minDom_def)
-   apply (fastforce simp: cready_queues_index_to_C_in_range simp: cready_queues_index_to_C_distinct)+
-  done
-
 lemma cbitmap_L2_relationD:
   "\<lbrakk> cbitmap_L2_relation cbitmap2 abitmap2 ; d \<le> maxDomain ; i < l2BitmapSize \<rbrakk> \<Longrightarrow>
     cbitmap2.[unat d].[i] = abitmap2 (d, i)"
@@ -1330,465 +1169,301 @@ lemma cbitmap_L2_relation_bit_clear:
   apply (case_tac "da = d" ; clarsimp simp: num_domains_index_updates)
   done
 
-lemma tcbSchedDequeue_ccorres':
+lemma removeFromBitmap_ccorres:
   "ccorres dc xfdc
-           ((\<lambda>s. \<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s)
-                     \<and> distinct (ksReadyQueues s (d, p)))
-             and valid_queues' and tcb_at' t and valid_objs')
-           (UNIV \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace>)
-           []
-           (tcbSchedDequeue t)
-           (Call tcbSchedDequeue_'proc)"
+     (K (tdom \<le> maxDomain \<and> prio \<le> maxPriority)) (\<lbrace>\<acute>dom = ucast tdom\<rbrace> \<inter> \<lbrace>\<acute>prio = ucast prio\<rbrace>) hs
+     (removeFromBitmap tdom prio) (Call removeFromBitmap_'proc)"
 proof -
-
   note prio_and_dom_limit_helpers[simp] word_sle_def[simp]
 
   (* when numDomains = 1, array bounds checks would become _ = 0 rather than _ < 1, changing the
      shape of the proof compared to when numDomains > 1 *)
   include no_less_1_simps
 
-  have ksQ_tcb_at': "\<And>s ko d p.
-    \<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s)
-                                          \<and> distinct (ksReadyQueues s (d, p)) \<Longrightarrow>
-    \<forall>t\<in>set (ksReadyQueues s (d, p)). tcb_at' t s"
-    by (fastforce dest: spec elim: obj_at'_weakenE)
-
-  have invert_l1_index_limit: "\<And>p. invertL1Index (prioToL1Index p) < 4"
+  have invert_l1_index_limit: "\<And>p. invertL1Index (prioToL1Index p) < l2BitmapSize"
     unfolding invertL1Index_def l2BitmapSize_def' prioToL1Index_def
     by simp
 
   show ?thesis
-  apply (cinit lift: tcb_')
-   apply (rule_tac r'="\<lambda>rv rv'. rv = to_bool rv'" and xf'="ret__unsigned_longlong_'"
-            in ccorres_split_nothrow)
-       apply (rule threadGet_vcg_corres)
-       apply (rule allI, rule conseqPre, vcg)
-       apply clarsimp
-       apply (drule obj_at_ko_at', clarsimp)
-       apply (drule spec, drule(1) mp, clarsimp)
-       apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-      apply ceqv
-     apply (simp add: when_def del: Collect_const split del: if_split)
-     apply (rule ccorres_cond[where R=\<top>])
-       apply (simp add: to_bool_def)
-      apply (rule ccorres_rhs_assoc)+
-      apply csymbr
-      apply csymbr
-      apply csymbr
-      apply csymbr
-      apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="dom_'" in ccorres_split_nothrow)
-          apply (rule threadGet_vcg_corres)
+    supply if_split[split del]
+    (* pull out static assms *)
+    apply simp
+    apply (rule ccorres_grab_asm[where P=\<top>, simplified])
+    apply (cinit lift: dom_' prio_')
+     apply clarsimp
+     apply csymbr
+     apply csymbr
+     (* we can clear up all C guards now *)
+     apply (clarsimp simp: maxDomain_le_unat_ucast_explicit word_and_less')
+     apply (simp add: invert_prioToL1Index_c_simp word_less_nat_alt)
+     apply (simp add: invert_l1_index_limit[simplified l2BitmapSize_def'])
+     apply ccorres_rewrite
+     (* handle L2 update *)
+     apply (rule_tac ccorres_split_nothrow_novcg_dc)
+        apply (rule_tac P=\<top> and P'=UNIV in ccorres_from_vcg)
+        apply (rule allI, rule conseqPre, vcg)
+        apply (clarsimp simp: simpler_gets_def get_def modify_def
+                              put_def bind_def return_def bitmap_fun_defs)
+        apply (frule rf_sr_cbitmap_L2_relation)
+        apply (erule cbitmap_L2_relation_update)
+        apply (erule (1) cbitmap_L2_relation_bit_clear)
+       (* the check on the C side is identical to checking the L2 entry, rewrite the condition *)
+       apply (simp add: getReadyQueuesL2Bitmap_def)
+       apply (rule ccorres_symb_exec_l3, rename_tac l2)
+          apply (rule_tac C'="{s. l2 = 0}"
+                      and Q="\<lambda>s. l2 = ksReadyQueuesL2Bitmap s (tdom, invertL1Index (prioToL1Index prio))"
+                   in ccorres_rewrite_cond_sr[where Q'=UNIV])
+           apply clarsimp
+           apply (frule rf_sr_cbitmap_L2_relation)
+           apply (clarsimp simp: cbitmap_L2_relationD invert_l1_index_limit split: if_split)
+          (* unset L1 bit when L2 entry is empty *)
+          apply (rule ccorres_from_vcg[where P=\<top> and P'=UNIV])
           apply (rule allI, rule conseqPre, vcg)
-          apply clarsimp
-          apply (drule obj_at_ko_at', clarsimp)
-          apply (drule spec, drule(1) mp, clarsimp)
-          apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-         apply ceqv
-        apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="prio_'" in ccorres_split_nothrow)
-            apply (rule threadGet_vcg_corres)
-            apply (rule allI, rule conseqPre, vcg)
-            apply clarsimp
-            apply (drule obj_at_ko_at', clarsimp)
-            apply (drule spec, drule(1) mp, clarsimp)
-            apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+          apply (clarsimp simp: simpler_gets_def get_def modify_def
+                                put_def bind_def return_def bitmap_fun_defs)
+          apply (frule rf_sr_cbitmap_L1_relation)
+          apply (erule cbitmap_L1_relation_update)
+          apply (erule (1) cbitmap_L1_relation_bit_clear)
+         apply wpsimp+
+     apply (fastforce simp: guard_is_UNIV_def)
+    apply clarsimp
+    done
+qed
+
+lemma ctcb_ptr_to_tcb_ptr_option_to_ctcb_ptr[simp]:
+  "ctcb_ptr_to_tcb_ptr (option_to_ctcb_ptr (Some ptr)) = ptr"
+  by (clarsimp simp: option_to_ctcb_ptr_def)
+
+lemma tcb_queue_remove_ccorres:
+  "ccorres ctcb_queue_relation ret__struct_tcb_queue_C_'
+     (\<lambda>s. tcb_at' tcbPtr s \<and> valid_objs' s
+          \<and> (tcbQueueHead queue \<noteq> None \<longleftrightarrow> tcbQueueEnd queue \<noteq> None))
+     (\<lbrace>ctcb_queue_relation queue \<acute>queue\<rbrace> \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr tcbPtr\<rbrace>) hs
+     (tcbQueueRemove queue tcbPtr) (Call tcb_queue_remove_'proc)"
+  (is "ccorres _ _ ?abs _ _ _ _")
+  supply if_split[split del]
+  apply (cinit' lift: tcb_')
+   apply (rename_tac tcb')
+   apply (simp only: tcbQueueRemove_def)
+    \<comment> \<open>cinit is not able to lift queue_' because queue_' is later modified in the C program\<close>
+   apply (rule_tac xf'=queue_' in ccorres_abstract, ceqv, rename_tac cqueue)
+   apply (rule_tac P="ctcb_queue_relation queue cqueue" in ccorres_gen_asm2)
+   apply (rule ccorres_pre_getObject_tcb, rename_tac tcb)
+   apply (rule ccorres_symb_exec_l, rename_tac beforePtrOpt)
+      apply (rule ccorres_symb_exec_l, rename_tac afterPtrOpt)
+         apply (rule ccorres_move_c_guard_tcb)
+         apply (rule_tac xf'="before___ptr_to_struct_tcb_C_'"
+                     and val="option_to_ctcb_ptr beforePtrOpt"
+                     and R="ko_at' tcb tcbPtr and K (tcbSchedPrev tcb = beforePtrOpt)"
+                     and R'=UNIV
+                      in ccorres_symb_exec_r_known_rv)
+            apply (rule conseqPre, vcg)
+            apply (fastforce dest: obj_at_cslift_tcb simp: typ_heap_simps ctcb_relation_def)
            apply ceqv
-          apply (rule ccorres_rhs_assoc2)+
-          apply (simp only: bind_assoc[symmetric])
-          apply (rule ccorres_split_nothrow_novcg_dc)
-             prefer 2
-             apply (rule ccorres_move_c_guard_tcb)
-             apply ctac
-            prefer 2
-            apply (wp, clarsimp, wp+)
-           apply (rule_tac P="(\<lambda>s. \<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s)
-                                         \<and> distinct(ksReadyQueues s (d, p)))
-                                and valid_queues' and obj_at' (inQ rva rvb) t
-                                and (\<lambda>s. rva \<le> maxDomain \<and> rvb \<le> maxPriority)"
-                       and P'=UNIV in ccorres_from_vcg)
-           apply (rule allI, rule conseqPre, vcg)
-           apply (clarsimp simp: getQueue_def gets_def get_def setQueue_def modify_def
-                                 put_def bind_def return_def bitmap_fun_defs when_def
-                                 null_def)
-
-           apply (rule conjI; clarsimp simp: queue_in_range[simplified maxDom_to_H maxPrio_to_H])
-            apply (rule conjI; clarsimp simp: queue_in_range[simplified maxDom_to_H maxPrio_to_H])
-             apply (frule(1) valid_queuesD')
-             apply (drule (1) obj_at_cslift_tcb, clarsimp simp: inQ_def)
-             apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko" in rf_sr_sched_queue_relation)
-               apply (fastforce simp: maxDom_to_H maxPrio_to_H)+
-             apply (frule_tac s=\<sigma> in tcb_queue_relation_prev_next'; (fastforce simp: ksQ_tcb_at')?)
-             apply (drule_tac s=\<sigma> in tcbSchedDequeue_update, assumption,
-                    simp_all add: remove1_filter ksQ_tcb_at')[1]
-             apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                       unat_trans_ucast_helper\<close>)
-             apply (clarsimp simp: maxDomain_le_unat_ucast_explicit)
-             apply (intro conjI;
-                    clarsimp simp: h_val_field_clift'
-                                   h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)+
-               apply (drule(2) filter_empty_unfiltered_contr, simp)+
-             apply (rule conjI; clarsimp)
-              apply (rule conjI)
-               apply (fastforce simp: c_invert_assist l2BitmapSize_def' wordRadix_def)
-              apply (rule conjI; clarsimp)
-               apply (subst rf_sr_drop_bitmaps_dequeue_helper, assumption)
-                 apply (fastforce intro: cbitmap_L1_relation_bit_clear)
-                apply (simp add: invert_prioToL1Index_c_simp)
-                apply (frule rf_sr_cbitmap_L2_relation)
-                apply (clarsimp simp: cbitmap_L2_relation_def
-                                      word_size prioToL1Index_def wordRadix_def mask_def
-                                      word_le_nat_alt
-                                      numPriorities_def wordBits_def l2BitmapSize_def'
-                                      invertL1Index_def numDomains_less_numeric_explicit)
-                apply (case_tac "d = tcbDomain ko"
-                       ; fastforce simp: le_maxDomain_eq_less_numDomains
-                                         numDomains_less_numeric_explicit)
-               apply (drule (1) obj_at_cslift_tcb, clarsimp simp: inQ_def)
-               apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko"
-                        in rf_sr_sched_queue_relation)
-                 apply (fold_subgoals (prefix))[2]
-                subgoal premises prems using prems by (fastforce simp: maxDom_to_H maxPrio_to_H)+
-
-               apply (frule_tac s=\<sigma> in tcb_queue_relation_prev_next', assumption)
-                  prefer 3
-                  apply fastforce
-                 apply (fold_subgoals (prefix))[2]
-                subgoal premises prems using prems by ((fastforce simp: ksQ_tcb_at')+)
-               apply (drule_tac s=\<sigma> in tcbSchedDequeue_update, assumption,
-                      simp_all add: remove1_filter ksQ_tcb_at')[1]
-               (* trivial case, setting queue to empty *)
-               apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def carch_state_relation_def
-                                     cmachine_state_relation_def)
-               apply (erule (2) cready_queues_relation_empty_queue_helper)
-              (* impossible case, C L2 update disagrees with Haskell update *)
-              apply (simp add: invert_prioToL1Index_c_simp)
-              apply (subst (asm) num_domains_index_updates)
-               subgoal by (simp add: le_maxDomain_eq_less_numDomains word_le_nat_alt)
-              apply (subst (asm) Arrays.index_update)
-               apply (simp add: invert_l1_index_limit)
-
-              apply (frule rf_sr_cbitmap_L2_relation)
-              apply (drule_tac i="invertL1Index (prioToL1Index (tcbPriority ko))"
-                       in cbitmap_L2_relationD, assumption)
-               apply (fastforce simp: l2BitmapSize_def' invert_l1_index_limit)
-              apply (fastforce simp: prioToL1Index_def invertL1Index_def mask_def wordRadix_def)
-             (* impossible case *)
-             apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-             apply (drule(2) filter_empty_unfiltered_contr, fastforce)
-
-            apply (frule (1) valid_queuesD')
-            apply (drule (1) obj_at_cslift_tcb, clarsimp simp: inQ_def)
-            apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko"
-                     in rf_sr_sched_queue_relation)
-              apply fold_subgoals[2]
-              apply (fastforce simp: maxDom_to_H maxPrio_to_H)+
-            apply (clarsimp simp: h_val_field_clift'
-                                  h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)
-            apply (frule_tac s=\<sigma> in tcb_queue_relation_prev_next', assumption)
-               prefer 3
-               apply fastforce
-              apply (fold_subgoals (prefix))[2]
-             subgoal premises prems using prems by (fastforce simp: ksQ_tcb_at')+
-            apply (drule_tac s=\<sigma> in tcbSchedDequeue_update, assumption,
-                   simp_all add: remove1_filter ksQ_tcb_at')[1]
-            apply (clarsimp simp:  filter_noteq_op upd_unless_null_def)
-            apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                      unat_trans_ucast_helper\<close>)
-            apply (clarsimp simp: maxDomain_le_unat_ucast_explicit)
-            apply (rule conjI, clarsimp)
-             apply (clarsimp simp: h_val_field_clift'
-                                   h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)
-             apply (rule conjI; clarsimp)
-              apply (simp add: typ_heap_simps)
-              apply (clarsimp simp: h_t_valid_c_guard [OF h_t_valid_field, OF h_t_valid_clift]
-                                    h_t_valid_field[OF h_t_valid_clift] h_t_valid_clift)
-              apply (erule_tac S="set (ksReadyQueues \<sigma> (tcbDomain ko, tcbPriority ko))"
-                       in state_relation_queue_update_helper',
-                     (simp | rule globals.equality)+,
-                     simp_all add: clift_field_update if_Some_helper numPriorities_def
-                                   cready_queues_index_to_C_def2 typ_heap_simps
-                                   maxDom_to_H maxPrio_to_H
-                             cong: if_cong split del: if_split)[1]
-
-               apply (fastforce simp: tcb_null_sched_ptrs_def typ_heap_simps c_guard_clift
-                                elim: obj_at'_weaken)+
-             apply (erule_tac S="set (ksReadyQueues \<sigma> (tcbDomain ko, tcbPriority ko))"
-                      in state_relation_queue_update_helper',
-                    (simp | rule globals.equality)+,
-                    simp_all add: clift_field_update if_Some_helper numPriorities_def
-                                  cready_queues_index_to_C_def2
-                                  maxDom_to_H maxPrio_to_H
-                            cong: if_cong split del: if_split,
-                    simp_all add: typ_heap_simps')[1]
-              subgoal by (fastforce simp: tcb_null_sched_ptrs_def)
-             subgoal by fastforce
+          apply (rule ccorres_move_c_guard_tcb)
+          apply (rule_tac xf'="after___ptr_to_struct_tcb_C_'"
+                      and val="option_to_ctcb_ptr afterPtrOpt"
+                      and R="ko_at' tcb tcbPtr and K (tcbSchedNext tcb = afterPtrOpt)"
+                       in ccorres_symb_exec_r_known_rv[where R'=UNIV])
+             apply (rule conseqPre, vcg)
+             apply (fastforce dest: obj_at_cslift_tcb simp: typ_heap_simps ctcb_relation_def)
+            apply ceqv
+           apply (rule ccorres_cond_seq)
+           apply (rule ccorres_cond[where R="?abs"])
+             apply (fastforce dest: tcb_at_not_NULL
+                              simp: ctcb_queue_relation_def option_to_ctcb_ptr_def)
+            apply (rule ccorres_rhs_assoc)+
+            apply csymbr
+            apply csymbr
+            apply (fastforce intro: ccorres_return_C')
+           apply (rule ccorres_cond_seq)
+           apply (rule_tac Q="?abs" and Q'=\<top> in ccorres_cond_both')
+             apply (fastforce dest: tcb_at_not_NULL
+                              simp: ctcb_queue_relation_def option_to_ctcb_ptr_def split: if_splits)
             apply clarsimp
-            apply (rule conjI; clarsimp)
-             apply (rule conjI)
-              apply (fastforce simp: c_invert_assist l2BitmapSize_def' wordRadix_def)
-             apply (rule conjI; clarsimp)
-              (* invalid, missing bitmap updates on haskell side *)
-              apply (fold_subgoals (prefix))[2]
-             subgoal premises prems using prems
-               by (fastforce dest!: tcb_queue_relation'_empty_ksReadyQueues
-                              elim: obj_at'_weaken)+
-            apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-            apply (erule_tac S="set (ksReadyQueues \<sigma> (tcbDomain ko, tcbPriority ko))"
-                     in state_relation_queue_update_helper',
-                   (simp | rule globals.equality)+,
-                   simp_all add: clift_field_update if_Some_helper numPriorities_def
-                                 cready_queues_index_to_C_def2
-                                 maxDom_to_H maxPrio_to_H
-                           cong: if_cong split del: if_split)[1]
-               apply (fold_subgoals (prefix))[4]
-            subgoal premises prems using prems
-              by - (fastforce simp: typ_heap_simps c_guard_clift tcb_null_sched_ptrs_def
-                                    clift_heap_update_same[OF h_t_valid_clift])+
-           apply (rule conjI; clarsimp simp: queue_in_range[simplified maxDom_to_H maxPrio_to_H])
-            apply (frule (1) valid_queuesD')
-            apply (drule (1) obj_at_cslift_tcb, clarsimp simp: inQ_def)
-            apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko"
-                     in rf_sr_sched_queue_relation)
-              apply (fold_subgoals (prefix))[2]
-             subgoal premises prems using prems by (fastforce simp: maxDom_to_H maxPrio_to_H)+
-            apply (clarsimp simp: h_val_field_clift'
-                                  h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)
-            apply (frule_tac s=\<sigma> in tcb_queue_relation_prev_next')
+            apply (rule ccorres_assert2)
+            apply (rule ccorres_rhs_assoc)+
+            apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                apply (rule ccorres_move_c_guard_tcb)+
+                apply (rule_tac P=\<top> and P'="tcb_at' tcbPtr"
+                            and Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb (the afterPtrOpt) s}"
+                             in threadSet_ccorres_lemma3)
+                 apply (rule conseqPre, vcg)
+                 apply clarsimp
+                 apply (frule (1) obj_at_cslift_tcb)
+                 apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                   simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                         tcb_cte_cases_def cteSizeBits_def)
                 apply fastforce
-               prefer 3
-               apply fastforce
-              apply (fold_subgoals (prefix))[2]
-             subgoal premises prems using prems by (fastforce simp: ksQ_tcb_at')+
-            apply (drule_tac s=\<sigma> in tcbSchedDequeue_update, assumption,
-                   simp_all add: remove1_filter ksQ_tcb_at')[1]
-            apply (clarsimp simp:  filter_noteq_op upd_unless_null_def)
-            apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                      unat_trans_ucast_helper\<close>)
-            apply (clarsimp simp: maxDomain_le_unat_ucast_explicit)
-            apply (rule conjI; clarsimp)
-             apply (clarsimp simp: h_val_field_clift'
-                                   h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)
-             apply (clarsimp simp: typ_heap_simps)
-             apply (rule conjI; clarsimp simp: typ_heap_simps)
-             apply (drule(2) filter_empty_unfiltered_contr[simplified filter_noteq_op], simp)
-            apply (rule conjI)
-             apply (fastforce simp: c_invert_assist l2BitmapSize_def' wordRadix_def)
-            apply (rule conjI; clarsimp)
-             (* impossible case, C L2 update disagrees with Haskell update *)
-             apply (subst (asm) num_domains_index_updates)
-              apply (simp add: le_maxDomain_eq_less_numDomains word_le_nat_alt)
-             apply (subst (asm) Arrays.index_update)
-              subgoal using invert_l1_index_limit
-                by (fastforce simp add: invert_prioToL1Index_c_simp intro: nat_Suc_less_le_imp)
-             apply (frule rf_sr_cbitmap_L2_relation)
-             apply (simp add: invert_prioToL1Index_c_simp)
-             apply (drule_tac i="invertL1Index (prioToL1Index (tcbPriority ko))"
-                      in cbitmap_L2_relationD, assumption)
-              subgoal by (simp add: invert_l1_index_limit l2BitmapSize_def')
-             apply (fastforce simp: prioToL1Index_def invertL1Index_def mask_def wordRadix_def)
-
-            apply (simp add: invert_prioToL1Index_c_simp)
-            apply (subst rf_sr_drop_bitmaps_dequeue_helper_L2, assumption)
-             subgoal by (fastforce dest: rf_sr_cbitmap_L2_relation elim!: cbitmap_L2_relation_bit_clear)
-
-            (* trivial case, setting queue to empty *)
-            apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def carch_state_relation_def
-                                  cmachine_state_relation_def)
-            apply (erule (2) cready_queues_relation_empty_queue_helper)
-
-           apply (frule (1) valid_queuesD')
-           apply (drule (1) obj_at_cslift_tcb, clarsimp simp: inQ_def)
-           apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko"
-                    in rf_sr_sched_queue_relation)
-             apply (fold_subgoals (prefix))[2]
-            subgoal premises prems using prems by (fastforce simp: maxDom_to_H maxPrio_to_H)+
-           apply (clarsimp simp: h_val_field_clift'
-                                 h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)
-           apply (simp add: invert_prioToL1Index_c_simp)
-           apply (frule_tac s=\<sigma> in tcb_queue_relation_prev_next')
-               apply (fastforce simp add: ksQ_tcb_at')+
-           apply (drule_tac s=\<sigma> in tcbSchedDequeue_update, assumption,
-                  simp_all add: remove1_filter ksQ_tcb_at')[1]
-           apply (clarsimp simp: filter_noteq_op upd_unless_null_def)
-           apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                     unat_trans_ucast_helper\<close>)
-           apply (clarsimp simp: maxDomain_le_unat_ucast_explicit)
-           apply (rule conjI, clarsimp)
-            apply (clarsimp simp: h_val_field_clift'
-                                  h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)
-            apply (clarsimp simp: typ_heap_simps)
-            apply (rule conjI; clarsimp simp: typ_heap_simps)
-             apply (erule_tac S="set (ksReadyQueues \<sigma> (tcbDomain ko, tcbPriority ko))"
-                      in state_relation_queue_update_helper',
-                    (simp | rule globals.equality)+,
-                    simp_all add: clift_field_update if_Some_helper numPriorities_def
-                                  cready_queues_index_to_C_def2
-                                  maxDom_to_H maxPrio_to_H
-                            cong: if_cong split del: if_split)[1]
-                apply (fastforce simp: tcb_null_sched_ptrs_def)
-               apply (clarsimp simp: typ_heap_simps)
-              apply (fastforce simp: typ_heap_simps)
-             apply (fastforce simp: tcb_null_sched_ptrs_def)
-            apply (erule_tac S="set (ksReadyQueues \<sigma> (tcbDomain ko, tcbPriority ko))"
-                     in state_relation_queue_update_helper',
-                   (simp | rule globals.equality)+,
-                   simp_all add: clift_field_update if_Some_helper numPriorities_def
-                                 cready_queues_index_to_C_def2
-                                 maxDom_to_H maxPrio_to_H
-                           cong: if_cong split del: if_split)[1]
-               apply (fold_subgoals (prefix))[4]
-            subgoal premises prems using prems
-              by - (fastforce simp: typ_heap_simps c_guard_clift tcb_null_sched_ptrs_def
-                                    clift_heap_update_same[OF h_t_valid_clift])+
-           apply (clarsimp)
-           apply (rule conjI; clarsimp simp: typ_heap_simps)
-            apply (rule conjI)
-             apply (fastforce simp: c_invert_assist l2BitmapSize_def' wordRadix_def)
-            apply (rule conjI; clarsimp)
-             (* invalid, missing bitmap updates on haskell side *)
-             apply (drule tcb_queue_relation'_empty_ksReadyQueues)
-              apply (fold_subgoals (prefix))[2]
-             subgoal premises prems using prems by (fastforce elim: obj_at'_weaken)+
-            (* invalid, missing bitmap updates on haskell side *)
-            apply (drule tcb_queue_relation'_empty_ksReadyQueues)
-             apply (fold_subgoals (prefix))[2]
-            subgoal premises prems using prems by (fastforce elim: obj_at'_weaken)+
-           apply (erule_tac S="set (ksReadyQueues \<sigma> (tcbDomain ko, tcbPriority ko))"
-                    in state_relation_queue_update_helper',
-                  (simp | rule globals.equality)+,
-                  simp_all add: clift_field_update if_Some_helper numPriorities_def
-                                cready_queues_index_to_C_def2 typ_heap_simps
-                                maxDom_to_H maxPrio_to_H
-                          cong: if_cong split del: if_split)[1]
-            apply (fold_subgoals (prefix))[2]
-           subgoal premises prems using prems
-            by (fastforce simp: typ_heap_simps c_guard_clift tcb_null_sched_ptrs_def)+
-          apply (simp add: guard_is_UNIV_def)
-         apply simp
-         apply (wp threadGet_wp)
-        apply vcg
-       apply simp
-       apply (wp threadGet_wp)
-      apply vcg
-     apply (rule ccorres_return_Skip)
-    apply simp
-    apply (wp threadGet_wp)
-   apply vcg
-  by (fastforce simp: valid_objs'_def obj_at'_def ran_def projectKOs typ_at'_def
-                      valid_obj'_def valid_tcb'_def inQ_def)
-qed
-
-lemma tcbSchedDequeue_ccorres:
-  "ccorres dc xfdc
-           (valid_queues and valid_queues' and tcb_at' t and valid_objs')
-           (UNIV \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace>)
-           []
-           (tcbSchedDequeue t)
-           (Call tcbSchedDequeue_'proc)"
-  apply (rule ccorres_guard_imp [OF tcbSchedDequeue_ccorres'])
-   apply (clarsimp simp: valid_queues_def valid_queues_no_bitmap_def)
-   apply (drule_tac x=d in spec)
-   apply (drule_tac x=p in spec)
-   apply (clarsimp)
-   apply (drule(1) bspec)
-   apply (erule obj_at'_weakenE)
-   apply (clarsimp)+
-  done
-
-lemma tcb_queue_relation_append:
-  "\<lbrakk> tcb_queue_relation tn tp' mp queue qprev qhead; queue \<noteq> [];
-     qend' \<notin> tcb_ptr_to_ctcb_ptr ` set queue; mp qend' = Some tcb;
-     queue = queue' @ [ctcb_ptr_to_tcb_ptr qend]; distinct queue;
-     \<forall>x \<in> set queue. tcb_ptr_to_ctcb_ptr x \<noteq> NULL; qend' \<noteq> NULL;
-     \<And>v f g. tn (tn_update f v) = f (tn v) \<and> tp' (tp_update g v) = g (tp' v)
-                \<and> tn (tp_update f v) = tn v \<and> tp' (tn_update g v) = tp' v \<rbrakk>
-    \<Longrightarrow> tcb_queue_relation tn tp'
-          (mp (qend \<mapsto> tn_update (\<lambda>_. qend') (the (mp qend)),
-               qend' \<mapsto> tn_update (\<lambda>_. NULL) (tp_update (\<lambda>_. qend) tcb)))
-          (queue @ [ctcb_ptr_to_tcb_ptr qend']) qprev qhead"
-  using [[hypsubst_thin = true]]
-  apply clarsimp
-  apply (induct queue' arbitrary: qprev qhead)
-   apply clarsimp
-  apply clarsimp
-  done
-
-lemma tcbSchedAppend_update:
-  assumes sr: "sched_queue_relation' mp queue qhead qend"
-  and     qh': "qend' \<notin> tcb_ptr_to_ctcb_ptr ` set queue"
-  and  cs_tcb: "mp qend' = Some tcb"
-  and valid_ep: "\<forall>t\<in>set queue. tcb_at' t s" "distinct queue"
-  and     qhN: "qend' \<noteq> NULL"
-  shows
-  "sched_queue_relation'
-            (upd_unless_null qend (tcbSchedNext_C_update (\<lambda>_. qend') (the (mp qend)))
-                (mp(qend' \<mapsto> tcb\<lparr>tcbSchedNext_C := NULL, tcbSchedPrev_C := qend\<rparr>)))
-            (queue @ [ctcb_ptr_to_tcb_ptr qend']) (if queue = [] then qend' else qhead) qend'"
-  using sr qh' valid_ep cs_tcb qhN
-  apply -
-  apply (rule rev_cases[where xs=queue])
-   apply (simp add: tcb_queue_relation'_def upd_unless_null_def)
-  apply (clarsimp simp: tcb_queue_relation'_def upd_unless_null_def tcb_at_not_NULL)
-  apply (drule_tac qend'=qend' and tn_update=tcbSchedNext_C_update
-             and tp_update=tcbSchedPrev_C_update and qend="tcb_ptr_to_ctcb_ptr y"
-             in tcb_queue_relation_append, simp_all)
-   apply (fastforce simp add: tcb_at_not_NULL)
-  apply (simp add: fun_upd_twist)
-  done
-
-lemma tcb_queue_relation_qend_mems:
-  "\<lbrakk> tcb_queue_relation' getNext getPrev mp queue qhead qend;
-     \<forall>x \<in> set queue. tcb_at' x s \<rbrakk>
-      \<Longrightarrow> (qend = NULL \<longrightarrow> queue = [])
-       \<and> (qend \<noteq> NULL \<longrightarrow> ctcb_ptr_to_tcb_ptr qend \<in> set queue)"
-  apply (clarsimp simp: tcb_queue_relation'_def)
-  apply (drule bspec, erule last_in_set)
-  apply (simp add: tcb_at_not_NULL)
+               apply ceqv
+              apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                  apply (rule ccorres_move_c_guard_tcb)
+                  apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb tcbPtr s}"
+                               in threadSet_ccorres_lemma3[where P=\<top> and P'=\<top>, simplified])
+                   apply (rule conseqPre, vcg)
+                   apply clarsimp
+                   apply (frule (1) obj_at_cslift_tcb[where thread=tcbPtr])
+                   apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                     simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                           tcb_cte_cases_def cteSizeBits_def)
+                  apply clarsimp
+                 apply ceqv
+                apply (rule ccorres_symb_exec_r)
+                  apply (fastforce intro: ccorres_return_C')
+                 apply vcg
+                apply (rule conseqPre, vcg)
+                apply clarsimp
+               apply wpsimp
+              apply vcg
+             apply wpsimp
+            apply vcg
+           apply (rule ccorres_cond_seq)
+           apply (rule_tac Q="?abs" and Q'=\<top> in ccorres_cond_both')
+             apply (fastforce dest: tcb_at_not_NULL
+                              simp: ctcb_queue_relation_def option_to_ctcb_ptr_def split: if_splits)
+            apply clarsimp
+            apply (rule ccorres_assert2)
+            apply (rule ccorres_rhs_assoc)+
+            apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                apply (rule ccorres_move_c_guard_tcb)+
+                apply (rule_tac P=\<top> and P'="tcb_at' tcbPtr"
+                            and Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb (the beforePtrOpt) s}"
+                             in threadSet_ccorres_lemma3)
+                 apply (rule conseqPre, vcg)
+                 apply clarsimp
+                 apply (frule (1) obj_at_cslift_tcb)
+                 apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                   simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                         tcb_cte_cases_def cteSizeBits_def)
+                apply fastforce
+               apply ceqv
+              apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                  apply (rule ccorres_move_c_guard_tcb)
+                  apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb tcbPtr s}"
+                               in threadSet_ccorres_lemma3[where P=\<top> and P'=\<top>, simplified])
+                   apply (rule conseqPre, vcg)
+                   apply clarsimp
+                   apply (frule (1) obj_at_cslift_tcb[where thread=tcbPtr])
+                   apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                     simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                           tcb_cte_cases_def cteSizeBits_def)
+                  apply clarsimp
+                 apply ceqv
+                apply (rule ccorres_symb_exec_r)
+                  apply (fastforce intro: ccorres_return_C')
+                 apply vcg
+                apply (rule conseqPre, vcg)
+                apply clarsimp
+               apply wpsimp
+              apply vcg
+             apply wpsimp
+            apply vcg
+           apply clarsimp
+           apply (rule ccorres_assert2)+
+           apply (rule ccorres_rhs_assoc)+
+           apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+               apply (rule ccorres_move_c_guard_tcb)+
+               apply (rule_tac Q="\<lambda>s tcb'. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb' (the beforePtrOpt) s}"
+                            in threadSet_ccorres_lemma3[where P=\<top> and P'=\<top>, simplified])
+                apply (rule conseqPre, vcg)
+                apply clarsimp
+                apply (frule (1) obj_at_cslift_tcb)
+                apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                  simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                        tcb_cte_cases_def cteSizeBits_def)
+               apply clarsimp
+              apply ceqv
+             apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                 apply (rule ccorres_move_c_guard_tcb)+
+                 apply (rule_tac P=\<top> and P'="tcb_at' tcbPtr"
+                             and Q="\<lambda>s tcb'. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb' (the afterPtrOpt) s}"
+                              in threadSet_ccorres_lemma3)
+                  apply (rule conseqPre, vcg)
+                  apply clarsimp
+                  apply (frule (1) obj_at_cslift_tcb)
+                  apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                    simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                          tcb_cte_cases_def cteSizeBits_def)
+                 apply clarsimp
+                apply ceqv
+               apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                   apply (rule ccorres_move_c_guard_tcb)
+                   apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb tcbPtr s}"
+                                in threadSet_ccorres_lemma3[where P=\<top> and P'=\<top>, simplified])
+                    apply (rule conseqPre, vcg)
+                    apply clarsimp
+                    apply (frule (1) obj_at_cslift_tcb[where thread=tcbPtr])
+                    apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                      simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                            tcb_cte_cases_def cteSizeBits_def)
+                   apply clarsimp
+                  apply ceqv
+                 apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                     apply (rule ccorres_move_c_guard_tcb)
+                     apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb tcbPtr s}"
+                                  in threadSet_ccorres_lemma3[where P=\<top> and P'=\<top>, simplified])
+                      apply (rule conseqPre, vcg)
+                      apply clarsimp
+                      apply (frule (1) obj_at_cslift_tcb[where thread=tcbPtr])
+                      apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                        simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                              tcb_cte_cases_def cteSizeBits_def)
+                     apply fastforce
+                    apply ceqv
+                   apply (fastforce intro: ccorres_return_C')
+                  apply (wpsimp | vcg)+
+  apply (clarsimp split: if_splits)
+  apply normalise_obj_at'
+  apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+  by (intro conjI impI;
+      clarsimp simp: ctcb_queue_relation_def typ_heap_simps option_to_ctcb_ptr_def
+                     valid_tcb'_def valid_bound_tcb'_def)
+
+lemma tcbQueueRemove_tcb_at'_head:
+  "\<lbrace>\<lambda>s. valid_objs' s \<and> (\<forall>head. tcbQueueHead queue = Some head \<longrightarrow> tcb_at' head s)\<rbrace>
+   tcbQueueRemove queue t
+   \<lbrace>\<lambda>rv s. \<not> tcbQueueEmpty rv \<longrightarrow> tcb_at' (the (tcbQueueHead rv)) s\<rbrace>"
+  unfolding tcbQueueRemove_def
+  apply (wpsimp wp: getTCB_wp haskell_assert_wp hoare_vcg_imp_lift')
+  apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+  apply (fastforce simp: valid_tcb'_def valid_bound_tcb'_def tcbQueueEmpty_def obj_at'_def)
   done
 
-lemma tcbSchedAppend_ccorres:
+lemma tcbSchedDequeue_ccorres:
   "ccorres dc xfdc
-           (valid_queues and tcb_at' t and valid_objs')
-           (UNIV \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace>)
-           []
-           (tcbSchedAppend t)
-           (Call tcbSchedAppend_'proc)"
+     (tcb_at' t and valid_objs' and pspace_aligned' and pspace_distinct')
+     \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace> hs
+     (tcbSchedDequeue t) (Call tcbSchedDequeue_'proc)"
 proof -
   note prio_and_dom_limit_helpers[simp] word_sle_def[simp] maxDom_to_H[simp] maxPrio_to_H[simp]
+  note invert_prioToL1Index_c_simp[simp]
 
   (* when numDomains = 1, array bounds checks would become _ = 0 rather than _ < 1, changing the
      shape of the proof compared to when numDomains > 1 *)
-  include no_less_1_simps
+  note word_less_1[simp del]
 
   show ?thesis
-  apply (cinit lift: tcb_')
-   apply (rule_tac r'="\<lambda>rv rv'. rv = to_bool rv'"
-               and xf'="ret__unsigned_longlong_'" in ccorres_split_nothrow)
-       apply (rule threadGet_vcg_corres)
-       apply (rule allI, rule conseqPre, vcg)
-       apply clarsimp
-       apply (drule obj_at_ko_at', clarsimp)
-       apply (drule spec, drule(1) mp, clarsimp)
-       apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-      apply ceqv
-     apply (simp add: when_def unless_def del: Collect_const split del: if_split)
-     apply (rule ccorres_cond[where R=\<top>])
-       apply (simp add: to_bool_def)
-      apply (rule ccorres_rhs_assoc)+
-      apply csymbr
-      apply csymbr
-      apply csymbr
-      apply csymbr
-      apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv"
-          and xf'="dom_'" in ccorres_split_nothrow)
-          apply (rule threadGet_vcg_corres)
-          apply (rule allI, rule conseqPre, vcg)
-          apply clarsimp
-          apply (drule obj_at_ko_at', clarsimp)
-          apply (drule spec, drule(1) mp, clarsimp)
-          apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-         apply ceqv
-        apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv"
-            and xf'="prio_'" in ccorres_split_nothrow)
+    apply (cinit lift: tcb_')
+     apply (rule ccorres_stateAssert)+
+     apply (rule_tac r'="\<lambda>rv rv'. rv = to_bool rv'" and xf'="ret__unsigned_longlong_'"
+                  in ccorres_split_nothrow)
+         apply (rule threadGet_vcg_corres)
+         apply (rule allI, rule conseqPre, vcg)
+         apply clarsimp
+         apply (drule obj_at_ko_at', clarsimp)
+         apply (drule spec, drule(1) mp, clarsimp)
+         apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+        apply ceqv
+       apply (simp add: when_def del: Collect_const split del: if_split)
+       apply (rule ccorres_cond[where R=\<top>])
+         apply (simp add: to_bool_def)
+        apply (rule ccorres_rhs_assoc)+
+        apply csymbr
+        apply csymbr
+        apply csymbr
+        apply csymbr
+        apply csymbr
+        apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="dom_'" in ccorres_split_nothrow)
             apply (rule threadGet_vcg_corres)
             apply (rule allI, rule conseqPre, vcg)
             apply clarsimp
@@ -1796,123 +1471,78 @@ proof -
             apply (drule spec, drule(1) mp, clarsimp)
             apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
            apply ceqv
-          apply (rule ccorres_rhs_assoc2)+
-          apply (simp only: bind_assoc[symmetric])
-          apply (rule ccorres_split_nothrow_novcg_dc)
-             prefer 2
-             apply (rule ccorres_move_c_guard_tcb)
-             apply ctac
-            prefer 2
-            apply (wp, clarsimp, wp+)
-           apply (rule_tac P="\<lambda>s. valid_queues s \<and> (\<forall>p. t \<notin> set (ksReadyQueues s p))
-                                  \<and> (\<exists>tcb. ko_at' tcb t s \<and> tcbDomain tcb =rva
-                                  \<and> tcbPriority tcb = rvb \<and> valid_tcb' tcb s)"
-                       and P'=UNIV in ccorres_from_vcg)
-           apply (rule allI, rule conseqPre, vcg)
-           apply (clarsimp simp: getQueue_def gets_def get_def setQueue_def modify_def
-                                 put_def bind_def return_def bitmap_fun_defs null_def)
-           apply (clarsimp simp: queue_in_range valid_tcb'_def)
-           apply (rule conjI; clarsimp simp: queue_in_range)
-            apply (drule (1) obj_at_cslift_tcb)
-            apply clarsimp
-            apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb"
-                     in rf_sr_sched_queue_relation)
-              apply clarsimp
-             apply clarsimp
-            apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL)
-             apply (simp add: valid_queues_valid_q)
-            apply (frule_tac s=\<sigma> in tcb_queue_relation_qend_mems,  simp add: valid_queues_valid_q)
-            apply (drule_tac qend'="tcb_ptr_to_ctcb_ptr t" and s=\<sigma> in tcbSchedAppend_update,
-                   simp_all add: valid_queues_valid_q)[1]
-             apply (rule tcb_at_not_NULL, erule obj_at'_weakenE, simp)
-            apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-            apply (simp add: invert_prioToL1Index_c_simp)
-            apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                      unat_trans_ucast_helper\<close>)
-            apply (clarsimp simp: maxDomain_le_unat_ucast_explicit)
-            apply (rule conjI; clarsimp)
-             apply (rule conjI)
-              apply (fastforce simp: c_invert_assist l2BitmapSize_def' wordRadix_def)
-             apply (simp add: t_hrs_ksReadyQueues_upd_absorb)
-             apply (subst rf_sr_drop_bitmaps_enqueue_helper, assumption)
-               apply (fastforce intro: cbitmap_L1_relation_bit_set)
-              subgoal by (fastforce intro: cbitmap_L2_relation_bit_set simp: wordRadix_def mask_def)
-             apply (erule(1) state_relation_queue_update_helper[where S="{t}"],
-                    (simp | rule globals.equality)+,
-                    simp_all add: cready_queues_index_to_C_def2 numPriorities_def
-                                  t_hrs_ksReadyQueues_upd_absorb upd_unless_null_def
-                                  typ_heap_simps)[1]
-               apply (fastforce simp: tcb_null_sched_ptrs_def elim: obj_at'_weaken)
-             apply (fastforce simp: tcb_null_sched_ptrs_def elim: obj_at'_weaken)
-            apply (clarsimp simp: upd_unless_null_def cready_queues_index_to_C_def numPriorities_def)
-           apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                     unat_trans_ucast_helper\<close>)
-           apply (clarsimp simp: maxDomain_le_unat_ucast_explicit)
-           apply (rule conjI; clarsimp simp: queue_in_range)
-            apply (drule (1) obj_at_cslift_tcb)
-            apply clarsimp
-            apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb"
-                     in rf_sr_sched_queue_relation)
-              apply clarsimp
-             apply clarsimp
-            apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL)
-             apply (simp add: valid_queues_valid_q)
-            apply (frule_tac s=\<sigma> in tcb_queue_relation_qend_mems,
-                   simp add: valid_queues_valid_q)
-            apply (drule_tac qend'="tcb_ptr_to_ctcb_ptr t" and s=\<sigma> in tcbSchedAppend_update,
-                   simp_all add: valid_queues_valid_q)[1]
+          apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="prio_'" in ccorres_split_nothrow)
+              apply (rule threadGet_vcg_corres)
+              apply (rule allI, rule conseqPre, vcg)
               apply clarsimp
-             apply (rule tcb_at_not_NULL, erule obj_at'_weakenE, simp)
-            apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-            apply (clarsimp simp: upd_unless_null_def cready_queues_index_to_C_def numPriorities_def)
-           apply (drule (1) obj_at_cslift_tcb)
-           apply clarsimp
-           apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb"
-                    in rf_sr_sched_queue_relation)
-             apply clarsimp
+              apply (drule obj_at_ko_at', clarsimp)
+              apply (drule spec, drule(1) mp, clarsimp)
+              apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+             apply ceqv
+            apply (rule ccorres_symb_exec_r)
+              apply (rule ccorres_Guard_Seq)
+              apply (simp add: bind_assoc)
+              apply (ctac add: getQueue_ccorres)
+                apply (rule_tac r'=ctcb_queue_relation and xf'=new_queue_' in ccorres_split_nothrow)
+                    apply (ctac add: tcb_queue_remove_ccorres)
+                   apply ceqv
+                  apply (rename_tac queue' newqueue)
+                  apply (rule ccorres_Guard_Seq)
+                  apply (ctac add: setQueue_ccorres)
+                    apply (rule ccorres_split_nothrow_novcg_dc)
+                       apply ctac
+                      apply (rule_tac xf'=ret__unsigned_long_'
+                                  and val="from_bool (tcbQueueEmpty queue')"
+                                  and R="\<lambda>s. \<not> tcbQueueEmpty queue' \<longrightarrow> tcb_at' (the (tcbQueueHead queue')) s"
+                                  in ccorres_symb_exec_r_known_rv[where R'=UNIV])
+                         apply (rule conseqPre, vcg)
+                         apply (fastforce dest: tcb_at_not_NULL
+                                          simp: ctcb_queue_relation_def option_to_ctcb_ptr_def
+                                                tcbQueueEmpty_def split: option.splits)
+                        apply ceqv
+                       apply (rule ccorres_cond[where R=\<top>])
+                         apply fastforce
+                        apply (ctac add: removeFromBitmap_ccorres)
+                       apply (rule ccorres_return_Skip)
+                      apply vcg
+                     apply (wpsimp wp: hoare_vcg_imp_lift')
+                    apply (clarsimp simp: guard_is_UNIV_def)
+                   apply (wpsimp wp: hoare_vcg_imp_lift')
+                  apply vcg
+                 apply ((wpsimp wp: tcbQueueRemove_tcb_at'_head | wp (once) hoare_drop_imps)+)[1]
+                apply (vcg exspec=tcb_queue_remove_modifies)
+               apply wpsimp
+              apply vcg
+             apply vcg
+            apply (rule conseqPre, vcg)
             apply clarsimp
-           apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL)
-            apply (simp add: valid_queues_valid_q)
-           apply (frule_tac s=\<sigma> in tcb_queue_relation_qend_mems,
-                  simp add: valid_queues_valid_q)
-           apply (drule_tac qend'="tcb_ptr_to_ctcb_ptr t" and s=\<sigma> in tcbSchedAppend_update,
-                  simp_all add: valid_queues_valid_q)[1]
-             apply clarsimp
-            apply (rule tcb_at_not_NULL, erule obj_at'_weakenE, simp)
-           apply (clarsimp simp: cready_queues_index_to_C_def2 numPriorities_def)
-           apply (frule(2) obj_at_cslift_tcb[OF valid_queues_obj_at'D])
-           apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-           apply (erule_tac S="{t, v}" for v in state_relation_queue_update_helper,
-                  (simp | rule globals.equality)+,
-                  simp_all add: typ_heap_simps if_Some_helper numPriorities_def
-                                cready_queues_index_to_C_def2 upd_unless_null_def
-                           cong: if_cong split del: if_split
-                           del: fun_upd_restrict_conv)[1]
-              apply simp
-              apply (rule conjI)
-               apply clarsimp
-               apply (drule_tac s="tcb_ptr_to_ctcb_ptr t" in sym, simp)
-              apply (clarsimp simp add: fun_upd_twist)
-             prefer 3
-             apply (simp add: obj_at'_weakenE[OF _ TrueI])
-             apply (rule disjI1, erule valid_queues_obj_at'D)
-             subgoal by simp
-            subgoal by simp
-           subgoal by (fastforce simp: tcb_null_sched_ptrs_def)
-          apply (simp add: guard_is_UNIV_def)
-         apply simp
-         apply (wp threadGet_wp)
+           apply (wpsimp wp: threadGet_wp)
+          apply vcg
+         apply clarsimp
+         apply (wpsimp wp: threadGet_wp)
         apply vcg
-       apply simp
-       apply (wp threadGet_wp)
-      apply vcg
-     apply (rule ccorres_return_Skip)
-    apply simp
-    apply (wp threadGet_wp)
-   apply vcg
-  by (fastforce simp: valid_objs'_def obj_at'_def ran_def projectKOs typ_at'_def
-                         valid_obj'_def inQ_def
-                   dest!: valid_queues_obj_at'D)
+       apply (rule ccorres_return_Skip)
+      apply (wpsimp wp: threadGet_wp)
+     apply (vcg expsec=thread_state_get_tcbQueued_modifies)
+    apply normalise_obj_at'
+    apply (rename_tac tcb)
+    apply (frule (1) obj_at_cslift_tcb)
+    apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+    apply (clarsimp simp: valid_tcb'_def)
+    apply (cut_tac qdom="tcbDomain tcb" and prio="tcbPriority tcb"
+                in cready_queues_index_to_C_in_range)
+      apply fastforce
+     apply fastforce
+    apply (rule conjI)
+     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
+     apply (frule (3) obj_at'_tcbQueueHead_ksReadyQueues)
+     apply (force dest!: tcbQueueHead_iff_tcbQueueEnd simp: tcbQueueEmpty_def obj_at'_def)
+    by (fastforce simp: word_less_nat_alt
+                        cready_queues_index_to_C_def2 ctcb_relation_def
+                        typ_heap_simps le_maxDomain_eq_less_numDomains(2) unat_trans_ucast_helper)
 qed
 
 lemma isStopped_spec:
@@ -1960,8 +1590,11 @@ lemma tcb_at_1:
   done
 
 lemma rescheduleRequired_ccorres:
-  "ccorres dc xfdc (valid_queues and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and valid_objs')
-           UNIV [] rescheduleRequired (Call rescheduleRequired_'proc)"
+  "ccorres dc xfdc
+     ((\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and valid_objs'
+      and pspace_aligned' and pspace_distinct')
+     UNIV []
+     rescheduleRequired (Call rescheduleRequired_'proc)"
   apply cinit
    apply (rule ccorres_symb_exec_l)
       apply (rule ccorres_split_nothrow_novcg[where r'=dc and xf'=xfdc])
@@ -2071,10 +1704,12 @@ lemma cguard_UNIV:
   by fastforce
 
 lemma lookupBitmapPriority_le_maxPriority:
-  "\<lbrakk> ksReadyQueuesL1Bitmap s d \<noteq> 0 ; valid_queues s \<rbrakk>
+  "\<lbrakk> ksReadyQueuesL1Bitmap s d \<noteq> 0 ;
+     \<forall>d p. d > maxDomain \<or> p > maxPriority \<longrightarrow> tcbQueueEmpty (ksReadyQueues s (d, p));
+     valid_bitmaps s \<rbrakk>
    \<Longrightarrow> lookupBitmapPriority d s \<le> maxPriority"
-   unfolding valid_queues_def valid_queues_no_bitmap_def
-   by (fastforce dest!: bitmapQ_from_bitmap_lookup bitmapQ_ksReadyQueuesI intro: ccontr)
+  apply (clarsimp simp: valid_bitmaps_def)
+  by (fastforce dest!: bitmapQ_from_bitmap_lookup bitmapQ_ksReadyQueuesI intro: ccontr)
 
 lemma rf_sr_ksReadyQueuesL1Bitmap_not_zero:
   "\<lbrakk> (\<sigma>, s') \<in> rf_sr ; d \<le> maxDomain ; ksReadyQueuesL1Bitmap_' (globals s').[unat d] \<noteq> 0 \<rbrakk>
@@ -2084,10 +1719,10 @@ lemma rf_sr_ksReadyQueuesL1Bitmap_not_zero:
   done
 
 lemma ksReadyQueuesL1Bitmap_word_log2_max:
-    "\<lbrakk>valid_queues s; ksReadyQueuesL1Bitmap s d \<noteq> 0\<rbrakk>
-    \<Longrightarrow> word_log2 (ksReadyQueuesL1Bitmap s d) < l2BitmapSize"
-    unfolding valid_queues_def
-    by (fastforce dest: word_log2_nth_same bitmapQ_no_L1_orphansD)
+  "\<lbrakk>valid_bitmaps s; ksReadyQueuesL1Bitmap s d \<noteq> 0\<rbrakk>
+   \<Longrightarrow> word_log2 (ksReadyQueuesL1Bitmap s d) < l2BitmapSize"
+  unfolding valid_bitmaps_def
+  by (fastforce dest: word_log2_nth_same bitmapQ_no_L1_orphansD)
 
 lemma word_log2_max_word64[simp]:
   "word_log2 (w :: 64 word) < 64"
@@ -2095,7 +1730,7 @@ lemma word_log2_max_word64[simp]:
   by (simp add: word_size)
 
 lemma rf_sr_ksReadyQueuesL2Bitmap_simp:
-  "\<lbrakk> (\<sigma>, s') \<in> rf_sr ; d \<le> maxDomain ; valid_queues \<sigma> ; ksReadyQueuesL1Bitmap \<sigma> d \<noteq> 0 \<rbrakk>
+  "\<lbrakk> (\<sigma>, s') \<in> rf_sr ; d \<le> maxDomain ; valid_bitmaps \<sigma> ; ksReadyQueuesL1Bitmap \<sigma> d \<noteq> 0 \<rbrakk>
    \<Longrightarrow> ksReadyQueuesL2Bitmap_' (globals s').[unat d].[word_log2 (ksReadyQueuesL1Bitmap \<sigma> d)] =
       ksReadyQueuesL2Bitmap \<sigma> (d, word_log2 (ksReadyQueuesL1Bitmap \<sigma> d))"
   apply (frule rf_sr_cbitmap_L2_relation)
@@ -2104,9 +1739,9 @@ lemma rf_sr_ksReadyQueuesL2Bitmap_simp:
   done
 
 lemma ksReadyQueuesL2Bitmap_nonzeroI:
-  "\<lbrakk> d \<le> maxDomain ; valid_queues s ; ksReadyQueuesL1Bitmap s d \<noteq> 0 \<rbrakk>
+  "\<lbrakk> d \<le> maxDomain ; valid_bitmaps s ; ksReadyQueuesL1Bitmap s d \<noteq> 0 \<rbrakk>
    \<Longrightarrow> ksReadyQueuesL2Bitmap s (d, invertL1Index (word_log2 (ksReadyQueuesL1Bitmap s d))) \<noteq> 0"
-   unfolding valid_queues_def
+   unfolding valid_bitmaps_def
    apply clarsimp
    apply (frule bitmapQ_no_L1_orphansD)
     apply (erule word_log2_nth_same)
@@ -2271,9 +1906,9 @@ lemma threadGet_get_obj_at'_has_domain:
 lemma possibleSwitchTo_ccorres:
   shows
   "ccorres dc xfdc
-         (valid_queues and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
+         ((\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
             and st_tcb_at' runnable' t and (\<lambda>s. ksCurDomain s \<le> maxDomain)
-            and valid_objs')
+            and valid_objs' and pspace_aligned' and pspace_distinct')
          ({s. target_' s = tcb_ptr_to_ctcb_ptr t}
           \<inter> UNIV) []
      (possibleSwitchTo t )
@@ -2321,8 +1956,8 @@ lemma possibleSwitchTo_ccorres:
 
 lemma scheduleTCB_ccorres':
   "ccorres dc xfdc
-           (tcb_at' thread and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and valid_queues
-                           and valid_objs')
+           (tcb_at' thread and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
+                           and valid_objs' and pspace_aligned' and pspace_distinct')
            (UNIV \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr thread})
            []
   (do (runnable, curThread, action) \<leftarrow> do
@@ -2372,24 +2007,26 @@ lemma scheduleTCB_ccorres':
            apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
                                  cscheduler_action_relation_def)
           apply wp+
-     apply (simp add: isRunnable_def isStopped_def)
-    apply wp
+   apply (simp add: isRunnable_def isStopped_def)
    apply (simp add: guard_is_UNIV_def)
   apply clarsimp
   apply (clarsimp simp: st_tcb_at'_def obj_at'_def weak_sch_act_wf_def)
   done
 
 lemma scheduleTCB_ccorres_valid_queues'_pre:
-        "ccorresG rf_sr \<Gamma> dc xfdc (tcb_at' thread and st_tcb_at' (not runnable') thread and valid_queues' and valid_queues and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and valid_objs')
-         (UNIV \<inter> \<lbrace>\<acute>tptr = tcb_ptr_to_ctcb_ptr thread\<rbrace>) []
-         (do (runnable, curThread, action) \<leftarrow> do
-             runnable \<leftarrow> isRunnable thread;
-             curThread \<leftarrow> getCurThread;
-             action \<leftarrow> getSchedulerAction;
-             return (runnable, curThread, action) od;
-             when (\<not> runnable \<and> curThread = thread \<and> action = ResumeCurrentThread) rescheduleRequired
-          od)
-         (Call scheduleTCB_'proc)"
+  "ccorresG rf_sr \<Gamma> dc xfdc
+     (tcb_at' thread and st_tcb_at' (not runnable') thread
+      and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
+      and valid_objs' and pspace_aligned' and pspace_distinct')
+     \<lbrace>\<acute>tptr = tcb_ptr_to_ctcb_ptr thread\<rbrace> []
+     (do (runnable, curThread, action) \<leftarrow> do runnable \<leftarrow> isRunnable thread;
+                                             curThread \<leftarrow> getCurThread;
+                                             action \<leftarrow> getSchedulerAction;
+                                             return (runnable, curThread, action)
+                                          od;
+         when (\<not> runnable \<and> curThread = thread \<and> action = ResumeCurrentThread) rescheduleRequired
+      od)
+     (Call scheduleTCB_'proc)"
   supply empty_fail_cond[simp]
   apply (cinit' lift: tptr_')
    apply (rule ccorres_rhs_assoc2)+
@@ -2430,17 +2067,17 @@ lemma scheduleTCB_ccorres_valid_queues'_pre:
                            split: scheduler_action.split_asm)
           apply wp+
      apply (simp add: isRunnable_def isStopped_def)
-    apply wp
    apply (simp add: guard_is_UNIV_def)
   apply (clarsimp simp: st_tcb_at'_def obj_at'_def)
   done
 
-
 lemmas scheduleTCB_ccorres_valid_queues'
     = scheduleTCB_ccorres_valid_queues'_pre[unfolded bind_assoc return_bind split_conv]
 
 lemma rescheduleRequired_ccorres_valid_queues'_simple:
-  "ccorresG rf_sr \<Gamma> dc xfdc (valid_queues' and sch_act_simple) UNIV [] rescheduleRequired (Call rescheduleRequired_'proc)"
+  "ccorresG rf_sr \<Gamma> dc xfdc
+     sch_act_simple UNIV []
+     rescheduleRequired (Call rescheduleRequired_'proc)"
   apply cinit
    apply (rule ccorres_symb_exec_l)
       apply (rule ccorres_split_nothrow_novcg[where r'=dc and xf'=xfdc])
@@ -2473,16 +2110,17 @@ lemma rescheduleRequired_ccorres_valid_queues'_simple:
                  split: scheduler_action.split_asm)
 
 lemma scheduleTCB_ccorres_valid_queues'_pre_simple:
-        "ccorresG rf_sr \<Gamma> dc xfdc (tcb_at' thread and st_tcb_at' (not runnable') thread and valid_queues' and sch_act_simple)
-         (UNIV \<inter> \<lbrace>\<acute>tptr = tcb_ptr_to_ctcb_ptr thread\<rbrace>) []
-         (do (runnable, curThread, action) \<leftarrow> do
-             runnable \<leftarrow> isRunnable thread;
-             curThread \<leftarrow> getCurThread;
-             action \<leftarrow> getSchedulerAction;
-             return (runnable, curThread, action) od;
-             when (\<not> runnable \<and> curThread = thread \<and> action = ResumeCurrentThread) rescheduleRequired
-          od)
-         (Call scheduleTCB_'proc)"
+  "ccorresG rf_sr \<Gamma> dc xfdc
+     (tcb_at' thread and st_tcb_at' (not runnable') thread and valid_queues' and sch_act_simple)
+     \<lbrace>\<acute>tptr = tcb_ptr_to_ctcb_ptr thread\<rbrace> []
+     (do (runnable, curThread, action) \<leftarrow> do runnable \<leftarrow> isRunnable thread;
+                                             curThread \<leftarrow> getCurThread;
+                                             action \<leftarrow> getSchedulerAction;
+                                             return (runnable, curThread, action)
+                                          od;
+         when (\<not> runnable \<and> curThread = thread \<and> action = ResumeCurrentThread) rescheduleRequired
+      od)
+     (Call scheduleTCB_'proc)"
   supply empty_fail_cond[simp]
   apply (cinit' lift: tptr_' simp del: word_neq_0_conv)
    apply (rule ccorres_rhs_assoc2)+
@@ -2521,11 +2159,10 @@ lemma scheduleTCB_ccorres_valid_queues'_pre_simple:
            apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
                                  cscheduler_action_relation_def)
           apply wp+
-     apply (simp add: isRunnable_def isStopped_def)
-    apply wp
+   apply (simp add: isRunnable_def isStopped_def)
    apply (simp add: guard_is_UNIV_def)
   apply clarsimp
-  apply (clarsimp simp: st_tcb_at'_def obj_at'_def valid_queues'_def)
+  apply (clarsimp simp: st_tcb_at'_def obj_at'_def)
   done
 
 lemmas scheduleTCB_ccorres_valid_queues'_simple
@@ -2545,47 +2182,34 @@ lemma threadSet_weak_sch_act_wf_runnable':
   apply (clarsimp)
 done
 
-lemma threadSet_valid_queues_and_runnable': "\<lbrace>\<lambda>s. valid_queues s \<and> (\<forall>p. thread \<in> set (ksReadyQueues s p) \<longrightarrow> runnable' st)\<rbrace>
-                 threadSet (tcbState_update (\<lambda>_. st)) thread
-               \<lbrace>\<lambda>rv s. valid_queues s\<rbrace>"
-  apply (wp threadSet_valid_queues)
-  apply (clarsimp simp: inQ_def)
-done
-
 lemma setThreadState_ccorres[corres]:
    "ccorres dc xfdc
-   (\<lambda>s. tcb_at' thread s \<and> valid_queues s \<and> valid_objs' s \<and> valid_tcb_state' st s \<and>
-                 (ksSchedulerAction s = SwitchToThread thread \<longrightarrow> runnable' st) \<and>
-                 (\<forall>p. thread \<in> set (ksReadyQueues s p) \<longrightarrow> runnable' st) \<and>
-                 sch_act_wf (ksSchedulerAction s) s)
-     ({s'. (\<forall>cl fl. cthread_state_relation_lifted st (cl\<lparr>tsType_CL := ts_' s' && mask 4\<rparr>, fl))}
+   (\<lambda>s. tcb_at' thread s \<and> valid_objs' s \<and> valid_tcb_state' st s
+        \<and> (ksSchedulerAction s = SwitchToThread thread \<longrightarrow> runnable' st)
+        \<and> sch_act_wf (ksSchedulerAction s) s \<and> pspace_aligned' s \<and> pspace_distinct' s)
+   ({s'. (\<forall>cl fl. cthread_state_relation_lifted st (cl\<lparr>tsType_CL := ts_' s' && mask 4\<rparr>, fl))}
     \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr thread}) hs
-         (setThreadState st thread) (Call setThreadState_'proc)"
+   (setThreadState st thread) (Call setThreadState_'proc)"
    apply (cinit lift: tptr_' cong add: call_ignore_cong)
    apply (ctac (no_vcg) add: threadSet_tcbState_simple_corres)
     apply (ctac add: scheduleTCB_ccorres)
-  apply (wp threadSet_weak_sch_act_wf_runnable' threadSet_valid_queues_and_runnable'
-            threadSet_valid_objs')
-  by (clarsimp simp: weak_sch_act_wf_def valid_queues_def valid_tcb'_tcbState_update)
-
-lemma threadSet_valid_queues'_and_not_runnable': "\<lbrace>tcb_at' thread and valid_queues' and (\<lambda>s. (\<not> runnable' st))\<rbrace>
-                  threadSet (tcbState_update (\<lambda>_. st)) thread
-               \<lbrace>\<lambda>rv. tcb_at' thread and st_tcb_at' (not runnable') thread and valid_queues' \<rbrace>"
-
-  apply (wp threadSet_valid_queues' threadSet_tcbState_st_tcb_at')
-  apply (clarsimp simp: pred_neg_def valid_queues'_def inQ_def)+
-done
+  apply (wp threadSet_weak_sch_act_wf_runnable' threadSet_valid_objs')
+  apply (clarsimp simp: weak_sch_act_wf_def valid_tcb'_tcbState_update)
+  done
 
 lemma setThreadState_ccorres_valid_queues':
-   "ccorres dc xfdc
-   (\<lambda>s. tcb_at' thread s \<and> valid_queues' s \<and> \<not> runnable' st \<and> weak_sch_act_wf (ksSchedulerAction s) s \<and> Invariants_H.valid_queues s \<and> (\<forall>p. thread \<notin> set (ksReadyQueues s p)) \<and> sch_act_not thread s \<and> valid_objs' s \<and> valid_tcb_state' st s)
+  "ccorres dc xfdc
+     (\<lambda>s. tcb_at' thread s \<and> \<not> runnable' st \<and> weak_sch_act_wf (ksSchedulerAction s) s
+          \<and> sch_act_not thread s \<and> valid_objs' s \<and> valid_tcb_state' st s
+          \<and> pspace_aligned' s \<and> pspace_distinct' s)
      ({s'. (\<forall>cl fl. cthread_state_relation_lifted st (cl\<lparr>tsType_CL := ts_' s' && mask 4\<rparr>, fl))}
-    \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr thread}) []
-         (setThreadState st thread) (Call setThreadState_'proc)"
+      \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr thread}) []
+     (setThreadState st thread) (Call setThreadState_'proc)"
    apply (cinit lift: tptr_' cong add: call_ignore_cong)
    apply (ctac (no_vcg) add: threadSet_tcbState_simple_corres)
     apply (ctac add: scheduleTCB_ccorres_valid_queues')
-   apply (wp threadSet_valid_queues'_and_not_runnable' threadSet_weak_sch_act_wf_runnable' threadSet_valid_queues_and_runnable' threadSet_valid_objs')
+   apply (wp threadSet_weak_sch_act_wf_runnable' threadSet_valid_objs'
+             threadSet_tcbState_st_tcb_at')
   by (clarsimp simp: valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)
 
 lemma simp_list_case_return:
@@ -2607,22 +2231,20 @@ lemma cancelSignal_ccorres [corres]:
    apply (rule ccorres_rhs_assoc2)
    apply (ctac (no_vcg) add: cancelSignal_ccorres_helper)
      apply (ctac add: setThreadState_ccorres_valid_queues')
-    apply ((wp setNotification_nosch setNotification_ksQ hoare_vcg_all_lift set_ntfn_valid_objs' | simp add: valid_tcb_state'_def split del: if_split)+)[1]
+    apply ((wp setNotification_nosch hoare_vcg_all_lift set_ntfn_valid_objs' | simp add: valid_tcb_state'_def split del: if_split)+)[1]
    apply (simp add: ThreadState_defs)
   apply (rule conjI, clarsimp, rule conjI, clarsimp)
     apply (frule (1) ko_at_valid_ntfn'[OF _ invs_valid_objs'])
    subgoal by ((auto simp: obj_at'_def projectKOs st_tcb_at'_def invs'_def valid_state'_def
                      isTS_defs cte_wp_at_ctes_of
                      cthread_state_relation_def sch_act_wf_weak valid_ntfn'_def
-             dest!: valid_queues_not_runnable'_not_ksQ[where t=thread] |
-           clarsimp simp: eq_commute)+)
+               | clarsimp simp: eq_commute)+)
    apply (clarsimp)
    apply (frule (1) ko_at_valid_ntfn'[OF _ invs_valid_objs'])
    apply (frule (2) ntfn_blocked_in_queueD)
    by (auto simp: obj_at'_def projectKOs st_tcb_at'_def invs'_def valid_state'_def
                      isTS_defs cte_wp_at_ctes_of valid_ntfn'_def
                      cthread_state_relation_def sch_act_wf_weak isWaitingNtfn_def
-             dest!: valid_queues_not_runnable'_not_ksQ[where t=thread]
              split: ntfn.splits option.splits
          |  clarsimp simp: eq_commute
          | drule_tac x=thread in bspec)+
@@ -2927,23 +2549,20 @@ lemma cancelIPC_ccorres_helper:
                         cpspace_relation_def update_ep_map_tos typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-       \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            subgoal by (clarsimp simp: comp_def)
-        \<comment> \<open>ep relation\<close>
-           apply (rule cpspace_relation_ep_update_ep, assumption+)
-            subgoal by (simp add: cendpoint_relation_def Let_def EPState_Idle_def)
-           subgoal by simp
-           \<comment> \<open>ntfn relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-          apply simp
-          apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
-           subgoal by simp
-          apply (erule (1) map_to_ko_atI')
-         apply (simp add: heap_to_user_data_def Let_def)
-        \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         subgoal by (clarsimp simp: comp_def)
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           subgoal by (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (rule cpspace_relation_ep_update_ep, assumption+)
+           subgoal by (simp add: cendpoint_relation_def Let_def EPState_Idle_def)
+          subgoal by simp
+         \<comment> \<open>ntfn relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+          subgoal by simp
+         apply (erule (1) map_to_ko_atI')
+        apply (simp add: heap_to_user_data_def Let_def)
         subgoal by (clarsimp simp: carch_state_relation_def carch_globals_def
                                    packed_heap_update_collapse_hrs)
        subgoal by (simp add: cmachine_state_relation_def)
@@ -2964,27 +2583,16 @@ lemma cancelIPC_ccorres_helper:
                        cpspace_relation_def update_ep_map_tos typ_heap_simps')
       apply (elim conjE)
       apply (intro conjI)
-      \<comment> \<open>tcb relation\<close>
-           apply (erule ctcb_relation_null_queue_ptrs)
-           subgoal by (clarsimp simp: comp_def)
-       \<comment> \<open>ep relation\<close>
-          apply (rule cpspace_relation_ep_update_ep, assumption+)
-           apply (simp add: cendpoint_relation_def Let_def isSendEP_def isRecvEP_def split: endpoint.splits split del: if_split)
-           \<comment> \<open>recv case\<close>
-            apply (subgoal_tac "pspace_canonical' \<sigma>")
-             prefer 2
-             apply fastforce
-            apply (clarsimp
-                     simp: h_t_valid_clift_Some_iff ctcb_offset_defs
-                           tcb_queue_relation'_next_mask tcb_queue_relation'_prev_mask
-                           tcb_queue_relation'_next_sign tcb_queue_relation'_prev_sign
-                     simp flip: canonical_bit_def
-                     cong: tcb_queue_relation'_cong)
-            subgoal by (intro impI conjI; simp)
-           \<comment> \<open>send case\<close>
-            apply (subgoal_tac "pspace_canonical' \<sigma>")
-             prefer 2
-             apply fastforce
+          \<comment> \<open>tcb relation\<close>
+          apply (erule ctcb_relation_null_ep_ptrs)
+          subgoal by (clarsimp simp: comp_def)
+         \<comment> \<open>ep relation\<close>
+         apply (rule cpspace_relation_ep_update_ep, assumption+)
+          apply (simp add: cendpoint_relation_def Let_def isSendEP_def isRecvEP_def split: endpoint.splits split del: if_split)
+          \<comment> \<open>recv case\<close>
+           apply (subgoal_tac "pspace_canonical' \<sigma>")
+            prefer 2
+            apply fastforce
            apply (clarsimp
                     simp: h_t_valid_clift_Some_iff ctcb_offset_defs
                           tcb_queue_relation'_next_mask tcb_queue_relation'_prev_mask
@@ -2992,16 +2600,24 @@ lemma cancelIPC_ccorres_helper:
                     simp flip: canonical_bit_def
                     cong: tcb_queue_relation'_cong)
            subgoal by (intro impI conjI; simp)
-          subgoal by simp
-                \<comment> \<open>ntfn relation\<close>
-         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-         apply simp
-         apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
-         apply simp
-         apply (erule (1) map_to_ko_atI')
-         \<comment> \<open>queue relation\<close>
-        apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-        subgoal by (clarsimp simp: comp_def)
+          \<comment> \<open>send case\<close>
+           apply (subgoal_tac "pspace_canonical' \<sigma>")
+            prefer 2
+            apply fastforce
+          apply (clarsimp
+                   simp: h_t_valid_clift_Some_iff ctcb_offset_defs
+                         tcb_queue_relation'_next_mask tcb_queue_relation'_prev_mask
+                          tcb_queue_relation'_next_sign tcb_queue_relation'_prev_sign
+                    simp flip: canonical_bit_def
+                    cong: tcb_queue_relation'_cong)
+          subgoal by (intro impI conjI; simp)
+         subgoal by simp
+        \<comment> \<open>ntfn relation\<close>
+        apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+        apply simp
+        apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+        apply simp
+        apply (erule (1) map_to_ko_atI')
        subgoal by (clarsimp simp: carch_state_relation_def carch_globals_def
                                   packed_heap_update_collapse_hrs)
       subgoal by (simp add: cmachine_state_relation_def)
@@ -3214,37 +2830,35 @@ lemma cancelIPC_ccorres1:
      subgoal by (auto simp: obj_at'_def projectKOs pred_tcb_at'_def invs'_def valid_state'_def
                      isTS_defs cte_wp_at_ctes_of
                      cthread_state_relation_def sch_act_wf_weak valid_ep'_def
-             dest!: valid_queues_not_runnable'_not_ksQ[where t=thread] split: thread_state.splits)
+                     split: thread_state.splits)
     apply clarsimp
     apply (frule (2) ep_blocked_in_queueD_recv)
     apply (frule (1) ko_at_valid_ep'[OF _ invs_valid_objs'])
     subgoal by (auto simp: obj_at'_def projectKOs pred_tcb_at'_def invs'_def valid_state'_def
                          isTS_defs cte_wp_at_ctes_of isRecvEP_def
                          cthread_state_relation_def sch_act_wf_weak valid_ep'_def
-                 dest!: valid_queues_not_runnable'_not_ksQ[where t=thread] split: thread_state.splits endpoint.splits)
+                    split: thread_state.splits endpoint.splits)
    apply (rule conjI)
     apply (clarsimp simp: inQ_def)
-   apply (rule conjI)
-    apply clarsimp
    apply clarsimp
    apply (rule conjI)
     subgoal by (auto simp: obj_at'_def projectKOs pred_tcb_at'_def invs'_def valid_state'_def
                          isTS_defs cte_wp_at_ctes_of
                          cthread_state_relation_def sch_act_wf_weak valid_ep'_def
-                 dest!: valid_queues_not_runnable'_not_ksQ[where t=thread] split: thread_state.splits)
+                    split: thread_state.splits)
    apply clarsimp
    apply (rule conjI)
     subgoal by (auto simp: obj_at'_def projectKOs pred_tcb_at'_def invs'_def valid_state'_def
                          isTS_defs cte_wp_at_ctes_of
                          cthread_state_relation_def sch_act_wf_weak valid_ep'_def
-                 dest!: valid_queues_not_runnable'_not_ksQ[where t=thread] split: thread_state.splits)
+                    split: thread_state.splits)
    apply clarsimp
    apply (frule (2) ep_blocked_in_queueD_send)
    apply (frule (1) ko_at_valid_ep'[OF _ invs_valid_objs'])
    subgoal by (auto simp: obj_at'_def projectKOs pred_tcb_at'_def invs'_def valid_state'_def
                         isTS_defs cte_wp_at_ctes_of isSendEP_def
                         cthread_state_relation_def sch_act_wf_weak valid_ep'_def
-                dest!: valid_queues_not_runnable'_not_ksQ[where t=thread] split: thread_state.splits endpoint.splits)[1]
+                   split: thread_state.splits endpoint.splits)[1]
   apply (auto simp: isTS_defs cthread_state_relation_def typ_heap_simps weak_sch_act_wf_def)
   apply (case_tac ts,
            auto simp: isTS_defs cthread_state_relation_def typ_heap_simps)
diff --git a/proof/crefine/RISCV64/Ipc_C.thy b/proof/crefine/RISCV64/Ipc_C.thy
index 4c4cf65500..c2e028eb22 100644
--- a/proof/crefine/RISCV64/Ipc_C.thy
+++ b/proof/crefine/RISCV64/Ipc_C.thy
@@ -1359,18 +1359,14 @@ lemma getRestartPC_ccorres [corres]:
   done
 
 lemma asUser_tcbFault_obj_at:
-  "\<lbrace>obj_at' (\<lambda>tcb. P (tcbFault tcb)) t\<rbrace> asUser t' m
-   \<lbrace>\<lambda>rv. obj_at' (\<lambda>tcb. P (tcbFault tcb)) t\<rbrace>"
+  "asUser t' m \<lbrace>obj_at' (\<lambda>tcb. P (tcbFault tcb)) t\<rbrace>"
   apply (simp add: asUser_def split_def)
   apply (wp threadGet_wp)
   apply (simp cong: if_cong)
   done
 
 lemma asUser_atcbContext_obj_at:
-  "t \<noteq> t' \<Longrightarrow>
-    \<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>
-      asUser t' m
-    \<lbrace>\<lambda>rv. obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
+  "t \<noteq> t' \<Longrightarrow> asUser t' m \<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
   apply (simp add: asUser_def split_def atcbContextGet_def atcbContextSet_def)
   apply (wp threadGet_wp)
   apply simp
@@ -4173,10 +4169,6 @@ lemma doReplyTransfer_ccorres [corres]:
           \<inter> \<lbrace>\<acute>grant = from_bool grant\<rbrace>)  hs
     (doReplyTransfer sender receiver slot grant)
     (Call doReplyTransfer_'proc)"
-proof -
-  have invs_valid_queues_strg: "\<And>s. invs' s \<longrightarrow> valid_queues s"
-    by clarsimp
-  show ?thesis
   apply (cinit lift: sender_' receiver_' slot_' grant_')
    apply (rule getThreadState_ccorres_foo)
    apply (rule ccorres_assert2)
@@ -4208,7 +4200,7 @@ proof -
         apply (ctac(no_vcg) add: cteDeleteOne_ccorres[where w="scast cap_reply_cap"])
          apply (ctac(no_vcg) add: setThreadState_ccorres)
           apply (ctac(no_vcg) add: possibleSwitchTo_ccorres)
-         apply (wpsimp wp: sts_running_valid_queues setThreadState_st_tcb)+
+         apply (wpsimp wp: sts_valid_objs' setThreadState_st_tcb)+
         apply (wp cteDeleteOne_sch_act_wf)
        apply vcg
       apply (rule conseqPre, vcg)
@@ -4217,8 +4209,7 @@ proof -
      apply wp
      apply (simp add: cap_get_tag_isCap)
      apply (strengthen invs_weak_sch_act_wf_strg
-                       cte_wp_at_imp_consequent'[where P="\<lambda>ct. Ex (ccap_relation (cteCap ct))" for ct]
-                       invs_valid_queues_strg)
+                       cte_wp_at_imp_consequent'[where P="\<lambda>ct. Ex (ccap_relation (cteCap ct))" for ct])
      apply (simp add: cap_reply_cap_def)
      apply (wp doIPCTransfer_reply_or_replyslot)
     apply (clarsimp simp: seL4_Fault_NullFault_def ccorres_cond_iffs
@@ -4253,19 +4244,20 @@ proof -
               apply (ctac (no_vcg))
                apply (simp only: K_bind_def)
                apply (ctac add: possibleSwitchTo_ccorres)
-              apply (wp sts_running_valid_queues setThreadState_st_tcb | simp)+
-             apply (ctac add: setThreadState_ccorres_valid_queues'_simple)
+              apply (wp sts_valid_objs' setThreadState_st_tcb | simp)+
+             apply (ctac add: setThreadState_ccorres_simple)
              apply wp
-            apply ((wp threadSet_valid_queues threadSet_sch_act threadSet_valid_queues' hoare_weak_lift_imp
+            apply ((wp threadSet_sch_act hoare_weak_lift_imp
                        threadSet_valid_objs' threadSet_weak_sch_act_wf
                          | simp add: valid_tcb_state'_def)+)[1]
            apply (clarsimp simp: guard_is_UNIV_def ThreadState_defs mask_def option_to_ctcb_ptr_def)
 
-          apply (rule_tac Q="\<lambda>rv. valid_queues and tcb_at' receiver and valid_queues' and
+          apply (rule_tac Q="\<lambda>rv. tcb_at' receiver and
                                 valid_objs' and sch_act_simple and (\<lambda>s. ksCurDomain s \<le> maxDomain) and
-                                (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)" in hoare_post_imp)
+                                (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and
+                                pspace_aligned' and pspace_distinct'" in hoare_post_imp)
            apply (clarsimp simp: inQ_def weak_sch_act_wf_def)
-          apply (wp threadSet_valid_queues threadSet_sch_act handleFaultReply_sch_act_wf)
+          apply (wp threadSet_sch_act handleFaultReply_sch_act_wf)
          apply (clarsimp simp: guard_is_UNIV_def)
         apply assumption
        apply clarsimp
@@ -4274,7 +4266,7 @@ proof -
        apply (erule(1) cmap_relation_ko_atE [OF cmap_relation_tcb])
        apply (clarsimp simp: ctcb_relation_def typ_heap_simps)
       apply wp
-      apply (strengthen vp_invs_strg' invs_valid_queues')
+      apply (strengthen vp_invs_strg')
       apply (wp cteDeleteOne_tcbFault cteDeleteOne_sch_act_wf)
      apply vcg
     apply (rule conseqPre, vcg)
@@ -4290,7 +4282,6 @@ proof -
                         cap_get_tag_isCap)
   apply fastforce
   done
-qed
 
 lemma ccorres_getCTE_cte_at:
   "ccorresG rf_sr \<Gamma> r xf P P' hs (getCTE p >>= f) c
@@ -4310,7 +4301,7 @@ lemma ccorres_getCTE_cte_at:
   done
 
 lemma setupCallerCap_ccorres [corres]:
-  "ccorres dc xfdc (valid_queues and valid_pspace' and (\<lambda>s. \<forall>d p. sender \<notin> set (ksReadyQueues s (d, p)))
+  "ccorres dc xfdc (valid_pspace'
                     and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and sch_act_not sender
                     and tcb_at' sender and tcb_at' receiver
                     and tcb_at' sender and tcb_at' receiver)
@@ -4442,23 +4433,20 @@ lemma sendIPC_dequeue_ccorres_helper:
                          typ_heap_simps')
         apply (elim conjE)
         apply (intro conjI)
-             \<comment> \<open>tcb relation\<close>
-             apply (erule ctcb_relation_null_queue_ptrs)
-             apply (clarsimp simp: comp_def)
-            \<comment> \<open>ep relation\<close>
-            apply (rule cpspace_relation_ep_update_ep, assumption+)
-             apply (simp add: cendpoint_relation_def Let_def EPState_Idle_def
-                              tcb_queue_relation'_def)
-            apply simp
-           \<comment> \<open>ntfn relation\<close>
-           apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+            \<comment> \<open>tcb relation\<close>
+            apply (erule ctcb_relation_null_ep_ptrs)
+            apply (clarsimp simp: comp_def)
+           \<comment> \<open>ep relation\<close>
+           apply (rule cpspace_relation_ep_update_ep, assumption+)
+            apply (simp add: cendpoint_relation_def Let_def EPState_Idle_def
+                             tcb_queue_relation'_def)
            apply simp
-           apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
-            apply simp
-           apply (erule (1) map_to_ko_atI')
-          \<comment> \<open>queue relation\<close>
-          apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-          apply (clarsimp simp: comp_def)
+          \<comment> \<open>ntfn relation\<close>
+          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+          apply simp
+          apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+           apply simp
+          apply (erule (1) map_to_ko_atI')
          apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs)
         apply (simp add: cmachine_state_relation_def)
        apply (simp add: h_t_valid_clift_Some_iff)
@@ -4482,31 +4470,28 @@ lemma sendIPC_dequeue_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-             \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (rule cpspace_relation_ep_update_ep, assumption+)
-            apply (clarsimp simp: cendpoint_relation_def Let_def
-                                  isRecvEP_def isSendEP_def
-                                  tcb_queue_relation'_def valid_ep'_def
-                       simp flip: canonical_bit_def
-                           split: endpoint.splits list.splits
-                       split del: if_split)
-            apply (subgoal_tac "tcb_at' (if x22 = [] then x21 else last x22) \<sigma>")
-             apply (erule (1) tcb_and_not_mask_canonical[OF invs_pspace_canonical'])
-             apply (simp add: objBits_simps')
-            apply (clarsimp split: if_split)
-           apply simp
-          \<comment> \<open>ntfn relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (rule cpspace_relation_ep_update_ep, assumption+)
+           apply (clarsimp simp: cendpoint_relation_def Let_def
+                                 isRecvEP_def isSendEP_def
+                                 tcb_queue_relation'_def valid_ep'_def
+                      simp flip: canonical_bit_def
+                          split: endpoint.splits list.splits
+                      split del: if_split)
+           apply (subgoal_tac "tcb_at' (if x22 = [] then x21 else last x22) \<sigma>")
+            apply (erule (1) tcb_and_not_mask_canonical[OF invs_pspace_canonical'])
+            apply (simp add: objBits_simps')
+           apply (clarsimp split: if_split)
           apply simp
-          apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
-           apply simp
-          apply (erule (1) map_to_ko_atI')
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         apply (clarsimp simp: comp_def)
+         \<comment> \<open>ntfn relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+          apply simp
+         apply (erule (1) map_to_ko_atI')
         apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs)
        apply (simp add: cmachine_state_relation_def)
       apply (simp add: h_t_valid_clift_Some_iff)
@@ -4531,10 +4516,10 @@ lemma rf_sr_tcb_update_twice:
                 packed_heap_update_collapse_hrs)
 
 lemma sendIPC_block_ccorres_helper:
-  "ccorres dc xfdc (tcb_at' thread and valid_queues and valid_objs' and pspace_canonical' and
+  "ccorres dc xfdc (tcb_at' thread and valid_objs' and pspace_canonical' and
+                    pspace_aligned' and pspace_distinct' and
                     sch_act_not thread and ep_at' epptr and
-                    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s \<and>
-                         (\<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))) and
+                    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and
                     K (bos = ThreadState_BlockedOnSend
                       \<and> epptr' = epptr \<and> badge' = badge
                       \<and> cg = from_bool canGrant \<and> cgr = from_bool canGrantReply
@@ -4593,7 +4578,7 @@ lemma sendIPC_block_ccorres_helper:
        apply ceqv
       apply clarsimp
       apply ctac
-     apply (wp threadSet_weak_sch_act_wf_runnable' threadSet_valid_queues
+     apply (wp threadSet_weak_sch_act_wf_runnable'
                threadSet_valid_objs')
     apply (clarsimp simp: guard_is_UNIV_def)
    apply (clarsimp simp: sch_act_wf_weak valid_tcb'_def valid_tcb_state'_def
@@ -4698,6 +4683,19 @@ lemma tcb_queue_relation_qend_valid':
   apply (simp add: h_t_valid_clift_Some_iff)
   done
 
+lemma tcb_queue'_head_end_NULL:
+  assumes qr: "tcb_queue_relation' getNext getPrev mp queue qhead qend"
+  and   tat: "\<forall>t\<in>set queue. tcb_at' t s"
+  shows "(qend = NULL) = (qhead = NULL)"
+  using qr tat
+  apply -
+  apply (erule tcb_queue_relationE')
+  apply (simp add: tcb_queue_head_empty_iff split: if_splits)
+  apply (rule tcb_at_not_NULL)
+  apply (erule bspec)
+  apply simp
+  done
+
 lemma tcbEPAppend_spec:
   "\<forall>s queue. \<Gamma> \<turnstile> \<lbrace>s. \<exists>t. (t, s) \<in> rf_sr
                       \<and> (\<forall>tcb\<in>set queue. tcb_at' tcb t) \<and> distinct queue
@@ -4820,33 +4818,30 @@ lemma sendIPC_enqueue_ccorres_helper:
        apply (elim conjE)
        apply (intro conjI)
             \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (rule cpspace_relation_ep_update_ep', assumption+)
-            apply (clarsimp simp: cendpoint_relation_def Let_def
-                                  mask_def [where n=3] EPState_Send_def)
-            apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask)
-            apply (rule conjI, simp add: mask_def)
-            subgoal
-              apply (clarsimp simp: valid_pspace'_def objBits_simps' simp flip: canonical_bit_def)
-              apply (erule (1) tcb_and_not_mask_canonical)
-              by (simp (no_asm) add: tcbBlockSizeBits_def)
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (rule cpspace_relation_ep_update_ep', assumption+)
+           apply (clarsimp simp: cendpoint_relation_def Let_def
+                                 mask_def [where n=3] EPState_Send_def)
+           apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask)
+           apply (rule conjI, simp add: mask_def)
+           subgoal
+             apply (clarsimp simp: valid_pspace'_def objBits_simps' simp flip: canonical_bit_def)
+             apply (erule (1) tcb_and_not_mask_canonical)
+             by (simp (no_asm) add: tcbBlockSizeBits_def)
+          apply (simp add: isSendEP_def isRecvEP_def)
+         \<comment> \<open>ntfn relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cnotification_relation_ep_queue, assumption+)
            apply (simp add: isSendEP_def isRecvEP_def)
-          \<comment> \<open>ntfn relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
           apply simp
-          apply (rule cnotification_relation_ep_queue, assumption+)
-            apply (simp add: isSendEP_def isRecvEP_def)
-           apply simp
-          apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
-          apply (erule(2) map_to_ko_at_updI')
-           apply (simp only:projectKOs injectKO_ep objBits_simps)
-           apply clarsimp
-          apply (clarsimp simp: obj_at'_def projectKOs)
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         apply (clarsimp simp: comp_def)
+         apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
+         apply (erule(2) map_to_ko_at_updI')
+          apply (simp only:projectKOs injectKO_ep objBits_simps)
+          apply clarsimp
+         apply (clarsimp simp: obj_at'_def projectKOs)
         apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs)
        apply (simp add: cmachine_state_relation_def)
       apply (simp add: typ_heap_simps')
@@ -4863,42 +4858,39 @@ lemma sendIPC_enqueue_ccorres_helper:
                        typ_heap_simps')
       apply (elim conjE)
       apply (intro conjI)
-           \<comment> \<open>tcb relation\<close>
-           apply (erule ctcb_relation_null_queue_ptrs)
-           apply (clarsimp simp: comp_def)
-          \<comment> \<open>ep relation\<close>
-          apply (rule cpspace_relation_ep_update_ep', assumption+)
-           apply (clarsimp simp: cendpoint_relation_def Let_def
-                                 mask_def [where n=3] EPState_Send_def
-                          split: if_split)
-           subgoal
-             apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask
-                                 valid_ep'_def
-                           dest: tcb_queue_relation_next_not_NULL)
-             apply (rule conjI, clarsimp)
-              apply (rule conjI, fastforce simp: mask_def)
-              apply (clarsimp simp: valid_pspace'_def objBits_simps' simp flip: canonical_bit_def)
-              apply (erule (1) tcb_and_not_mask_canonical)
-              apply (simp (no_asm) add: tcbBlockSizeBits_def)
+          \<comment> \<open>tcb relation\<close>
+          apply (erule ctcb_relation_null_ep_ptrs)
+          apply (clarsimp simp: comp_def)
+         \<comment> \<open>ep relation\<close>
+         apply (rule cpspace_relation_ep_update_ep', assumption+)
+          apply (clarsimp simp: cendpoint_relation_def Let_def
+                                mask_def [where n=3] EPState_Send_def
+                         split: if_split)
+          subgoal
+            apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask
+                                  valid_ep'_def
+                            dest: tcb_queue_relation_next_not_NULL)
+            apply (rule conjI, clarsimp)
+             apply (rule conjI, fastforce simp: mask_def)
              apply (clarsimp simp: valid_pspace'_def objBits_simps' simp flip: canonical_bit_def)
-             apply (rule conjI, solves \<open>simp (no_asm) add: mask_def\<close>)
              apply (erule (1) tcb_and_not_mask_canonical)
              apply (simp (no_asm) add: tcbBlockSizeBits_def)
-             done
+            apply (clarsimp simp: valid_pspace'_def objBits_simps' simp flip: canonical_bit_def)
+            apply (rule conjI, solves \<open>simp (no_asm) add: mask_def\<close>)
+            apply (erule (1) tcb_and_not_mask_canonical)
+            apply (simp (no_asm) add: tcbBlockSizeBits_def)
+            done
+         apply (simp add: isSendEP_def isRecvEP_def)
+        \<comment> \<open>ntfn relation\<close>
+        apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+        apply simp
+        apply (rule cnotification_relation_ep_queue, assumption+)
           apply (simp add: isSendEP_def isRecvEP_def)
-         \<comment> \<open>ntfn relation\<close>
-         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
          apply simp
-         apply (rule cnotification_relation_ep_queue, assumption+)
-           apply (simp add: isSendEP_def isRecvEP_def)
-          apply simp
-         apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
-         apply (erule(2) map_to_ko_at_updI')
-          apply (clarsimp simp: objBitsKO_def)
-         apply (clarsimp simp: obj_at'_def projectKOs)
-        \<comment> \<open>queue relation\<close>
-        apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-        apply (clarsimp simp: comp_def)
+        apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
+        apply (erule(2) map_to_ko_at_updI')
+         apply (clarsimp simp: objBitsKO_def)
+        apply (clarsimp simp: obj_at'_def projectKOs)
        apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs)
       apply (simp add: cmachine_state_relation_def)
      apply (simp add: h_t_valid_clift_Some_iff)
@@ -4918,8 +4910,7 @@ lemma ctcb_relation_blockingIPCCanGrantD:
 
 lemma sendIPC_ccorres [corres]:
   "ccorres dc xfdc (invs' and st_tcb_at' simple' thread
-                          and sch_act_not thread and ep_at' epptr and
-                          (\<lambda>s. \<forall>d p. thread \<notin> set (ksReadyQueues s (d, p))))
+                          and sch_act_not thread and ep_at' epptr)
      (UNIV \<inter> \<lbrace>\<acute>blocking = from_bool blocking\<rbrace>
            \<inter> \<lbrace>\<acute>do_call = from_bool do_call\<rbrace>
            \<inter> \<lbrace>\<acute>badge = badge\<rbrace>
@@ -4950,8 +4941,7 @@ lemma sendIPC_ccorres [corres]:
      apply ceqv
     apply (rule_tac A="invs' and st_tcb_at' simple' thread
                           and sch_act_not thread and ko_at' ep epptr
-                          and ep_at' epptr
-                          and (\<lambda>s. \<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))"
+                          and ep_at' epptr"
                  in ccorres_guard_imp2 [where A'=UNIV])
      apply wpc
        \<comment> \<open>RecvEP case\<close>
@@ -4999,12 +4989,11 @@ lemma sendIPC_ccorres [corres]:
               apply (ctac add: setThreadState_ccorres)
              apply (rule ccorres_return_Skip)
             apply (wpsimp wp: hoare_drop_imps hoare_vcg_all_lift possibleSwitchTo_sch_act_not
-                              possibleSwitchTo_sch_act_not sts_st_tcb'
-                              possibleSwitchTo_ksQ' sts_valid_queues sts_ksQ'
+                              possibleSwitchTo_sch_act_not sts_st_tcb' sts_valid_objs'
                           simp: valid_tcb_state'_def)+
           apply vcg
-         apply (wpsimp wp: doIPCTransfer_sch_act setEndpoint_ksQ hoare_vcg_all_lift
-                          set_ep_valid_objs' setEndpoint_valid_mdb'
+         apply (wpsimp wp: doIPCTransfer_sch_act hoare_vcg_all_lift
+                           set_ep_valid_objs' setEndpoint_valid_mdb'
                 | wp (once) hoare_drop_imp
                 | strengthen sch_act_wf_weak)+
        apply (fastforce simp: guard_is_UNIV_def ThreadState_defs Collect_const_mem mask_def
@@ -5125,10 +5114,10 @@ lemma ctcb_relation_blockingIPCCanGrantReplyD:
   done
 
 lemma receiveIPC_block_ccorres_helper:
-  "ccorres dc xfdc (tcb_at' thread and valid_queues and valid_objs' and pspace_canonical' and
+  "ccorres dc xfdc (tcb_at' thread and valid_objs' and pspace_canonical' and
+                    pspace_aligned' and pspace_distinct' and
                     sch_act_not thread and ep_at' epptr and
-                    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s \<and>
-                     (\<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))) and
+                    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and
                     K (epptr = epptr && ~~ mask 4) and
                     K (isEndpointCap cap \<and> ccap_relation cap cap'))
                    UNIV hs
@@ -5169,7 +5158,7 @@ lemma receiveIPC_block_ccorres_helper:
        apply ceqv
       apply clarsimp
       apply ctac
-     apply (wp threadSet_valid_queues hoare_vcg_all_lift threadSet_valid_objs'
+     apply (wp hoare_vcg_all_lift threadSet_valid_objs'
                threadSet_weak_sch_act_wf_runnable')
     apply (clarsimp simp: guard_is_UNIV_def)
    apply (clarsimp simp: sch_act_wf_weak valid_tcb'_def valid_tcb_state'_def
@@ -5235,42 +5224,38 @@ lemma receiveIPC_enqueue_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-             \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (rule cpspace_relation_ep_update_ep', assumption+)
-            apply (clarsimp simp: cendpoint_relation_def Let_def
-                                  mask_def [where n=3] EPState_Recv_def
-                           split: if_split)
-            subgoal
-              apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask
-                                  valid_ep'_def
-                            dest: tcb_queue_relation_next_not_NULL)
-              apply (rule conjI, clarsimp)
-               apply (rule conjI, fastforce simp: mask_def)
-               apply (clarsimp simp: valid_pspace'_def objBits_simps' simp flip: canonical_bit_def)
-               apply (erule (1) tcb_and_not_mask_canonical)
-               apply (simp (no_asm) add: tcbBlockSizeBits_def)
+            \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (rule cpspace_relation_ep_update_ep', assumption+)
+           apply (clarsimp simp: cendpoint_relation_def Let_def
+                                 mask_def [where n=3] EPState_Recv_def
+                          split: if_split)
+           subgoal
+             apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask valid_ep'_def
+                             dest: tcb_queue_relation_next_not_NULL)
+             apply (rule conjI, clarsimp)
+              apply (rule conjI, fastforce simp: mask_def)
               apply (clarsimp simp: valid_pspace'_def objBits_simps' simp flip: canonical_bit_def)
-              apply (rule conjI, solves \<open>simp (no_asm) add: mask_def\<close>)
               apply (erule (1) tcb_and_not_mask_canonical)
               apply (simp (no_asm) add: tcbBlockSizeBits_def)
-              done
+             apply (clarsimp simp: valid_pspace'_def objBits_simps' simp flip: canonical_bit_def)
+             apply (rule conjI, solves \<open>simp (no_asm) add: mask_def\<close>)
+             apply (erule (1) tcb_and_not_mask_canonical)
+             apply (simp (no_asm) add: tcbBlockSizeBits_def)
+             done
+          apply (simp add: isSendEP_def isRecvEP_def)
+         \<comment> \<open>ntfn relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cnotification_relation_ep_queue, assumption+)
            apply (simp add: isSendEP_def isRecvEP_def)
-          \<comment> \<open>ntfn relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
           apply simp
-          apply (rule cnotification_relation_ep_queue, assumption+)
-            apply (simp add: isSendEP_def isRecvEP_def)
-           apply simp
-          apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
-          apply (erule(2) map_to_ko_at_updI')
-           apply (clarsimp simp: objBitsKO_def)
-          apply (clarsimp simp: obj_at'_def projectKOs)
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         apply (clarsimp simp: comp_def)
+         apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
+         apply (erule(2) map_to_ko_at_updI')
+          apply (clarsimp simp: objBitsKO_def)
+         apply (clarsimp simp: obj_at'_def projectKOs)
         apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs)
        apply (simp add: cmachine_state_relation_def)
       apply (simp add: h_t_valid_clift_Some_iff)
@@ -5287,34 +5272,31 @@ lemma receiveIPC_enqueue_ccorres_helper:
                        typ_heap_simps')
       apply (elim conjE)
       apply (intro conjI)
-           \<comment> \<open>tcb relation\<close>
-           apply (erule ctcb_relation_null_queue_ptrs)
-           apply (clarsimp simp: comp_def)
-          \<comment> \<open>ep relation\<close>
-          apply (rule cpspace_relation_ep_update_ep', assumption+)
-           apply (clarsimp simp: cendpoint_relation_def Let_def
-                                 mask_def [where n=3] EPState_Recv_def)
-           apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask
-                           simp flip: canonical_bit_def)
-           subgoal
-             apply (rule conjI, solves\<open>simp (no_asm) add: mask_def\<close>)
-             apply (clarsimp simp: valid_pspace'_def)
-             apply (erule (1) tcb_and_not_mask_canonical, simp (no_asm) add: tcbBlockSizeBits_def)
-             done
+          \<comment> \<open>tcb relation\<close>
+          apply (erule ctcb_relation_null_ep_ptrs)
+          apply (clarsimp simp: comp_def)
+         \<comment> \<open>ep relation\<close>
+         apply (rule cpspace_relation_ep_update_ep', assumption+)
+          apply (clarsimp simp: cendpoint_relation_def Let_def
+                                mask_def [where n=3] EPState_Recv_def)
+          apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask
+                          simp flip: canonical_bit_def)
+          subgoal
+            apply (rule conjI, solves\<open>simp (no_asm) add: mask_def\<close>)
+            apply (clarsimp simp: valid_pspace'_def)
+            apply (erule (1) tcb_and_not_mask_canonical, simp (no_asm) add: tcbBlockSizeBits_def)
+            done
+         apply (simp add: isSendEP_def isRecvEP_def)
+        \<comment> \<open>ntfn relation\<close>
+        apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+        apply simp
+        apply (rule cnotification_relation_ep_queue, assumption+)
           apply (simp add: isSendEP_def isRecvEP_def)
-         \<comment> \<open>ntfn relation\<close>
-         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
          apply simp
-         apply (rule cnotification_relation_ep_queue, assumption+)
-           apply (simp add: isSendEP_def isRecvEP_def)
-          apply simp
-         apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
-         apply (erule(2) map_to_ko_at_updI')
-          apply (clarsimp simp: objBitsKO_def)
-         apply (clarsimp simp: obj_at'_def projectKOs)
-        \<comment> \<open>queue relation\<close>
-        apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-        apply (clarsimp simp: comp_def)
+        apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
+        apply (erule(2) map_to_ko_at_updI')
+         apply (clarsimp simp: objBitsKO_def)
+        apply (clarsimp simp: obj_at'_def projectKOs)
        apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs)
       apply (simp add: cmachine_state_relation_def)
      apply (simp add: typ_heap_simps')
@@ -5383,23 +5365,20 @@ lemma receiveIPC_dequeue_ccorres_helper:
                          typ_heap_simps')
         apply (elim conjE)
         apply (intro conjI)
-             \<comment> \<open>tcb relation\<close>
-             apply (erule ctcb_relation_null_queue_ptrs)
-             apply (clarsimp simp: comp_def)
-            \<comment> \<open>ep relation\<close>
-            apply (rule cpspace_relation_ep_update_ep, assumption+)
-             apply (simp add: cendpoint_relation_def Let_def EPState_Idle_def
-                              tcb_queue_relation'_def)
-            apply simp
-           \<comment> \<open>ntfn relation\<close>
-           apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-           apply simp
-           apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+            \<comment> \<open>tcb relation\<close>
+            apply (erule ctcb_relation_null_ep_ptrs)
+            apply (clarsimp simp: comp_def)
+           \<comment> \<open>ep relation\<close>
+           apply (rule cpspace_relation_ep_update_ep, assumption+)
+            apply (simp add: cendpoint_relation_def Let_def EPState_Idle_def
+                             tcb_queue_relation'_def)
            apply simp
+          \<comment> \<open>ntfn relation\<close>
+          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+          apply simp
+          apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+          apply simp
           apply (erule (1) map_to_ko_atI')
-          \<comment> \<open>queue relation\<close>
-          apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-          apply (clarsimp simp: comp_def)
          apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs)
         apply (simp add: cmachine_state_relation_def)
        apply (simp add: typ_heap_simps')
@@ -5423,31 +5402,28 @@ lemma receiveIPC_dequeue_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-            \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (rule cpspace_relation_ep_update_ep, assumption+)
-            apply (clarsimp simp: cendpoint_relation_def Let_def
-                                  isRecvEP_def isSendEP_def
-                                  tcb_queue_relation'_def valid_ep'_def
-                       simp flip: canonical_bit_def
-                           split: endpoint.splits list.splits
-                       split del: if_split)
-            apply (subgoal_tac "tcb_at' (if x22 = [] then x21 else last x22) \<sigma>")
-             apply (erule (1) tcb_and_not_mask_canonical[OF invs_pspace_canonical'])
-             apply (clarsimp simp: objBits_simps')
-            apply (clarsimp split: if_split)
-           apply simp
-          \<comment> \<open>ntfn relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (rule cpspace_relation_ep_update_ep, assumption+)
+           apply (clarsimp simp: cendpoint_relation_def Let_def
+                                 isRecvEP_def isSendEP_def
+                                 tcb_queue_relation'_def valid_ep'_def
+                      simp flip: canonical_bit_def
+                          split: endpoint.splits list.splits
+                      split del: if_split)
+           apply (subgoal_tac "tcb_at' (if x22 = [] then x21 else last x22) \<sigma>")
+            apply (erule (1) tcb_and_not_mask_canonical[OF invs_pspace_canonical'])
+            apply (clarsimp simp: objBits_simps')
+           apply (clarsimp split: if_split)
           apply simp
-          apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
-           apply simp
-          apply (erule (1) map_to_ko_atI')
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         apply (clarsimp simp: comp_def)
+         \<comment> \<open>ntfn relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+          apply simp
+         apply (erule (1) map_to_ko_atI')
         apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs)
        apply (simp add: cmachine_state_relation_def)
       apply (simp add: typ_heap_simps')
@@ -5564,7 +5540,6 @@ lemma receiveIPC_ccorres [corres]:
   notes option.case_cong_weak [cong]
   shows
   "ccorres dc xfdc (invs' and st_tcb_at' simple' thread and sch_act_not thread
-                          and (\<lambda>s. \<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))
                           and valid_cap' cap and K (isEndpointCap cap))
      (UNIV \<inter> \<lbrace>\<acute>thread = tcb_ptr_to_ctcb_ptr thread\<rbrace>
            \<inter> \<lbrace>ccap_relation cap \<acute>cap\<rbrace>
@@ -5640,7 +5615,6 @@ lemma receiveIPC_ccorres [corres]:
           apply ceqv
          apply (rule_tac A="invs' and st_tcb_at' simple' thread
                                   and sch_act_not thread
-                              and (\<lambda>s. \<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))
                                   and ko_at' ep (capEPPtr cap)"
                      in ccorres_guard_imp2 [where A'=UNIV])
            apply wpc
@@ -5780,27 +5754,25 @@ lemma receiveIPC_ccorres [corres]:
                  apply ccorres_rewrite
                  apply ctac
                    apply (ctac add: possibleSwitchTo_ccorres)
-                  apply (wpsimp wp: sts_st_tcb' sts_valid_queues)
+                  apply (wpsimp wp: sts_st_tcb' sts_valid_objs')
                  apply (vcg exspec=setThreadState_modifies)
                 apply (fastforce simp: guard_is_UNIV_def ThreadState_defs mask_def
                                        cap_get_tag_isCap ccap_relation_ep_helpers)
                apply (clarsimp simp: valid_tcb_state'_def)
-               apply (rule_tac Q="\<lambda>_. valid_pspace' and valid_queues
+               apply (rule_tac Q="\<lambda>_. valid_pspace'
                                        and st_tcb_at' ((=) sendState) sender and tcb_at' thread
                                        and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)
-                                       and (\<lambda>s. (\<forall>a b. sender \<notin> set (ksReadyQueues s (a, b))))
                                        and sch_act_not sender and K (thread \<noteq> sender)
                                        and (\<lambda>s. ksCurDomain s \<le> maxDomain)" in hoare_post_imp)
-                apply (clarsimp simp: valid_pspace_valid_objs' pred_tcb_at'_def sch_act_wf_weak
-                                      obj_at'_def)
+                apply (fastforce simp: valid_pspace_valid_objs' pred_tcb_at'_def sch_act_wf_weak
+                                       obj_at'_def)
                apply (wpsimp simp: guard_is_UNIV_def option_to_ptr_def option_to_0_def conj_ac)+
-           apply (rule_tac Q="\<lambda>rv. valid_queues and valid_pspace'
+           apply (rule_tac Q="\<lambda>rv. valid_pspace'
                                and cur_tcb' and tcb_at' sender and tcb_at' thread
                                and sch_act_not sender and K (thread \<noteq> sender)
                                and ep_at' (capEPPtr cap)
                                and (\<lambda>s. ksCurDomain s \<le> maxDomain)
-                               and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s \<and>
-                                        (\<forall>d p. sender \<notin> set (ksReadyQueues s (d, p))))"
+                               and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)"
                             in hoare_post_imp)
             subgoal by (auto, auto simp: st_tcb_at'_def obj_at'_def)
            apply (wp hoare_vcg_all_lift set_ep_valid_objs')
@@ -5836,14 +5808,11 @@ lemma receiveIPC_ccorres [corres]:
                                  split: if_split_asm bool.splits) (*very long *)
            apply (clarsimp simp: obj_at'_def state_refs_of'_def projectKOs)
           apply (frule(1) sym_refs_ko_atD' [OF _ invs_sym'])
-          apply (frule invs_queues)
           apply clarsimp
           apply (rename_tac list x xa)
           apply (rule_tac P="x\<in>set list" in case_split)
            apply (clarsimp simp:st_tcb_at_refs_of_rev')
            apply (erule_tac x=x and P="\<lambda>x. st_tcb_at' P x s" for P in ballE)
-            apply (drule_tac t=x in valid_queues_not_runnable'_not_ksQ)
-             apply (clarsimp simp: st_tcb_at'_def obj_at'_def)
             apply (subgoal_tac "sch_act_not x s")
              prefer 2
              apply (frule invs_sch_act_wf')
@@ -5921,23 +5890,20 @@ lemma sendSignal_dequeue_ccorres_helper:
                          typ_heap_simps')
         apply (elim conjE)
         apply (intro conjI)
-             \<comment> \<open>tcb relation\<close>
-             apply (erule ctcb_relation_null_queue_ptrs)
-             apply (clarsimp simp: comp_def)
-            \<comment> \<open>ep relation\<close>
-            apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-            apply simp
-            apply (rule cendpoint_relation_ntfn_queue [OF invs_sym'], assumption+)
-             apply simp+
-            apply (erule (1) map_to_ko_atI')
-           \<comment> \<open>ntfn relation\<close>
-           apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
-            apply (simp add: cnotification_relation_def Let_def NtfnState_Idle_def
-                             tcb_queue_relation'_def)
+            \<comment> \<open>tcb relation\<close>
+            apply (erule ctcb_relation_null_ep_ptrs)
+            apply (clarsimp simp: comp_def)
+           \<comment> \<open>ep relation\<close>
+           apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
            apply simp
-          \<comment> \<open>queue relation\<close>
-          apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-          apply (clarsimp simp: comp_def)
+           apply (rule cendpoint_relation_ntfn_queue [OF invs_sym'], assumption+)
+            apply simp+
+           apply (erule (1) map_to_ko_atI')
+          \<comment> \<open>ntfn relation\<close>
+          apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
+           apply (simp add: cnotification_relation_def Let_def NtfnState_Idle_def
+                            tcb_queue_relation'_def)
+          apply simp
          apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs)
         apply (simp add: cmachine_state_relation_def)
        apply (simp add: h_t_valid_clift_Some_iff)
@@ -5963,33 +5929,30 @@ lemma sendSignal_dequeue_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-            \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-           apply simp
-           apply (rule cendpoint_relation_ntfn_queue [OF invs_sym'], assumption+)
-            apply simp+
-           apply (erule (1) map_to_ko_atI')
-          \<comment> \<open>ntfn relation\<close>
-          apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
-           apply (clarsimp simp: cnotification_relation_def Let_def
-                                 isWaitingNtfn_def
-                                 tcb_queue_relation'_def valid_ntfn'_def
-                          split: Structures_H.notification.splits list.splits
-                      split del: if_split)
-           apply (subgoal_tac "tcb_at' (if x22 = [] then x21 else last x22) \<sigma>")
-            apply (rule conjI)
-             subgoal by (erule (1) tcb_ptr_sign_extend_canonical[OF invs_pspace_canonical'])
-            apply (rule context_conjI)
-             subgoal by (erule (1) tcb_ptr_sign_extend_canonical[OF invs_pspace_canonical'])
-            apply clarsimp
-           apply (clarsimp split: if_split)
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
           apply simp
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         apply (clarsimp simp: comp_def)
+          apply (rule cendpoint_relation_ntfn_queue [OF invs_sym'], assumption+)
+           apply simp+
+          apply (erule (1) map_to_ko_atI')
+         \<comment> \<open>ntfn relation\<close>
+         apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
+          apply (clarsimp simp: cnotification_relation_def Let_def
+                                isWaitingNtfn_def
+                                tcb_queue_relation'_def valid_ntfn'_def
+                         split: Structures_H.notification.splits list.splits
+                     split del: if_split)
+          apply (subgoal_tac "tcb_at' (if x22 = [] then x21 else last x22) \<sigma>")
+           apply (rule conjI)
+            subgoal by (erule (1) tcb_ptr_sign_extend_canonical[OF invs_pspace_canonical'])
+           apply (rule context_conjI)
+            subgoal by (erule (1) tcb_ptr_sign_extend_canonical[OF invs_pspace_canonical'])
+           apply clarsimp
+          apply (clarsimp split: if_split)
+         apply simp
         apply (clarsimp simp: carch_state_relation_def)
        apply (simp add: cmachine_state_relation_def)
       apply (simp add: h_t_valid_clift_Some_iff)
@@ -6096,7 +6059,7 @@ lemma sendSignal_ccorres [corres]:
          apply (ctac(no_vcg) add: setThreadState_ccorres)
           apply (ctac(no_vcg) add: setRegister_ccorres)
            apply (ctac add: possibleSwitchTo_ccorres)
-          apply (wp sts_running_valid_queues sts_st_tcb_at'_cases
+          apply (wp sts_valid_objs' sts_st_tcb_at'_cases
                  | simp add: option_to_ctcb_ptr_def split del: if_split)+
         apply (rule_tac Q="\<lambda>_. tcb_at' (the (ntfnBoundTCB ntfn)) and invs'"
                  in hoare_post_imp)
@@ -6162,10 +6125,8 @@ lemma sendSignal_ccorres [corres]:
        apply (ctac (no_vcg))
         apply (ctac add: possibleSwitchTo_ccorres)
        apply (simp)
-       apply (wp weak_sch_act_wf_lift_linear
-         setThreadState_oa_queued
-         sts_valid_queues tcb_in_cur_domain'_lift)[1]
-      apply (wp sts_valid_queues sts_runnable)
+       apply (wp weak_sch_act_wf_lift_linear tcb_in_cur_domain'_lift)[1]
+      apply (wp sts_valid_objs' sts_runnable)
      apply (wp setThreadState_st_tcb set_ntfn_valid_objs' | clarsimp)+
     apply (clarsimp simp: guard_is_UNIV_def ThreadState_defs mask_def
                           badgeRegister_def C_register_defs
@@ -6190,10 +6151,10 @@ lemma sendSignal_ccorres [corres]:
   done
 
 lemma receiveSignal_block_ccorres_helper:
-  "ccorres dc xfdc (tcb_at' thread and valid_queues and sch_act_not thread and
+  "ccorres dc xfdc (tcb_at' thread and sch_act_not thread and
                     valid_objs' and ntfn_at' ntfnptr and pspace_canonical' and
-                    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s \<and>
-                        (\<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))) and
+                    pspace_aligned' and pspace_distinct' and
+                    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and
                     K (ntfnptr = ntfnptr && ~~ mask 4))
                    UNIV hs
            (setThreadState (Structures_H.thread_state.BlockedOnNotification
@@ -6229,7 +6190,7 @@ lemma receiveSignal_block_ccorres_helper:
        apply ceqv
       apply clarsimp
       apply ctac
-     apply (wp threadSet_valid_queues hoare_vcg_all_lift threadSet_valid_objs'
+     apply (wp hoare_vcg_all_lift threadSet_valid_objs'
                threadSet_weak_sch_act_wf_runnable')
     apply (clarsimp simp: guard_is_UNIV_def)
    apply (auto simp: weak_sch_act_wf_def valid_tcb'_def tcb_cte_cases_def
@@ -6348,37 +6309,34 @@ lemma receiveSignal_enqueue_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-            \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+          apply simp
+          apply (rule cendpoint_relation_ntfn_queue, assumption+)
+            apply (simp add: isWaitingNtfn_def)
            apply simp
-           apply (rule cendpoint_relation_ntfn_queue, assumption+)
-             apply (simp add: isWaitingNtfn_def)
-            apply simp
-           apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
-           apply (erule(2) map_to_ko_at_updI')
-            apply (clarsimp simp: objBitsKO_def)
-           apply (clarsimp simp: obj_at'_def projectKOs)
-          \<comment> \<open>ntfn relation\<close>
-          apply (rule cpspace_relation_ntfn_update_ntfn', assumption+)
-            apply (case_tac "ntfn", simp_all)[1]
-           apply (clarsimp simp: cnotification_relation_def Let_def
-                                 mask_def [where n=3] NtfnState_Waiting_def)
-           subgoal
-             apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask                                valid_ntfn'_def
-                                   dest: tcb_queue_relation_next_not_NULL)
-             apply (rule conjI, fastforce simp: mask_def)
-             apply (rule context_conjI)
-              subgoal by (fastforce simp: valid_pspace'_def objBits_simps'
-                              intro!: tcb_ptr_sign_extend_canonical
-                               dest!: st_tcb_strg'[rule_format])
-             by clarsimp
-          apply (simp add: isWaitingNtfn_def)
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         subgoal by (clarsimp simp: comp_def)
+          apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
+          apply (erule(2) map_to_ko_at_updI')
+           apply (clarsimp simp: objBitsKO_def)
+          apply (clarsimp simp: obj_at'_def projectKOs)
+         \<comment> \<open>ntfn relation\<close>
+         apply (rule cpspace_relation_ntfn_update_ntfn', assumption+)
+           apply (case_tac "ntfn", simp_all)[1]
+          apply (clarsimp simp: cnotification_relation_def Let_def
+                                mask_def [where n=3] NtfnState_Waiting_def)
+          subgoal
+            apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask                                valid_ntfn'_def
+                                  dest: tcb_queue_relation_next_not_NULL)
+            apply (rule conjI, fastforce simp: mask_def)
+            apply (rule context_conjI)
+             subgoal by (fastforce simp: valid_pspace'_def objBits_simps'
+                             intro!: tcb_ptr_sign_extend_canonical
+                              dest!: st_tcb_strg'[rule_format])
+            by clarsimp
+         apply (simp add: isWaitingNtfn_def)
         apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs)
        apply (simp add: cmachine_state_relation_def)
       apply (simp add: h_t_valid_clift_Some_iff)
@@ -6395,49 +6353,46 @@ lemma receiveSignal_enqueue_ccorres_helper:
                        typ_heap_simps')
       apply (elim conjE)
       apply (intro conjI)
-           \<comment> \<open>tcb relation\<close>
-           apply (erule ctcb_relation_null_queue_ptrs)
-           apply (clarsimp simp: comp_def)
-          \<comment> \<open>ep relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+          \<comment> \<open>tcb relation\<close>
+          apply (erule ctcb_relation_null_ep_ptrs)
+          apply (clarsimp simp: comp_def)
+         \<comment> \<open>ep relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cendpoint_relation_ntfn_queue, assumption+)
+           apply (simp add: isWaitingNtfn_def)
           apply simp
-          apply (rule cendpoint_relation_ntfn_queue, assumption+)
-            apply (simp add: isWaitingNtfn_def)
-           apply simp
-          apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
-          apply (erule(2) map_to_ko_at_updI')
-           apply (clarsimp simp: objBitsKO_def)
-          apply (clarsimp simp: obj_at'_def projectKOs)
-         \<comment> \<open>ntfn relation\<close>
-         apply (rule cpspace_relation_ntfn_update_ntfn', assumption+)
-           apply (case_tac "ntfn", simp_all)[1]
-          apply (clarsimp simp: cnotification_relation_def Let_def
-                                mask_def [where n=3] NtfnState_Waiting_def
-                         split: if_split)
-          subgoal for _ _ ko'
-            apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask
-                            dest: tcb_queue_relation_next_not_NULL)
-            apply (rule conjI, clarsimp)
-             apply (rule conjI, fastforce simp: mask_def)
-             apply (rule context_conjI)
-              subgoal by (fastforce intro!: tcb_ptr_sign_extend_canonical
-                                     dest!: st_tcb_strg'[rule_format])
-             apply clarsimp
-            apply clarsimp
+         apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
+         apply (erule(2) map_to_ko_at_updI')
+          apply (clarsimp simp: objBitsKO_def)
+         apply (clarsimp simp: obj_at'_def projectKOs)
+        \<comment> \<open>ntfn relation\<close>
+        apply (rule cpspace_relation_ntfn_update_ntfn', assumption+)
+          apply (case_tac "ntfn", simp_all)[1]
+         apply (clarsimp simp: cnotification_relation_def Let_def
+                               mask_def [where n=3] NtfnState_Waiting_def
+                        split: if_split)
+         subgoal for _ _ ko'
+           apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask
+                           dest: tcb_queue_relation_next_not_NULL)
+           apply (rule conjI, clarsimp)
             apply (rule conjI, fastforce simp: mask_def)
-            apply (rule conjI)
+            apply (rule context_conjI)
              subgoal by (fastforce intro!: tcb_ptr_sign_extend_canonical
                                     dest!: st_tcb_strg'[rule_format])
-            apply (subgoal_tac "canonical_address (ntfnQueue_head_CL (notification_lift ko'))")
-             apply (clarsimp simp: canonical_address_sign_extended sign_extended_iff_sign_extend)
-            apply (clarsimp simp: notification_lift_def canonical_address_sign_extended
-                                  sign_extended_sign_extend
-                            simp flip: canonical_bit_def)
-            done
-         apply (simp add: isWaitingNtfn_def)
-        \<comment> \<open>queue relation\<close>
-        apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-        apply (clarsimp simp: comp_def)
+            apply clarsimp
+           apply clarsimp
+           apply (rule conjI, fastforce simp: mask_def)
+           apply (rule conjI)
+            subgoal by (fastforce intro!: tcb_ptr_sign_extend_canonical
+                                   dest!: st_tcb_strg'[rule_format])
+           apply (subgoal_tac "canonical_address (ntfnQueue_head_CL (notification_lift ko'))")
+            apply (clarsimp simp: canonical_address_sign_extended sign_extended_iff_sign_extend)
+           apply (clarsimp simp: notification_lift_def canonical_address_sign_extended
+                                 sign_extended_sign_extend
+                           simp flip: canonical_bit_def)
+           done
+        apply (simp add: isWaitingNtfn_def)
        apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs)
       apply (simp add: cmachine_state_relation_def)
      apply (simp add: h_t_valid_clift_Some_iff)
@@ -6449,7 +6404,6 @@ lemma receiveSignal_enqueue_ccorres_helper:
 lemma receiveSignal_ccorres [corres]:
   "ccorres dc xfdc (invs' and valid_cap' cap and st_tcb_at' simple' thread
                     and sch_act_not thread
-                    and (\<lambda>s. \<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))
                     and K (isNotificationCap cap))
      (UNIV \<inter> \<lbrace>\<acute>thread = tcb_ptr_to_ctcb_ptr thread\<rbrace>
            \<inter> \<lbrace>ccap_relation cap \<acute>cap\<rbrace>
diff --git a/proof/crefine/RISCV64/IsolatedThreadAction.thy b/proof/crefine/RISCV64/IsolatedThreadAction.thy
index 96b7886d3d..0c5bd15952 100644
--- a/proof/crefine/RISCV64/IsolatedThreadAction.thy
+++ b/proof/crefine/RISCV64/IsolatedThreadAction.thy
@@ -68,12 +68,12 @@ lemma put_tcb_state_regs_twice[simp]:
   "put_tcb_state_regs tsr (put_tcb_state_regs tsr' tcb)
     = put_tcb_state_regs tsr tcb"
   apply (simp add: put_tcb_state_regs_def put_tcb_state_regs_tcb_def
-                   atcbContextSet_def
-                   makeObject_tcb newArchTCB_def newContext_def initContext_def
+                   makeObject_tcb newArchTCB_def
             split: tcb_state_regs.split option.split
                    Structures_H.kernel_object.split)
   apply (intro all_tcbI impI allI)
-  apply (case_tac q, simp)
+   using atcbContextSet_def atcbContext_set_set
+   apply fastforce+
   done
 
 lemma partial_overwrite_twice[simp]:
@@ -914,9 +914,11 @@ lemma oblivious_switchToThread_schact:
                    threadSet_def tcbSchedEnqueue_def unless_when asUser_def
                    getQueue_def setQueue_def storeWordUser_def setRegister_def
                    pointerInUserData_def isRunnable_def isStopped_def
-                   getThreadState_def tcbSchedDequeue_def bitmap_fun_defs)
+                   getThreadState_def tcbSchedDequeue_def tcbQueueRemove_def bitmap_fun_defs
+                   ksReadyQueues_asrt_def)
   by (safe intro!: oblivious_bind
-              | simp_all add: oblivious_setVMRoot_schact)+
+              | simp_all add: ready_qs_runnable_def idleThreadNotQueued_def
+                              oblivious_setVMRoot_schact)+
 
 (* FIXME move *)
 lemma empty_fail_getCurThread[intro!, wp, simp]:
@@ -956,9 +958,7 @@ lemma tcbSchedEnqueue_tcbPriority[wp]:
   done
 
 crunch obj_at_prio[wp]: cteDeleteOne "obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t"
-  (wp: crunch_wps setEndpoint_obj_at'_tcb
-       setThreadState_obj_at_unchanged setNotification_tcb setBoundNotification_obj_at_unchanged
-        simp: crunch_simps unless_def)
+  (wp: crunch_wps setEndpoint_obj_at'_tcb setNotification_tcb simp: crunch_simps unless_def)
 
 lemma setThreadState_no_sch_change:
   "\<lbrace>\<lambda>s. P (ksSchedulerAction s) \<and> (runnable' st \<or> t \<noteq> ksCurThread s)\<rbrace>
@@ -1077,8 +1077,6 @@ lemma setCTE_assert_modify:
        apply (rule word_and_le2)
       apply (simp add: objBits_simps mask_def field_simps)
      apply (simp add: simpler_modify_def cong: option.case_cong if_cong)
-     apply (rule kernel_state.fold_congs[OF refl refl])
-     apply (clarsimp simp: projectKO_opt_tcb cong: if_cong)
     apply (clarsimp simp: lookupAround2_char1 word_and_le2)
     apply (rule ccontr, clarsimp)
     apply (erule(2) ps_clearD)
@@ -1095,7 +1093,7 @@ lemma setCTE_assert_modify:
    apply (erule disjE)
     apply clarsimp
     apply (frule(1) tcb_cte_cases_aligned_helpers)
-    apply (clarsimp simp: domI[where m = cte_cte_cases] field_simps)
+    apply (clarsimp simp: domI field_simps)
     apply (clarsimp simp: lookupAround2_char1 obj_at'_def projectKOs
                           objBits_simps)
    apply (clarsimp simp: obj_at'_def lookupAround2_char1
@@ -1221,11 +1219,14 @@ lemma thread_actions_isolatableD:
 lemma tcbSchedDequeue_rewrite:
   "monadic_rewrite True True (obj_at' (Not \<circ> tcbQueued) t) (tcbSchedDequeue t) (return ())"
   apply (simp add: tcbSchedDequeue_def)
-   apply (wp_pre, monadic_rewrite_symb_exec_l_known False, simp)
-    apply (rule monadic_rewrite_refl)
-   apply (wpsimp wp: threadGet_const)+
+  apply wp_pre
+  apply monadic_rewrite_symb_exec_l
+    apply (monadic_rewrite_symb_exec_l_known False, simp)
+     apply (rule monadic_rewrite_refl)
+    apply (wpsimp wp: threadGet_const)+
   done
 
+(* FIXME: improve automation here *)
 lemma switchToThread_rewrite:
   "monadic_rewrite True True
        (ct_in_state' (Not \<circ> runnable') and cur_tcb' and obj_at' (Not \<circ> tcbQueued) t)
@@ -1233,7 +1234,9 @@ lemma switchToThread_rewrite:
        (do Arch.switchToThread t; setCurThread t od)"
   apply (simp add: switchToThread_def Thread_H.switchToThread_def)
   apply (monadic_rewrite_l tcbSchedDequeue_rewrite, simp)
-   apply (rule monadic_rewrite_refl)
+   (* strip LHS of getters and asserts until LHS and RHS are the same *)
+   apply (repeat_unless \<open>rule monadic_rewrite_refl\<close> monadic_rewrite_symb_exec_l)
+      apply wpsimp+
   apply (clarsimp simp: comp_def)
   done
 
@@ -1271,9 +1274,33 @@ lemma threadGet_isolatable:
                thread_actions_isolatable_fail)
   done
 
+lemma tcbQueued_put_tcb_state_regs_tcb:
+  "tcbQueued (put_tcb_state_regs_tcb tsr tcb) = tcbQueued tcb"
+  apply (clarsimp simp: put_tcb_state_regs_tcb_def)
+  by (cases tsr; clarsimp)
+
+lemma idleThreadNotQueued_isolatable:
+  "thread_actions_isolatable idx (stateAssert idleThreadNotQueued [])"
+  apply (simp add: stateAssert_def2 stateAssert_def)
+  apply (intro thread_actions_isolatable_bind[OF _ _ hoare_pre(1)]
+               gets_isolatable
+               thread_actions_isolatable_if
+               thread_actions_isolatable_returns
+               thread_actions_isolatable_fail)
+    unfolding idleThreadNotQueued_def
+    apply (clarsimp simp: obj_at_partial_overwrite_If)
+    apply (clarsimp simp: obj_at'_def tcbQueued_put_tcb_state_regs_tcb)
+   apply wpsimp+
+  done
+
 lemma setCurThread_isolatable:
   "thread_actions_isolatable idx (setCurThread t)"
-  by (simp add: setCurThread_def modify_isolatable)
+  unfolding setCurThread_def
+  apply (rule thread_actions_isolatable_bind)
+    apply (rule idleThreadNotQueued_isolatable)
+   apply (fastforce intro: modify_isolatable)
+  apply wpsimp
+  done
 
 lemma isolate_thread_actions_tcbs_at:
   assumes f: "\<And>x. \<lbrace>tcb_at' (idx x)\<rbrace> f \<lbrace>\<lambda>rv. tcb_at' (idx x)\<rbrace>" shows
diff --git a/proof/crefine/RISCV64/Recycle_C.thy b/proof/crefine/RISCV64/Recycle_C.thy
index f1564bcc83..dc3d306d2e 100644
--- a/proof/crefine/RISCV64/Recycle_C.thy
+++ b/proof/crefine/RISCV64/Recycle_C.thy
@@ -774,16 +774,6 @@ lemma cnotification_relation_q_cong:
   apply (auto intro: iffD1[OF tcb_queue_relation'_cong[OF refl refl refl]])
   done
 
-lemma tcbSchedEnqueue_ep_at:
-  "\<lbrace>obj_at' (P :: endpoint \<Rightarrow> bool) ep\<rbrace>
-      tcbSchedEnqueue t
-   \<lbrace>\<lambda>rv. obj_at' P ep\<rbrace>"
-  including no_pre
-  apply (simp add: tcbSchedEnqueue_def unless_def null_def)
-  apply (wp threadGet_wp, clarsimp, wp+)
-  apply (clarsimp split: if_split, wp)
-  done
-
 lemma ccorres_duplicate_guard:
   "ccorres r xf (P and P) Q hs f f' \<Longrightarrow> ccorres r xf P Q hs f f'"
   by (erule ccorres_guard_imp, auto)
@@ -803,10 +793,11 @@ lemma cancelBadgedSends_ccorres:
               (UNIV \<inter> {s. epptr_' s = Ptr ptr} \<inter> {s. badge_' s = bdg}) []
        (cancelBadgedSends ptr bdg) (Call cancelBadgedSends_'proc)"
   apply (cinit lift: epptr_' badge_' simp: whileAnno_def)
+   apply (rule ccorres_stateAssert)
    apply (simp add: list_case_return
               cong: list.case_cong Structures_H.endpoint.case_cong call_ignore_cong
                del: Collect_const)
-   apply (rule ccorres_pre_getEndpoint)
+   apply (rule ccorres_pre_getEndpoint, rename_tac ep)
    apply (rule_tac R="ko_at' ep ptr" and xf'="ret__unsigned_longlong_'"
                and val="case ep of RecvEP q \<Rightarrow> scast EPState_Recv | IdleEP \<Rightarrow> scast EPState_Idle
                                 | SendEP q \<Rightarrow> scast EPState_Send"
@@ -855,8 +846,9 @@ lemma cancelBadgedSends_ccorres:
                    st_tcb_at' (\<lambda>st. isBlockedOnSend st \<and> blockingObject st = ptr) x s)
                               \<and> distinct (xs @ list) \<and> ko_at' IdleEP ptr s
                               \<and> (\<forall>p. \<forall>x \<in> set (xs @ list). \<forall>rf. (x, rf) \<notin> {r \<in> state_refs_of' s p. snd r \<noteq> NTFNBound})
-                              \<and> valid_queues s \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_canonical' s
-                              \<and> sch_act_wf (ksSchedulerAction s) s \<and> valid_objs' s"
+                              \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_canonical' s
+                              \<and> sch_act_wf (ksSchedulerAction s) s \<and> valid_objs' s
+                              \<and> ksReadyQueues_head_end s \<and> ksReadyQueues_head_end_tcb_at' s"
                      and P'="\<lambda>xs. {s. ep_queue_relation' (cslift s) (xs @ list)
                                          (head_C (queue_' s)) (end_C (queue_' s))}
                                 \<inter> {s. thread_' s = (case list of [] \<Rightarrow> tcb_Ptr 0
@@ -956,8 +948,9 @@ lemma cancelBadgedSends_ccorres:
                    apply (rule_tac rrel=dc and xf=xfdc
                                and P="\<lambda>s. (\<forall>t \<in> set (x @ a # lista). tcb_at' t s)
                                           \<and> (\<forall>p. \<forall>t \<in> set (x @ a # lista). \<forall>rf. (t, rf) \<notin> {r \<in> state_refs_of' s p. snd r \<noteq> NTFNBound})
-                                          \<and> valid_queues s \<and> distinct (x @ a # lista)
-                                          \<and> pspace_aligned' s \<and> pspace_distinct' s"
+                                          \<and> distinct (x @ a # lista)
+                                          \<and> pspace_aligned' s \<and> pspace_distinct' s
+                                          \<and> ksReadyQueues_head_end s \<and> ksReadyQueues_head_end_tcb_at' s"
                               and P'="{s. ep_queue_relation' (cslift s) (x @ a # lista)
                                            (head_C (queue_' s)) (end_C (queue_' s))}"
                                in ccorres_from_vcg)
@@ -973,8 +966,7 @@ lemma cancelBadgedSends_ccorres:
                    apply (clarsimp simp: return_def rf_sr_def cstate_relation_def Let_def)
                    apply (rule conjI)
                     apply (clarsimp simp: cpspace_relation_def)
-                    apply (rule conjI, erule ctcb_relation_null_queue_ptrs)
-                     apply (rule null_ep_queue)
+                    apply (rule conjI, erule ctcb_relation_null_ep_ptrs)
                      subgoal by (simp add: o_def)
                     apply (rule conjI)
                      apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
@@ -997,9 +989,6 @@ lemma cancelBadgedSends_ccorres:
                     apply (clarsimp simp: image_iff)
                     apply (drule_tac x=p in spec)
                     subgoal by fastforce
-                   apply (rule conjI)
-                    apply (erule cready_queues_relation_not_queue_ptrs,
-                           auto dest: null_ep_schedD[unfolded o_def] simp: o_def)[1]
                    apply (clarsimp simp: carch_state_relation_def cmachine_state_relation_def)
                   apply (rule ccorres_symb_exec_r2)
                     apply (erule spec)
@@ -1008,12 +997,11 @@ lemma cancelBadgedSends_ccorres:
                  apply wp
                 apply simp
                 apply vcg
-               apply (wp hoare_vcg_const_Ball_lift tcbSchedEnqueue_ep_at
-                         sch_act_wf_lift)
+               apply (wp hoare_vcg_const_Ball_lift sch_act_wf_lift)
               apply simp
               apply (vcg exspec=tcbSchedEnqueue_cslift_spec)
              apply (wp hoare_vcg_const_Ball_lift sts_st_tcb_at'_cases
-                       sts_sch_act sts_valid_queues setThreadState_oa_queued)
+                       sts_sch_act sts_valid_objs')
             apply (vcg exspec=setThreadState_cslift_spec)
            apply (simp add: ccorres_cond_iffs)
            apply (rule ccorres_symb_exec_r2)
@@ -1037,14 +1025,11 @@ lemma cancelBadgedSends_ccorres:
            apply (clarsimp simp: cscheduler_action_relation_def st_tcb_at'_def
                           split: scheduler_action.split_asm)
            apply (rename_tac word)
-           apply (frule_tac x=word in tcbSchedEnqueue_cslift_precond_discharge)
-              apply simp
-             subgoal by clarsimp
-            subgoal by clarsimp
+           apply (frule_tac x=word in tcbSchedEnqueue_cslift_precond_discharge; simp?)
            subgoal by clarsimp
           apply clarsimp
           apply (rule conjI)
-           apply (frule(3) tcbSchedEnqueue_cslift_precond_discharge)
+           apply (frule tcbSchedEnqueue_cslift_precond_discharge; simp?)
            subgoal by clarsimp
           apply clarsimp
           apply (rule context_conjI)
@@ -1084,9 +1069,19 @@ lemma cancelBadgedSends_ccorres:
    apply (clarsimp split: if_split)
    apply (drule sym_refsD, clarsimp)
    apply (drule(1) bspec)+
-   by (auto simp: obj_at'_def projectKOs state_refs_of'_def pred_tcb_at'_def tcb_bound_refs'_def
-              dest!: symreftype_inverse')
-
+   apply (frule ksReadyQueues_asrt_ksReadyQueues_head_end)
+   apply (frule invs_pspace_aligned')
+   apply (frule invs_pspace_distinct')
+   apply (frule (2) ksReadyQueues_asrt_ksReadyQueues_head_end_tcb_at')
+   apply (fastforce simp: obj_at'_def projectKOs state_refs_of'_def pred_tcb_at'_def
+                          tcb_bound_refs'_def
+                   dest!: symreftype_inverse')
+  apply (frule ksReadyQueues_asrt_ksReadyQueues_head_end)
+  apply (frule invs_pspace_aligned')
+  apply (frule invs_pspace_distinct')
+  apply (frule (2) ksReadyQueues_asrt_ksReadyQueues_head_end_tcb_at')
+  apply fastforce
+  done
 
 lemma tcb_ptr_to_ctcb_ptr_force_fold:
   "x + 2 ^ ctcb_size_bits = ptr_val (tcb_ptr_to_ctcb_ptr x)"
diff --git a/proof/crefine/RISCV64/Refine_C.thy b/proof/crefine/RISCV64/Refine_C.thy
index 1eeb2d9b3b..6dec83c176 100644
--- a/proof/crefine/RISCV64/Refine_C.thy
+++ b/proof/crefine/RISCV64/Refine_C.thy
@@ -64,7 +64,7 @@ proof -
          apply (rule allI, rule conseqPre, vcg)
          apply (clarsimp simp: return_def)
         apply (wp schedule_sch_act_wf schedule_invs'
-             | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+             | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
       apply vcg
      apply vcg
     apply (clarsimp simp: irqInvalid_def ucast_8_32_neq Kernel_C.irqInvalid_def)
@@ -77,7 +77,7 @@ proof -
        apply (rule allI, rule conseqPre, vcg)
        apply (clarsimp simp: return_def)
       apply (wp schedule_sch_act_wf schedule_invs'
-             | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+             | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
    apply (rule_tac Q="\<lambda>rv s. invs' s \<and> (\<forall>x. rv = Some x \<longrightarrow> x \<le> RISCV64.maxIRQ) \<and> rv \<noteq> Some 0x3FF" in hoare_post_imp)
     apply (clarsimp simp: non_kernel_IRQs_def)
    apply (wp getActiveIRQ_le_maxIRQ getActiveIRQ_neq_Some0x3FF | simp)+
@@ -106,14 +106,12 @@ lemma handleUnknownSyscall_ccorres:
          apply (rule allI, rule conseqPre, vcg)
         apply (clarsimp simp: return_def)
        apply (wp schedule_sch_act_wf schedule_invs'
-              | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+              | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
     apply (clarsimp, vcg)
    apply (clarsimp, rule conseqPre, vcg, clarsimp)
   apply clarsimp
   apply (intro impI conjI allI)
-      apply fastforce
-     apply (clarsimp simp: ct_not_ksQ)
-    apply (clarsimp simp add: sch_act_simple_def split: scheduler_action.split)
+    apply fastforce
    apply (rule active_ex_cap')
     apply (erule active_from_running')
    apply (erule invs_iflive')
@@ -163,13 +161,13 @@ lemma handleVMFaultEvent_ccorres:
        apply (rule allI, rule conseqPre, vcg)
        apply (clarsimp simp: return_def)
       apply (wp schedule_sch_act_wf schedule_invs'
-             | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+             | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
      apply (case_tac x, clarsimp, wp)
      apply (clarsimp, wp, simp)
     apply wp
    apply (simp add: guard_is_UNIV_def)
   apply (clarsimp simp: simple_sane_strg[unfolded sch_act_sane_not])
-  apply (auto simp: ct_in_state'_def cfault_rel_def is_cap_fault_def ct_not_ksQ
+  apply (auto simp: ct_in_state'_def cfault_rel_def is_cap_fault_def
               elim: pred_tcb'_weakenE st_tcb_ex_cap''
               dest: st_tcb_at_idle_thread' rf_sr_ksCurThread)
   done
@@ -195,16 +193,14 @@ lemma handleUserLevelFault_ccorres:
         apply (rule allI, rule conseqPre, vcg)
         apply (clarsimp simp: return_def)
        apply (wp schedule_sch_act_wf schedule_invs'
-              | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+              | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
     apply (clarsimp, vcg)
    apply (clarsimp, rule conseqPre, vcg, clarsimp)
   apply clarsimp
   apply (intro impI conjI allI)
-      apply (simp add: ct_in_state'_def)
-      apply (erule pred_tcb'_weakenE)
-      apply simp
-     apply (clarsimp simp: ct_not_ksQ)
-    apply (clarsimp simp add: sch_act_simple_def split: scheduler_action.split)
+    apply (simp add: ct_in_state'_def)
+    apply (erule pred_tcb'_weakenE)
+    apply simp
    apply (rule active_ex_cap')
     apply (erule active_from_running')
    apply (erule invs_iflive')
@@ -377,11 +373,10 @@ lemma handleSyscall_ccorres:
           apply wp[1]
          apply clarsimp
          apply wp
-         apply (rule_tac Q="\<lambda>rv s. ct_in_state' simple' s \<and> sch_act_sane s \<and>
-                            (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))"
+         apply (rule_tac Q="\<lambda>rv s. ct_in_state' simple' s \<and> sch_act_sane s"
                               in hoare_post_imp)
           apply (simp add: ct_in_state'_def)
-         apply (wp handleReply_sane handleReply_ct_not_ksQ)
+         apply (wp handleReply_sane)
         \<comment> \<open>SysYield\<close>
         apply (clarsimp simp: syscall_from_H_def syscall_defs)
         apply (rule ccorres_cond_empty |rule ccorres_cond_univ)+
@@ -407,11 +402,11 @@ lemma handleSyscall_ccorres:
        apply (rule_tac P=\<top> and P'=UNIV in ccorres_from_vcg_throws)
        apply (rule allI, rule conseqPre, vcg)
        apply (clarsimp simp: return_def)
-      apply (wp schedule_invs' schedule_sch_act_wf | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+      apply (wp schedule_invs' schedule_sch_act_wf
+             | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
      apply (simp
           | wpc
           | wp hoare_drop_imp handleReply_sane handleReply_nonz_cap_to_ct schedule_invs'
-               handleReply_ct_not_ksQ[simplified]
           | strengthen ct_active_not_idle'_strengthen invs_valid_objs_strengthen)+
       apply (rule_tac  Q="\<lambda>rv. invs' and ct_active'" in hoare_post_imp, simp)
       apply (wp hy_invs')
@@ -429,7 +424,7 @@ lemma handleSyscall_ccorres:
   apply (frule active_ex_cap')
    apply (clarsimp simp: invs'_def valid_state'_def)
   apply (clarsimp simp: simple_sane_strg ct_in_state'_def st_tcb_at'_def obj_at'_def
-                        isReply_def ct_not_ksQ irqInvalid_def Kernel_C.irqInvalid_def)
+                        isReply_def irqInvalid_def Kernel_C.irqInvalid_def)
   apply (auto simp: syscall_from_H_def Kernel_C.SysSend_def
               split: option.split_asm)
   done
@@ -516,7 +511,7 @@ lemma handleHypervisorEvent_ccorres:
          apply simp
         apply assumption
        apply (wp schedule_sch_act_wf schedule_invs'
-              | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+              | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
     apply clarsimp+
   done
 
@@ -648,7 +643,7 @@ lemma threadSet_all_invs_triv':
     apply (wp thread_set_invs_trivial thread_set_ct_running thread_set_not_state_valid_sched
               threadSet_invs_trivial threadSet_ct_running' hoare_weak_lift_imp
               thread_set_ct_in_state
-           | simp add: tcb_cap_cases_def tcb_arch_ref_def
+           | simp add: tcb_cap_cases_def tcb_arch_ref_def exst_same_def
            | rule threadSet_ct_in_state'
            | wp (once) hoare_vcg_disj_lift)+
   apply clarsimp
@@ -869,17 +864,22 @@ lemma dmo_domain_user_mem'[wp]:
   done
 
 lemma do_user_op_corres_C:
-  "corres_underlying rf_sr False False (=) (invs' and ex_abs einvs) \<top>
-                     (doUserOp f tc) (doUserOp_C f tc)"
+  "corres_underlying rf_sr False False (=)
+     (invs' and ksReadyQueues_asrt and ex_abs einvs) \<top>
+     (doUserOp f tc) (doUserOp_C f tc)"
   apply (simp only: doUserOp_C_def doUserOp_def split_def)
   apply (rule corres_guard_imp)
     apply (rule_tac P=\<top> and P'=\<top> and r'="(=)" in corres_split)
        apply (clarsimp simp: simpler_gets_def getCurThread_def
                 corres_underlying_def rf_sr_def cstate_relation_def Let_def)
-      apply (rule_tac P=valid_state' and P'=\<top> and r'="(=)" in corres_split)
+      apply (rule_tac P="valid_state' and ksReadyQueues_asrt"
+                  and P'=\<top> and r'="(=)"
+                   in corres_split)
          apply (clarsimp simp: cstate_to_A_def absKState_def
                                rf_sr_def cstate_to_H_correct ptable_lift_def)
-        apply (rule_tac P=valid_state' and P'=\<top> and r'="(=)" in corres_split)
+        apply (rule_tac P="valid_state' and ksReadyQueues_asrt"
+                    and P'=\<top> and r'="(=)"
+                     in corres_split)
            apply (clarsimp simp: cstate_to_A_def absKState_def
                                  rf_sr_def cstate_to_H_correct ptable_rights_def)
           apply (rule_tac P=pspace_distinct' and P'=\<top> and r'="(=)"
@@ -977,6 +977,9 @@ lemma refinement2_both:
     apply (subst cstate_to_H_correct)
      apply (fastforce simp: full_invs'_def invs'_def)
     apply (clarsimp simp: rf_sr_def)
+    apply (clarsimp simp: lift_state_relation_def full_invs_def)
+    apply (rule ksReadyQueues_asrt_cross)
+    apply (erule state_relation_ready_queues_relation)
    apply (simp add:absKState_def observable_memory_def absExst_def)
    apply (rule MachineTypes.machine_state.equality,simp_all)[1]
    apply (rule ext)
@@ -1003,13 +1006,35 @@ lemma refinement2_both:
    apply (clarsimp simp add: do_user_op_C_def do_user_op_H_def monad_to_transition_def)
    apply (rule rev_mp, rule_tac f="uop" and tc=af in do_user_op_corres_C)
    apply (clarsimp simp: corres_underlying_def invs_def ex_abs_def)
-   apply (fastforce simp: full_invs'_def ex_abs_def)
+   apply (drule bspec)
+    apply fastforce
+   apply clarsimp
+   apply (elim impE)
+    apply (clarsimp simp: full_invs'_def ex_abs_def)
+    apply (intro conjI)
+     apply (rule ksReadyQueues_asrt_cross)
+     apply (erule state_relation_ready_queues_relation)
+    apply (clarsimp simp: lift_state_relation_def full_invs_def)
+    apply (frule state_relation_ready_queues_relation)
+    apply (fastforce simp: ready_queues_relation_def Let_def tcbQueueEmpty_def)
+   apply fastforce
 
   apply (erule_tac P="a \<and> b \<and> c \<and> (\<exists>x. e x)" for a b c d e in disjE)
    apply (clarsimp simp add: do_user_op_C_def do_user_op_H_def monad_to_transition_def)
    apply (rule rev_mp, rule_tac f="uop" and tc=af in do_user_op_corres_C)
    apply (clarsimp simp: corres_underlying_def invs_def ex_abs_def)
-   apply (fastforce simp: full_invs'_def ex_abs_def)
+   apply (drule bspec)
+    apply fastforce
+   apply clarsimp
+   apply (elim impE)
+    apply (clarsimp simp: full_invs'_def ex_abs_def)
+    apply (intro conjI)
+     apply (rule ksReadyQueues_asrt_cross)
+     apply (erule state_relation_ready_queues_relation)
+    apply (clarsimp simp: lift_state_relation_def full_invs_def)
+    apply (frule state_relation_ready_queues_relation)
+    apply (fastforce simp: ready_queues_relation_def Let_def tcbQueueEmpty_def)
+   apply fastforce
 
   apply (clarsimp simp: check_active_irq_C_def check_active_irq_H_def)
   apply (rule rev_mp, rule check_active_irq_corres_C)
diff --git a/proof/crefine/RISCV64/Retype_C.thy b/proof/crefine/RISCV64/Retype_C.thy
index 9a2bc7f66f..c5001d8e53 100644
--- a/proof/crefine/RISCV64/Retype_C.thy
+++ b/proof/crefine/RISCV64/Retype_C.thy
@@ -2950,7 +2950,6 @@ lemma cnc_tcb_helper:
   assumes rfsr: "(\<sigma>\<lparr>ksPSpace := ks\<rparr>, x) \<in> rf_sr"
   assumes al: "is_aligned (ctcb_ptr_to_tcb_ptr p) (objBitsKO kotcb)"
   assumes ptr0: "ctcb_ptr_to_tcb_ptr p \<noteq> 0"
-  assumes vq: "valid_queues \<sigma>"
   assumes pal: "pspace_aligned' (\<sigma>\<lparr>ksPSpace := ks\<rparr>)"
   assumes pno: "pspace_no_overlap' (ctcb_ptr_to_tcb_ptr p) (objBitsKO kotcb) (\<sigma>\<lparr>ksPSpace := ks\<rparr>)"
   assumes pds: "pspace_distinct' (\<sigma>\<lparr>ksPSpace := ks\<rparr>)"
@@ -3308,20 +3307,20 @@ proof -
     unfolding ctcb_relation_def makeObject_tcb heap_updates_defs initContext_registers_def
     apply (simp add: fbtcb minBound_word)
     apply (intro conjI)
-        apply (simp add: cthread_state_relation_def thread_state_lift_def
-                         eval_nat_numeral ThreadState_defs)
-       apply (clarsimp simp: ccontext_relation_def newContext_def2 carch_tcb_relation_def
-                             newArchTCB_def cregs_relation_def atcbContextGet_def)
-       apply (case_tac r; simp add: C_register_defs index_foldr_update
-                                    atcbContext_def newArchTCB_def newContext_def
-                                    initContext_def)
-       apply (clarsimp)
-      apply (simp add: thread_state_lift_def index_foldr_update atcbContextGet_def)
-     apply (simp add: Kernel_Config.timeSlice_def)
-    apply (simp add: cfault_rel_def seL4_Fault_lift_def seL4_Fault_get_tag_def Let_def
-                     lookup_fault_lift_def lookup_fault_get_tag_def lookup_fault_invalid_root_def
-                     index_foldr_update seL4_Fault_NullFault_def option_to_ptr_def option_to_0_def
-              split: if_split)+
+         apply (simp add: cthread_state_relation_def thread_state_lift_def
+                          eval_nat_numeral ThreadState_defs)
+        apply (clarsimp simp: ccontext_relation_def newContext_def2 carch_tcb_relation_def
+                              newArchTCB_def cregs_relation_def atcbContextGet_def)
+        apply (case_tac r; simp add: C_register_defs index_foldr_update
+                                     atcbContext_def newArchTCB_def newContext_def
+                                     initContext_def)
+       apply (simp add: thread_state_lift_def index_foldr_update atcbContextGet_def)
+      apply (simp add: Kernel_Config.timeSlice_def)
+     apply (simp add: cfault_rel_def seL4_Fault_lift_def seL4_Fault_get_tag_def Let_def
+                      lookup_fault_lift_def lookup_fault_get_tag_def lookup_fault_invalid_root_def
+                      index_foldr_update seL4_Fault_NullFault_def option_to_ptr_def option_to_0_def
+               split: if_split)+
+    apply (simp add: option_to_ctcb_ptr_def)
     done
 
   have pks: "ks (ctcb_ptr_to_tcb_ptr p) = None"
@@ -3372,15 +3371,6 @@ proof -
     apply (fastforce simp: dom_def)
     done
 
-  hence kstcb: "\<And>qdom prio. ctcb_ptr_to_tcb_ptr p \<notin> set (ksReadyQueues \<sigma> (qdom, prio))" using vq
-    apply (clarsimp simp add: valid_queues_def valid_queues_no_bitmap_def)
-    apply (drule_tac x = qdom in spec)
-    apply (drule_tac x = prio in spec)
-    apply clarsimp
-    apply (drule (1) bspec)
-    apply (simp add: obj_at'_def)
-    done
-
   have ball_subsetE:
     "\<And>P S R. \<lbrakk> \<forall>x \<in> S. P x; R \<subseteq> S \<rbrakk> \<Longrightarrow> \<forall>x \<in> R. P x"
     by blast
@@ -3504,7 +3494,7 @@ proof -
     apply (simp add: cl_cte [simplified] cl_tcb [simplified] cl_rest [simplified] tag_disj_via_td_name)
     apply (clarsimp simp: cready_queues_relation_def Let_def
                           htd_safe[simplified] kernel_data_refs_domain_eq_rotate)
-    apply (simp add: heap_updates_def kstcb tcb_queue_update_other' hrs_htd_update
+    apply (simp add: heap_updates_def tcb_queue_update_other' hrs_htd_update
                      ptr_retyp_to_array[simplified] irq[simplified])
     done
 qed
@@ -4494,7 +4484,8 @@ lemma Arch_initContext_spec':
 
 lemma ccorres_placeNewObject_tcb:
   "ccorresG rf_sr \<Gamma> dc xfdc
-   (pspace_aligned' and pspace_distinct' and pspace_no_overlap' regionBase tcbBlockSizeBits and valid_queues and (\<lambda>s. sym_refs (state_refs_of' s))
+   (pspace_aligned' and pspace_distinct' and pspace_no_overlap' regionBase tcbBlockSizeBits
+      and (\<lambda>s. sym_refs (state_refs_of' s))
       and (\<lambda>s. 2 ^ tcbBlockSizeBits \<le> gsMaxObjectSize s)
       and ret_zero regionBase (2 ^ tcbBlockSizeBits)
       and K (regionBase \<noteq> 0 \<and> range_cover regionBase tcbBlockSizeBits tcbBlockSizeBits 1
@@ -4765,7 +4756,7 @@ qed
 lemma placeNewObject_user_data:
   "ccorresG rf_sr \<Gamma> dc xfdc
   (pspace_aligned' and pspace_distinct' and pspace_no_overlap' regionBase (pageBits+us)
-  and valid_queues and valid_machine_state'
+  and valid_machine_state'
   and ret_zero regionBase (2 ^ (pageBits+us))
   and (\<lambda>s. sym_refs (state_refs_of' s))
   and (\<lambda>s. 2^(pageBits +  us) \<le> gsMaxObjectSize s)
@@ -4904,7 +4895,7 @@ lemma placeNewObject_user_data_device:
   "ccorresG rf_sr \<Gamma> dc xfdc
   (pspace_aligned' and pspace_distinct'
     and ret_zero regionBase (2 ^ (pageBits + us))
-    and pspace_no_overlap' regionBase (pageBits+us) and valid_queues
+    and pspace_no_overlap' regionBase (pageBits+us)
     and (\<lambda>s. sym_refs (state_refs_of' s))
     and (\<lambda>s. 2^(pageBits +  us) \<le> gsMaxObjectSize s)
     and K (regionBase \<noteq> 0 \<and> range_cover regionBase (pageBits + us) (pageBits+us) (Suc 0)
@@ -5110,7 +5101,7 @@ proof -
     apply clarify
     apply (intro conjI)
      apply (clarsimp simp: invs_pspace_aligned' invs_pspace_distinct' invs_valid_global'
-                           APIType_capBits_def invs_queues invs_valid_objs'
+                           APIType_capBits_def invs_valid_objs'
                            invs_urz pageBits_def)
     apply clarsimp
     apply (clarsimp simp: pageBits_def ccap_relation_def APIType_capBits_def
@@ -5191,15 +5182,11 @@ lemma threadSet_domain_ccorres [corres]:
   apply (simp add: map_to_ctes_upd_tcb_no_ctes map_to_tcbs_upd tcb_cte_cases_def cteSizeBits_def)
   apply (simp add: cep_relations_drop_fun_upd
                    cvariable_relation_upd_const ko_at_projectKO_opt)
-  apply (rule conjI)
-   apply (drule ko_at_projectKO_opt)
-   apply (erule (2) cmap_relation_upd_relI)
-     subgoal by (simp add: ctcb_relation_def)
-    apply assumption
-   apply simp
-  apply (erule cready_queues_relation_not_queue_ptrs)
-   apply (rule ext, simp split: if_split)
-  apply (rule ext, simp split: if_split)
+  apply (drule ko_at_projectKO_opt)
+  apply (erule (2) cmap_relation_upd_relI)
+    subgoal by (simp add: ctcb_relation_def)
+   apply assumption
+  apply simp
   done
 
 lemma createObject_ccorres:
@@ -5326,7 +5313,6 @@ proof -
                                createObject_c_preconds_def)
          apply (frule invs_pspace_aligned')
          apply (frule invs_pspace_distinct')
-         apply (frule invs_queues)
          apply (frule invs_sym')
          apply (simp add: getObjectSize_def objBits_simps word_bits_conv
                           apiGetObjectSize_def
@@ -5371,7 +5357,6 @@ proof -
         apply (clarsimp simp: createObject_hs_preconds_def isFrameType_def)
         apply (frule invs_pspace_aligned')
         apply (frule invs_pspace_distinct')
-        apply (frule invs_queues)
         apply (frule invs_sym')
         apply (auto simp: getObjectSize_def objBits_simps apiGetObjectSize_def
                           epSizeBits_def word_bits_conv
@@ -5409,7 +5394,6 @@ proof -
        apply (clarsimp simp: createObject_hs_preconds_def isFrameType_def)
        apply (frule invs_pspace_aligned')
        apply (frule invs_pspace_distinct')
-       apply (frule invs_queues)
        apply (frule invs_sym')
        apply (auto simp: getObjectSize_def objBits_simps
                    apiGetObjectSize_def
@@ -5450,7 +5434,6 @@ proof -
        apply (clarsimp simp: createObject_hs_preconds_def isFrameType_def)
        apply (frule invs_pspace_aligned')
        apply (frule invs_pspace_distinct')
-       apply (frule invs_queues)
        apply (frule invs_sym')
        apply (frule(1) ghost_assertion_size_logic_no_unat)
        apply (clarsimp simp: getObjectSize_def objBits_simps
diff --git a/proof/crefine/RISCV64/SR_lemmas_C.thy b/proof/crefine/RISCV64/SR_lemmas_C.thy
index 7f1d299552..e5adf595ef 100644
--- a/proof/crefine/RISCV64/SR_lemmas_C.thy
+++ b/proof/crefine/RISCV64/SR_lemmas_C.thy
@@ -304,11 +304,15 @@ lemma cmdbnode_relation_mdb_node_to_H [simp]:
   unfolding cmdbnode_relation_def mdb_node_to_H_def mdb_node_lift_def cte_lift_def
   by (fastforce split: option.splits)
 
-definition
-  tcb_no_ctes_proj :: "tcb \<Rightarrow> Structures_H.thread_state \<times> machine_word \<times> machine_word \<times> arch_tcb \<times> bool \<times> word8 \<times> word8 \<times> word8 \<times> nat \<times> fault option \<times> machine_word option"
+definition tcb_no_ctes_proj ::
+  "tcb \<Rightarrow> Structures_H.thread_state \<times> machine_word \<times> machine_word \<times> arch_tcb \<times> bool \<times> word8
+          \<times> word8 \<times> word8 \<times> nat \<times> fault option \<times> machine_word option
+          \<times> machine_word option \<times> machine_word option"
   where
-  "tcb_no_ctes_proj t \<equiv> (tcbState t, tcbFaultHandler t, tcbIPCBuffer t, tcbArch t, tcbQueued t,
-                            tcbMCP t, tcbPriority t, tcbDomain t, tcbTimeSlice t, tcbFault t, tcbBoundNotification t)"
+  "tcb_no_ctes_proj t \<equiv>
+     (tcbState t, tcbFaultHandler t, tcbIPCBuffer t, tcbArch t, tcbQueued t,
+      tcbMCP t, tcbPriority t, tcbDomain t, tcbTimeSlice t, tcbFault t, tcbBoundNotification t,
+      tcbSchedNext t, tcbSchedPrev t)"
 
 lemma tcb_cte_cases_proj_eq [simp]:
   "tcb_cte_cases p = Some (getF, setF) \<Longrightarrow>
@@ -1411,9 +1415,9 @@ lemma cmap_relation_cong:
    apply (erule imageI)
    done
 
-lemma ctcb_relation_null_queue_ptrs:
+lemma ctcb_relation_null_ep_ptrs:
   assumes rel: "cmap_relation mp mp' tcb_ptr_to_ctcb_ptr ctcb_relation"
-  and same: "map_option tcb_null_queue_ptrs \<circ> mp'' = map_option tcb_null_queue_ptrs \<circ> mp'"
+  and same: "map_option tcb_null_ep_ptrs \<circ> mp'' = map_option tcb_null_ep_ptrs \<circ> mp'"
   shows "cmap_relation mp mp'' tcb_ptr_to_ctcb_ptr ctcb_relation"
   using rel
   apply (rule iffD1 [OF cmap_relation_cong, OF _ map_option_eq_dom_eq, rotated -1])
@@ -1421,7 +1425,7 @@ lemma ctcb_relation_null_queue_ptrs:
    apply (rule same [symmetric])
   apply (drule compD [OF same])
   apply (case_tac b, case_tac b')
-  apply (simp add: ctcb_relation_def tcb_null_queue_ptrs_def)
+  apply (simp add: ctcb_relation_def tcb_null_ep_ptrs_def)
   done
 
 lemma map_to_ctes_upd_tcb_no_ctes:
@@ -2034,6 +2038,14 @@ lemma capTCBPtr_eq:
   apply clarsimp
   done
 
+lemma rf_sr_ctcb_queue_relation:
+  "\<lbrakk> (s, s') \<in> rf_sr; d \<le> maxDomain; p \<le> maxPriority \<rbrakk>
+  \<Longrightarrow> ctcb_queue_relation (ksReadyQueues s (d, p))
+                          (index (ksReadyQueues_' (globals s')) (cready_queues_index_to_C d p))"
+  unfolding rf_sr_def cstate_relation_def cready_queues_relation_def
+  apply (clarsimp simp: Let_def seL4_MinPrio_def minDom_def maxDom_to_H maxPrio_to_H)
+  done
+
 lemma rf_sr_sched_action_relation:
   "(s, s') \<in> rf_sr
    \<Longrightarrow> cscheduler_action_relation (ksSchedulerAction s) (ksSchedulerAction_' (globals s'))"
@@ -2135,5 +2147,11 @@ lemma physBase_spec:
   apply (simp add: Kernel_Config.physBase_def)
   done
 
+lemma rf_sr_obj_update_helper:
+  "(s, s'\<lparr> globals := globals s' \<lparr> t_hrs_' := t_hrs_' (globals (undefined
+              \<lparr> globals := (undefined \<lparr> t_hrs_' := f (globals s') (t_hrs_' (globals s')) \<rparr>)\<rparr>))\<rparr>\<rparr>) \<in> rf_sr
+          \<Longrightarrow> (s, globals_update (\<lambda>v. t_hrs_'_update (f v) v) s') \<in> rf_sr"
+  by (simp cong: StateSpace.state.fold_congs globals.fold_congs)
+
 end
 end
diff --git a/proof/crefine/RISCV64/Schedule_C.thy b/proof/crefine/RISCV64/Schedule_C.thy
index fb02afc6d0..5d97c3c95b 100644
--- a/proof/crefine/RISCV64/Schedule_C.thy
+++ b/proof/crefine/RISCV64/Schedule_C.thy
@@ -7,7 +7,7 @@
  *)
 
 theory Schedule_C
-imports Tcb_C
+imports Tcb_C Detype_C
 begin
 
 (*FIXME: arch_split: move up?*)
@@ -38,15 +38,17 @@ lemma switchToIdleThread_ccorres:
   "ccorres dc xfdc invs_no_cicd' UNIV hs
            switchToIdleThread (Call switchToIdleThread_'proc)"
   apply (cinit)
+   apply (rule ccorres_stateAssert)
    apply (rule ccorres_symb_exec_l)
       apply (ctac (no_vcg) add: Arch_switchToIdleThread_ccorres)
        apply (simp add: setCurThread_def)
+       apply (rule ccorres_stateAssert)
        apply (rule_tac P="\<lambda>s. thread = ksIdleThread s" and P'=UNIV in ccorres_from_vcg)
        apply (rule allI, rule conseqPre, vcg)
        apply (clarsimp simp: simpler_modify_def)
        apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
                              carch_state_relation_def cmachine_state_relation_def)
-      apply (wpsimp simp: RISCV64_H.switchToIdleThread_def)+
+      apply (wpsimp simp: RISCV64_H.switchToIdleThread_def wp: hoare_drop_imps)+
   done
 
 lemma Arch_switchToThread_ccorres:
@@ -62,8 +64,25 @@ lemma Arch_switchToThread_ccorres:
   apply clarsimp
   done
 
+lemma invs_no_cicd'_pspace_aligned':
+  "all_invs_but_ct_idle_or_in_cur_domain' s \<Longrightarrow> pspace_aligned' s"
+  by (simp add: all_invs_but_ct_idle_or_in_cur_domain'_def valid_pspace'_def)
 
+lemma invs_no_cicd'_pspace_distinct':
+  "all_invs_but_ct_idle_or_in_cur_domain' s \<Longrightarrow> pspace_distinct' s"
+  by (simp add: all_invs_but_ct_idle_or_in_cur_domain'_def valid_pspace'_def)
 
+lemma threadGet_exs_valid[wp]:
+  "tcb_at' t s \<Longrightarrow> \<lbrace>(=) s\<rbrace> threadGet f t \<exists>\<lbrace>\<lambda>r. (=) s\<rbrace>"
+  unfolding threadGet_def liftM_def
+  apply (wpsimp wp: exs_getObject)
+    apply (fastforce simp: obj_at'_def objBits_simps')+
+  done
+
+lemma isRunnable_exs_valid[wp]:
+  "tcb_at' t s \<Longrightarrow> \<lbrace>(=) s\<rbrace> isRunnable t \<exists>\<lbrace>\<lambda>r. (=) s\<rbrace>"
+  unfolding isRunnable_def getThreadState_def
+  by (wpsimp wp: exs_getObject)
 
 (* FIXME: move *)
 lemma switchToThread_ccorres:
@@ -73,23 +92,28 @@ lemma switchToThread_ccorres:
            hs
            (switchToThread t)
            (Call switchToThread_'proc)"
-  apply (cinit lift: thread_')
+  apply (clarsimp simp: switchToThread_def)
+  apply (rule ccorres_symb_exec_l'[OF _ _ isRunnable_sp]; (solves wpsimp)?)
+  apply (rule ccorres_symb_exec_l'[OF _ _ assert_sp]; (solves wpsimp)?)
+  apply (rule ccorres_stateAssert_fwd)+
+  apply (cinit' lift: thread_')
    apply (ctac (no_vcg) add: Arch_switchToThread_ccorres)
     apply (ctac (no_vcg) add: tcbSchedDequeue_ccorres)
+     apply (simp add: setCurThread_def)
+     apply (rule ccorres_stateAssert)
      apply (rule_tac P=\<top> and P'=UNIV in ccorres_from_vcg)
      apply clarsimp
      apply (rule conseqPre, vcg)
-     apply (clarsimp simp: setCurThread_def simpler_modify_def)
-     apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
-                           carch_state_relation_def cmachine_state_relation_def)
-    apply wp+
-  apply (clarsimp simp: all_invs_but_ct_idle_or_in_cur_domain'_def valid_state'_def)
+     apply (clarsimp simp: setCurThread_def simpler_modify_def rf_sr_def cstate_relation_def
+                           Let_def carch_state_relation_def cmachine_state_relation_def)
+    apply (wpsimp wp: Arch_switchToThread_invs_no_cicd' hoare_drop_imps
+           | strengthen invs_no_cicd'_pspace_aligned' invs_no_cicd'_pspace_distinct')+
   done
 
 lemma activateThread_ccorres:
   "ccorres dc xfdc
            (ct_in_state' activatable' and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)
-                   and valid_queues and valid_objs')
+            and valid_objs' and pspace_aligned' and pspace_distinct')
            UNIV []
            activateThread
            (Call activateThread_'proc)"
@@ -181,13 +205,42 @@ lemma switchToThread_ccorres':
 
 lemmas word_log2_max_word_word_size = word_log2_max[where 'a=machine_word_len, simplified word_size, simplified]
 
+lemma ccorres_pre_getQueue:
+  assumes cc: "\<And>queue. ccorres r xf (P queue) (P' queue) hs (f queue) c"
+  shows   "ccorres r xf (\<lambda>s. P (ksReadyQueues s (d, p)) s \<and> d \<le> maxDomain \<and> p \<le> maxPriority)
+                        {s'. \<forall>queue. (let cqueue = index (ksReadyQueues_' (globals s'))
+                                                         (cready_queues_index_to_C d p) in
+                                      ctcb_queue_relation queue cqueue) \<longrightarrow> s' \<in> P' queue}
+           hs (getQueue d p >>= (\<lambda>queue. f queue)) c"
+  apply (rule ccorres_guard_imp2)
+  apply (rule ccorres_symb_exec_l2)
+     defer
+     defer
+     apply (rule gq_sp)
+    defer
+    apply (rule ccorres_guard_imp)
+    apply (rule cc)
+     apply clarsimp
+     apply assumption
+    apply assumption
+   apply (clarsimp simp: getQueue_def gets_exs_valid)
+  apply clarsimp
+  apply (drule spec, erule mp)
+  apply (erule rf_sr_ctcb_queue_relation)
+   apply (simp add: maxDom_to_H maxPrio_to_H)+
+  done
+
 lemma chooseThread_ccorres:
-  "ccorres dc xfdc all_invs_but_ct_idle_or_in_cur_domain' UNIV [] chooseThread (Call chooseThread_'proc)"
+  "ccorres dc xfdc all_invs_but_ct_idle_or_in_cur_domain' UNIV []
+     chooseThread (Call chooseThread_'proc)"
 proof -
 
   note prio_and_dom_limit_helpers [simp]
   note ksReadyQueuesL2Bitmap_nonzeroI [simp]
   note Collect_const_mem [simp]
+
+  note prio_and_dom_limit_helpers[simp] word_sle_def[simp] maxDom_to_H[simp] maxPrio_to_H[simp]
+  note invert_prioToL1Index_c_simp[simp]
   (* when numDomains = 1, array bounds checks would become _ = 0 rather than _ < 1, changing the
      shape of the proof compared to when numDomains > 1 *)
   include no_less_1_simps
@@ -196,9 +249,22 @@ proof -
     "\<And>s. invs_no_cicd' s \<Longrightarrow> ksCurDomain s \<le> maxDomain"
     by (simp add: invs_no_cicd'_def)
 
+  have invs_no_cicd'_valid_bitmaps:
+    "\<And>s. invs_no_cicd' s \<Longrightarrow> valid_bitmaps s"
+    by (simp add: invs_no_cicd'_def)
+
+  have invs_no_cicd'_pspace_aligned':
+    "\<And>s. invs_no_cicd' s \<Longrightarrow> pspace_aligned' s"
+    by (simp add: invs_no_cicd'_def valid_pspace'_def)
+
+  have invs_no_cicd'_pspace_distinct':
+    "\<And>s. invs_no_cicd' s \<Longrightarrow> pspace_distinct' s"
+    by (simp add: invs_no_cicd'_def valid_pspace'_def)
+
   show ?thesis
     supply if_split[split del]
     apply (cinit)
+     apply (rule ccorres_stateAssert)+
      apply (simp add: numDomains_sge_1_simp)
      apply (rule_tac xf'=dom_' and r'="\<lambda>rv rv'. rv' = ucast rv" in ccorres_split_nothrow_novcg)
          apply (rule ccorres_from_vcg[where P=\<top> and P'=UNIV])
@@ -231,7 +297,7 @@ proof -
          apply (rule_tac P="curdom \<le> maxDomain" in ccorres_cross_over_guard_no_st)
          apply (rule_tac P="prio \<le> maxPriority" in ccorres_cross_over_guard_no_st)
          apply (rule ccorres_pre_getQueue)
-         apply (rule_tac P="queue \<noteq> []" in ccorres_cross_over_guard_no_st)
+         apply (rule_tac P="\<not> tcbQueueEmpty queue" in ccorres_cross_over_guard_no_st)
          apply (rule ccorres_symb_exec_l)
             apply (rule ccorres_assert)
             apply (rule ccorres_symb_exec_r)
@@ -246,37 +312,40 @@ proof -
              apply (rule conseqPre, vcg)
              apply (rule Collect_mono)
              apply clarsimp
-             apply (strengthen queue_in_range)
              apply assumption
             apply clarsimp
             apply (rule conseqPre, vcg)
             apply clarsimp
            apply (wp isRunnable_wp)+
        apply (clarsimp simp: Let_def guard_is_UNIV_def)
-       apply (drule invs_no_cicd'_queues)
-       apply (case_tac queue, simp)
-       apply (clarsimp simp: tcb_queue_relation'_def cready_queues_index_to_C_def numPriorities_def)
-       apply (clarsimp simp add: maxDom_to_H maxPrio_to_H
-                                 queue_in_range[where qdom=0, simplified, simplified maxPrio_to_H])
-       apply (clarsimp simp: le_maxDomain_eq_less_numDomains unat_trans_ucast_helper )
+       apply (rule conjI)
+        apply (clarsimp simp: le_maxDomain_eq_less_numDomains unat_trans_ucast_helper)
+       apply (intro conjI impI)
+        apply (clarsimp simp: cready_queues_index_to_C_def numPriorities_def ctcb_queue_relation_def
+                              tcbQueueEmpty_def option_to_ctcb_ptr_def)
+       apply (frule_tac qdom=curdom and prio=rv in cready_queues_index_to_C_in_range')
+        apply fastforce
+       apply (clarsimp simp: num_tcb_queues_val word_less_nat_alt cready_queues_index_to_C_def2)
       apply wpsimp
      apply (clarsimp simp: guard_is_UNIV_def le_maxDomain_eq_less_numDomains word_less_nat_alt
                            numDomains_less_numeric_explicit)
-    apply (frule invs_no_cicd'_queues)
+    apply clarsimp
     apply (frule invs_no_cicd'_max_CurDomain)
-    apply (frule invs_no_cicd'_queues)
-    apply (clarsimp simp: valid_queues_def lookupBitmapPriority_le_maxPriority)
+    apply (frule invs_no_cicd'_pspace_aligned')
+    apply (frule invs_no_cicd'_pspace_distinct')
+    apply (frule invs_no_cicd'_valid_bitmaps)
+    apply (frule valid_bitmaps_bitmapQ_no_L1_orphans)
+    apply (frule valid_bitmaps_valid_bitmapQ)
+    apply (clarsimp simp: ready_queue_relation_def ksReadyQueues_asrt_def cong: conj_cong)
     apply (intro conjI impI)
-       apply (fastforce dest: bitmapQ_from_bitmap_lookup simp: valid_bitmapQ_bitmapQ_simp)
-      apply (fastforce dest: lookupBitmapPriority_obj_at'
-                       simp: pred_conj_def obj_at'_def st_tcb_at'_def)
-     apply (fastforce dest: bitmapQ_from_bitmap_lookup simp: valid_bitmapQ_bitmapQ_simp)
-    apply (clarsimp simp: pred_conj_def obj_at'_def st_tcb_at'_def)
-    apply (clarsimp simp: not_less le_maxDomain_eq_less_numDomains)
-    apply (prop_tac "ksCurDomain s = 0")
-     using unsigned_eq_0_iff apply force
-    apply (cut_tac s=s in lookupBitmapPriority_obj_at'; simp?)
-    apply (clarsimp simp: pred_conj_def obj_at'_def st_tcb_at'_def)
+         apply (fastforce intro: lookupBitmapPriority_le_maxPriority)
+        apply (fastforce dest!: bitmapQ_from_bitmap_lookup valid_bitmapQ_bitmapQ_simp)
+       apply (fastforce dest!: lookupBitmapPriority_obj_at'
+                         simp: ready_queue_relation_def ksReadyQueues_asrt_def st_tcb_at'_def obj_at'_def)
+      apply (fastforce dest: lookupBitmapPriority_le_maxPriority)
+     apply (fastforce dest!: bitmapQ_from_bitmap_lookup valid_bitmapQ_bitmapQ_simp)
+    apply (fastforce dest!: lookupBitmapPriority_obj_at'
+                      simp: ready_queue_relation_def ksReadyQueues_asrt_def st_tcb_at'_def obj_at'_def)
     done
 qed
 
@@ -600,7 +669,7 @@ lemma schedule_ccorres:
           apply (wp (once) hoare_drop_imps)
            apply wp
           apply (strengthen strenghten_False_imp[where P="a = ResumeCurrentThread" for a])
-          apply (clarsimp simp: conj_ac invs_queues invs_valid_objs' cong: conj_cong)
+          apply (clarsimp simp: conj_ac invs_valid_objs' cong: conj_cong)
           apply wp
          apply (clarsimp, vcg exspec=tcbSchedEnqueue_modifies)
         apply (clarsimp, vcg exspec=tcbSchedEnqueue_modifies)
@@ -620,9 +689,11 @@ lemma schedule_ccorres:
     apply wp
    apply vcg
 
-  apply (clarsimp simp: tcb_at_invs' rf_sr_ksCurThread if_apply_def2 invs_queues invs_valid_objs')
+  apply (clarsimp simp: tcb_at_invs' rf_sr_ksCurThread if_apply_def2 invs_valid_objs')
   apply (frule invs_sch_act_wf')
   apply (frule tcb_at_invs')
+  apply (frule invs_pspace_aligned')
+  apply (frule invs_pspace_distinct')
   apply (rule conjI)
    apply (clarsimp dest!: rf_sr_cscheduler_relation simp: cscheduler_action_relation_def)
   apply (rule conjI; clarsimp)
@@ -672,11 +743,7 @@ lemma threadSet_timeSlice_ccorres [corres]:
 
   apply (simp add: cep_relations_drop_fun_upd cvariable_relation_upd_const
                    ko_at_projectKO_opt)
-  apply (rule conjI)
    defer
-   apply (erule cready_queues_relation_not_queue_ptrs)
-    apply (rule ext, simp split: if_split)
-   apply (rule ext, simp split: if_split)
   apply (drule ko_at_projectKO_opt)
   apply (erule (2) cmap_relation_upd_relI)
     apply (simp add: ctcb_relation_def)
@@ -720,7 +787,7 @@ lemma timerTick_ccorres:
                apply simp
                apply (ctac (no_vcg) add: tcbSchedAppend_ccorres)
                 apply (ctac add: rescheduleRequired_ccorres)
-               apply (wp weak_sch_act_wf_lift_linear threadSet_valid_queues
+               apply (wp weak_sch_act_wf_lift_linear
                          threadSet_pred_tcb_at_state tcbSchedAppend_valid_objs' threadSet_valid_objs' threadSet_tcbDomain_triv
                     | clarsimp simp: st_tcb_at'_def o_def split: if_splits)+
              apply (vcg exspec=tcbSchedDequeue_modifies)
@@ -771,8 +838,8 @@ lemma timerTick_ccorres:
    apply (rule conjI, clarsimp simp: invs'_def valid_state'_def valid_tcb'_def)+
     apply (auto simp: obj_at'_def inQ_def weak_sch_act_wf_def st_tcb_at'_def
                       valid_pspace'_def ct_idle_or_in_cur_domain'_def valid_tcb'_def valid_idle'_def projectKOs)[1]
-   apply (auto simp: invs'_def valid_state'_def valid_tcb'_def tcb_cte_cases_def
-                     cteSizeBits_def)[1]
+   apply (auto simp: invs'_def valid_state'_def valid_tcb'_def tcb_cte_cases_def cur_tcb'_def
+                     obj_at'_def cteSizeBits_def)[1]
 
   apply (frule invs_cur')
   apply (clarsimp simp: cur_tcb'_def)
diff --git a/proof/crefine/RISCV64/StateRelation_C.thy b/proof/crefine/RISCV64/StateRelation_C.thy
index d5dc162b40..8f1cc0da32 100644
--- a/proof/crefine/RISCV64/StateRelation_C.thy
+++ b/proof/crefine/RISCV64/StateRelation_C.thy
@@ -17,8 +17,7 @@ definition
 definition
   "array_relation r n a c \<equiv> \<forall>i \<le> n. r (a i) (index c (unat i))"
 
-(* used for bound ntfn/tcb *)
-definition
+definition option_to_ctcb_ptr :: "machine_word option \<Rightarrow> tcb_C ptr" where
   "option_to_ctcb_ptr x \<equiv> case x of None \<Rightarrow> NULL | Some t \<Rightarrow> tcb_ptr_to_ctcb_ptr t"
 
 
@@ -362,7 +361,9 @@ where
      \<and> tcbTimeSlice atcb    = unat (tcbTimeSlice_C ctcb)
      \<and> cfault_rel (tcbFault atcb) (seL4_Fault_lift (tcbFault_C ctcb))
                   (lookup_fault_lift (tcbLookupFailure_C ctcb))
-     \<and> option_to_ptr (tcbBoundNotification atcb) = tcbBoundNotification_C ctcb"
+     \<and> option_to_ptr (tcbBoundNotification atcb) = tcbBoundNotification_C ctcb
+     \<and> option_to_ctcb_ptr (tcbSchedPrev atcb) = tcbSchedPrev_C ctcb
+     \<and> option_to_ctcb_ptr (tcbSchedNext atcb) = tcbSchedNext_C ctcb"
 
 abbreviation
   "ep_queue_relation' \<equiv> tcb_queue_relation' tcbEPNext_C tcbEPPrev_C"
@@ -545,17 +546,17 @@ definition
 where
   "cready_queues_index_to_C qdom prio \<equiv> (unat qdom) * numPriorities + (unat prio)"
 
-definition cready_queues_relation ::
-  "tcb_C typ_heap \<Rightarrow> (tcb_queue_C[num_tcb_queues]) \<Rightarrow> (domain \<times> priority \<Rightarrow> ready_queue) \<Rightarrow> bool"
-where
-  "cready_queues_relation h_tcb queues aqueues \<equiv>
-     \<forall>qdom prio. ((qdom \<ge> ucast minDom \<and> qdom \<le> ucast maxDom \<and>
-                  prio \<ge> ucast minPrio \<and> prio \<le> ucast maxPrio) \<longrightarrow>
-       (let cqueue = index queues (cready_queues_index_to_C qdom prio) in
-            sched_queue_relation' h_tcb (aqueues (qdom, prio)) (head_C cqueue) (end_C cqueue)))
-        \<and> (\<not> (qdom \<ge> ucast minDom \<and> qdom \<le> ucast maxDom \<and>
-                  prio \<ge> ucast minPrio \<and> prio \<le> ucast maxPrio) \<longrightarrow> aqueues (qdom, prio) = [])"
+definition ctcb_queue_relation :: "tcb_queue \<Rightarrow> tcb_queue_C \<Rightarrow> bool" where
+   "ctcb_queue_relation aqueue cqueue \<equiv>
+      head_C cqueue = option_to_ctcb_ptr (tcbQueueHead aqueue)
+      \<and> end_C cqueue = option_to_ctcb_ptr (tcbQueueEnd aqueue)"
 
+definition cready_queues_relation ::
+  "(domain \<times> priority \<Rightarrow> ready_queue) \<Rightarrow> (tcb_queue_C[num_tcb_queues]) \<Rightarrow>  bool"
+  where
+  "cready_queues_relation aqueues cqueues \<equiv>
+     \<forall>d p. d \<le> maxDomain \<and> p \<le> maxPriority
+           \<longrightarrow> ctcb_queue_relation (aqueues (d, p)) (index cqueues (cready_queues_index_to_C d p))"
 
 abbreviation
   "cte_array_relation astate cstate
@@ -694,9 +695,7 @@ where
   "cstate_relation astate cstate \<equiv>
      let cheap = t_hrs_' cstate in
        cpspace_relation (ksPSpace astate) (underlying_memory (ksMachineState astate)) cheap \<and>
-       cready_queues_relation (clift cheap)
-                             (ksReadyQueues_' cstate)
-                             (ksReadyQueues astate) \<and>
+       cready_queues_relation (ksReadyQueues astate) (ksReadyQueues_' cstate) \<and>
        zero_ranges_are_zero (gsUntypedZeroRanges astate) cheap \<and>
        cbitmap_L1_relation (ksReadyQueuesL1Bitmap_' cstate) (ksReadyQueuesL1Bitmap astate) \<and>
        cbitmap_L2_relation (ksReadyQueuesL2Bitmap_' cstate) (ksReadyQueuesL2Bitmap astate) \<and>
diff --git a/proof/crefine/RISCV64/SyscallArgs_C.thy b/proof/crefine/RISCV64/SyscallArgs_C.thy
index 3345ec7b9f..fa51df1de3 100644
--- a/proof/crefine/RISCV64/SyscallArgs_C.thy
+++ b/proof/crefine/RISCV64/SyscallArgs_C.thy
@@ -49,9 +49,7 @@ lemma replyOnRestart_invs'[wp]:
   including no_pre
   apply (simp add: replyOnRestart_def)
   apply (wp setThreadState_nonqueued_state_update rfk_invs' hoare_weak_lift_imp)
-  apply (rule hoare_vcg_all_lift)
-  apply (wp setThreadState_nonqueued_state_update rfk_invs' hoare_vcg_all_lift rfk_ksQ)
-   apply (rule hoare_strengthen_post, rule gts_sp')
+  apply (rule hoare_strengthen_post, rule gts_sp')
   apply (clarsimp simp: pred_tcb_at')
   apply (auto elim!: pred_tcb'_weakenE st_tcb_ex_cap''
                dest: st_tcb_at_idle_thread')
diff --git a/proof/crefine/RISCV64/Syscall_C.thy b/proof/crefine/RISCV64/Syscall_C.thy
index d6bdf0ecdd..95332904d1 100644
--- a/proof/crefine/RISCV64/Syscall_C.thy
+++ b/proof/crefine/RISCV64/Syscall_C.thy
@@ -50,8 +50,7 @@ lemma cap_cases_one_on_true_sum:
 lemma performInvocation_Endpoint_ccorres:
   "ccorres (K (K \<bottom>) \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
        (invs' and st_tcb_at' simple' thread and ep_at' epptr
-              and sch_act_sane and (\<lambda>s. thread = ksCurThread s
-              \<and> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))))
+              and sch_act_sane and (\<lambda>s. thread = ksCurThread s))
        (UNIV \<inter> {s. block_' s = from_bool blocking}
              \<inter> {s. call_' s = from_bool do_call}
              \<inter> {s. badge_' s = badge}
@@ -123,7 +122,6 @@ lemma decodeInvocation_ccorres:
               and (\<lambda>s. \<forall>v \<in> set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s)
               and (\<lambda>s. \<forall>v \<in> set extraCaps. s \<turnstile>' fst v \<and> cte_at' (snd v) s)
               and (\<lambda>s. \<forall>v \<in> set extraCaps. \<forall>y \<in> zobj_refs' (fst v). ex_nonz_cap_to' y s)
-              and (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))
               and sysargs_rel args buffer)
        (UNIV \<inter> {s. current_extra_caps_' (globals s) = extraCaps'}
              \<inter> {s. call_' s = from_bool isCall}
@@ -200,7 +198,7 @@ lemma decodeInvocation_ccorres:
       apply simp
       apply (rule hoare_use_eq[where f=ksCurThread])
        apply (wp sts_invs_minor' sts_st_tcb_at'_cases
-                 setThreadState_ct' hoare_vcg_all_lift sts_ksQ')+
+                 setThreadState_ct' hoare_vcg_all_lift)+
      apply simp
      apply (vcg exspec=setThreadState_modifies)
     apply vcg
@@ -508,7 +506,7 @@ lemma wordFromMessageInfo_spec:
 
 lemma handleDoubleFault_ccorres:
   "ccorres dc xfdc (invs' and  tcb_at' tptr and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and
-        sch_act_not tptr and (\<lambda>s. \<forall>p. tptr \<notin> set (ksReadyQueues s p)))
+        sch_act_not tptr)
       (UNIV \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr tptr})
       [] (handleDoubleFault tptr ex1 ex2)
          (Call handleDoubleFault_'proc)"
@@ -573,8 +571,7 @@ lemma hrs_mem_update_use_hrs_mem:
 
 lemma sendFaultIPC_ccorres:
   "ccorres  (cfault_rel2 \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
-      (invs' and st_tcb_at' simple' tptr and sch_act_not tptr and
-       (\<lambda>s. \<forall>p. tptr \<notin> set (ksReadyQueues s p)))
+      (invs' and st_tcb_at' simple' tptr and sch_act_not tptr)
       (UNIV \<inter> {s. (cfault_rel (Some fault) (seL4_Fault_lift(current_fault_' (globals s)))
                        (lookup_fault_lift(current_lookup_fault_' (globals s))))}
             \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr tptr})
@@ -652,8 +649,8 @@ lemma sendFaultIPC_ccorres:
               apply (ctac (no_vcg) add: sendIPC_ccorres)
                apply (ctac (no_vcg) add: ccorres_return_CE [unfolded returnOk_def comp_def])
               apply wp
-             apply (wp threadSet_pred_tcb_no_state threadSet_invs_trivial threadSet_typ_at_lifts
-                    | simp)+
+             apply (wpsimp wp: threadSet_invs_trivial)
+             apply (wpsimp wp: threadSet_pred_tcb_no_state threadSet_typ_at_lifts)
 
             apply (clarsimp simp: guard_is_UNIV_def)
             apply (subgoal_tac "capEPBadge epcap && mask 64 = capEPBadge epcap")
@@ -686,8 +683,7 @@ lemma sendFaultIPC_ccorres:
          apply vcg
         apply (clarsimp simp: inQ_def)
         apply (rule_tac Q="\<lambda>a b. invs' b \<and> st_tcb_at' simple' tptr b
-                                 \<and> sch_act_not tptr b \<and> valid_cap' a b
-                                 \<and> (\<forall>p. tptr \<notin> set (ksReadyQueues b p))"
+                                 \<and> sch_act_not tptr b \<and> valid_cap' a b"
                  and E="\<lambda> _. \<top>"
                  in hoare_post_impErr)
           apply (wp)
@@ -702,8 +698,7 @@ lemma sendFaultIPC_ccorres:
   done
 
 lemma handleFault_ccorres:
-  "ccorres dc xfdc (invs' and st_tcb_at' simple' t and
-        sch_act_not t and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p)))
+  "ccorres dc xfdc (invs' and st_tcb_at' simple' t and sch_act_not t)
       (UNIV \<inter> {s. (cfault_rel (Some flt) (seL4_Fault_lift(current_fault_' (globals s)))
                        (lookup_fault_lift(current_lookup_fault_' (globals s))) )}
             \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr t})
@@ -767,9 +762,7 @@ lemma getMRs_length:
 
 lemma handleInvocation_ccorres:
   "ccorres (K dc \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
-       (invs' and
-        ct_active' and sch_act_simple and
-        (\<lambda>s. \<forall>x. ksCurThread s \<notin> set (ksReadyQueues s x)))
+       (invs' and ct_active' and sch_act_simple)
        (UNIV \<inter> {s. isCall_' s = from_bool isCall}
              \<inter> {s. isBlocking_' s = from_bool isBlocking}) []
        (handleInvocation isCall isBlocking) (Call handleInvocation_'proc)"
@@ -897,7 +890,7 @@ lemma handleInvocation_ccorres:
                      apply (wp hoare_split_bind_case_sumE hoare_drop_imps
                                setThreadState_nonqueued_state_update
                                ct_in_state'_set setThreadState_st_tcb
-                               hoare_vcg_all_lift sts_ksQ'
+                               hoare_vcg_all_lift
                                  | wpc | wps)+
                     apply auto[1]
                    apply clarsimp
@@ -1156,9 +1149,6 @@ lemma ccorres_trim_redundant_throw_break:
 lemma invs_valid_objs_strengthen:
   "invs' s \<longrightarrow> valid_objs' s" by fastforce
 
-lemma ct_not_ksQ_strengthen:
-  "thread = ksCurThread s \<and> ksCurThread s \<notin> set (ksReadyQueues s p) \<longrightarrow> thread \<notin> set (ksReadyQueues s p)" by fastforce
-
 lemma option_to_ctcb_ptr_valid_ntfn:
   "valid_ntfn' ntfn s ==> (option_to_ctcb_ptr (ntfnBoundTCB ntfn) = NULL) = (ntfnBoundTCB ntfn = None)"
   apply (cases "ntfnBoundTCB ntfn", simp_all add: option_to_ctcb_ptr_def)
@@ -1192,8 +1182,7 @@ lemma handleRecv_ccorres:
   notes rf_sr_upd_safe[simp del]
   shows
   "ccorres dc xfdc
-       (\<lambda>s. invs' s \<and> st_tcb_at' simple' (ksCurThread s) s
-               \<and> sch_act_sane s \<and> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)))
+       (\<lambda>s. invs' s \<and> st_tcb_at' simple' (ksCurThread s) s \<and> sch_act_sane s)
        {s. isBlocking_' s = from_bool isBlocking}
        []
        (handleRecv isBlocking)
@@ -1257,7 +1246,7 @@ lemma handleRecv_ccorres:
             apply (rule_tac P="\<lambda>s. ksCurThread s = thread" in ccorres_cross_over_guard)
             apply (ctac add: receiveIPC_ccorres)
 
-           apply (wp deleteCallerCap_ksQ_ct' hoare_vcg_all_lift)
+           apply (wp hoare_vcg_all_lift)
           apply (rule conseqPost[where Q'=UNIV and A'="{}"], vcg exspec=deleteCallerCap_modifies)
            apply (clarsimp dest!: rf_sr_ksCurThread)
           apply simp
@@ -1380,13 +1369,11 @@ lemma handleRecv_ccorres:
       apply clarsimp
       apply (rename_tac thread epCPtr)
         apply (rule_tac Q'="(\<lambda>rv s. invs' s \<and> st_tcb_at' simple' thread s
-               \<and> sch_act_sane s \<and> (\<forall>p. thread \<notin> set (ksReadyQueues s p)) \<and> thread = ksCurThread s
+               \<and> sch_act_sane s \<and> thread = ksCurThread s
                \<and> valid_cap' rv s)" in hoare_post_imp_R[rotated])
-         apply (clarsimp simp: sch_act_sane_def)
-         apply (auto dest!: obj_at_valid_objs'[OF _ invs_valid_objs']
-                      simp: projectKOs valid_obj'_def,
-                auto simp: pred_tcb_at'_def obj_at'_def objBits_simps projectKOs ct_in_state'_def)[1]
-         apply wp
+       apply (intro conjI impI allI; clarsimp simp: sch_act_sane_def)
+       apply (fastforce dest: obj_at_valid_objs'[OF _ invs_valid_objs'] ko_at_valid_ntfn')
+      apply wp
      apply clarsimp
      apply (vcg exspec=isStopped_modifies exspec=lookupCap_modifies)
 
@@ -1435,7 +1422,7 @@ lemma handleYield_ccorres:
        apply (ctac add: rescheduleRequired_ccorres)
       apply (wp weak_sch_act_wf_lift_linear tcbSchedAppend_valid_objs')
      apply (vcg exspec= tcbSchedAppend_modifies)
-    apply (wp weak_sch_act_wf_lift_linear tcbSchedDequeue_valid_queues)
+    apply (wp weak_sch_act_wf_lift_linear)
    apply (vcg exspec= tcbSchedDequeue_modifies)
   apply (clarsimp simp: tcb_at_invs' invs_valid_objs'
                         valid_objs'_maxPriority valid_objs'_maxDomain)
@@ -1582,8 +1569,7 @@ lemma ccorres_return_void_C_Seq:
 
 lemma ccorres_handleReservedIRQ:
   "ccorres dc xfdc
-    (invs' and (\<lambda>s. irq \<in> non_kernel_IRQs \<longrightarrow> sch_act_not (ksCurThread s) s \<and>
-                     (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))))
+    (invs' and (\<lambda>s. irq \<in> non_kernel_IRQs \<longrightarrow> sch_act_not (ksCurThread s) s))
     (UNIV \<inter> {s. irq_' s = ucast irq}) hs
     (handleReservedIRQ irq) (Call handleReservedIRQ_'proc)"
   apply (cinit lift: irq_')
@@ -1593,8 +1579,7 @@ lemma ccorres_handleReservedIRQ:
 
 lemma handleInterrupt_ccorres:
   "ccorres dc xfdc
-     (invs' and (\<lambda>s. irq \<in> non_kernel_IRQs \<longrightarrow> sch_act_not (ksCurThread s) s \<and>
-                     (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))))
+     (invs' and (\<lambda>s. irq \<in> non_kernel_IRQs \<longrightarrow> sch_act_not (ksCurThread s) s))
      (UNIV \<inter> \<lbrace>\<acute>irq = ucast irq\<rbrace>)
      hs
      (handleInterrupt irq)
diff --git a/proof/crefine/RISCV64/TcbQueue_C.thy b/proof/crefine/RISCV64/TcbQueue_C.thy
index 55b52ed358..bca4869138 100644
--- a/proof/crefine/RISCV64/TcbQueue_C.thy
+++ b/proof/crefine/RISCV64/TcbQueue_C.thy
@@ -967,49 +967,6 @@ lemma tcb_queue_relation'_prev_sign:
 \<Longrightarrow> sign_extend canonical_bit (ptr_val (getPrev tcb)) = ptr_val (getPrev tcb)"
   by (rule tcb_queue_relation_prev_sign [OF tcb_queue_relation'_queue_rel])
 
-
-lemma cready_queues_relation_null_queue_ptrs:
-  assumes rel: "cready_queues_relation mp cq aq"
-  and same: "option_map tcb_null_ep_ptrs \<circ> mp' = option_map tcb_null_ep_ptrs \<circ> mp"
-  shows "cready_queues_relation mp' cq aq"
-  using rel
-  apply (clarsimp simp: cready_queues_relation_def Let_def all_conj_distrib)
-  apply (drule spec, drule spec, drule mp, (erule conjI)+, assumption)
-  apply (clarsimp simp: tcb_queue_relation'_def)
-  apply (erule iffD2 [OF tcb_queue_relation_only_next_prev, rotated -1])
-   apply (rule ext)
-   apply (case_tac "mp' x")
-    apply (frule compD [OF same])
-    apply simp
-   apply (frule compD [OF same])
-   apply (clarsimp simp: tcb_null_ep_ptrs_def)
-   apply (case_tac z, case_tac a)
-   apply simp
-  \<comment> \<open>clag\<close>
-  apply (rule ext)
-  apply (case_tac "mp' x")
-   apply (frule compD [OF same])
-   apply simp
-  apply (frule compD [OF same])
-  apply (clarsimp simp: tcb_null_ep_ptrs_def)
-  apply (case_tac z, case_tac a)
-  apply simp
-  done
-
-lemma cready_queues_relation_not_queue_ptrs:
-  assumes rel: "cready_queues_relation mp cq aq"
-  and same: "option_map tcbSchedNext_C \<circ> mp' = option_map tcbSchedNext_C \<circ> mp"
-  "option_map tcbSchedPrev_C \<circ> mp' = option_map tcbSchedPrev_C \<circ> mp"
-  shows "cready_queues_relation mp' cq aq"
-  using rel
-  apply (clarsimp simp: cready_queues_relation_def tcb_queue_relation'_def Let_def all_conj_distrib)
-  apply (drule spec, drule spec, drule mp, (erule conjI)+, assumption)
-  apply clarsimp
-  apply (erule iffD2 [OF tcb_queue_relation_only_next_prev, rotated -1])
-   apply (rule same)
-  apply (rule same)
-  done
-
 lemma ntfn_ep_disjoint:
   assumes  srs: "sym_refs (state_refs_of' s)"
   and     epat: "ko_at' ep epptr s"
@@ -1376,8 +1333,6 @@ lemma rf_sr_tcb_update_no_queue:
                                           (t_hrs_' (globals s'));
      tcbEPNext_C ctcb = tcbEPNext_C (the (cslift s' (tcb_ptr_to_ctcb_ptr thread)));
      tcbEPPrev_C ctcb = tcbEPPrev_C (the (cslift s' (tcb_ptr_to_ctcb_ptr thread)));
-     tcbSchedNext_C ctcb = tcbSchedNext_C (the (cslift s' (tcb_ptr_to_ctcb_ptr thread)));
-     tcbSchedPrev_C ctcb = tcbSchedPrev_C (the (cslift s' (tcb_ptr_to_ctcb_ptr thread)));
      (\<forall>x\<in>ran tcb_cte_cases. (\<lambda>(getF, setF). getF tcb' = getF tcb) x);
      ctcb_relation tcb' ctcb
    \<rbrakk>
@@ -1392,31 +1347,22 @@ lemma rf_sr_tcb_update_no_queue:
   apply (clarsimp simp: map_comp_update projectKO_opt_tcb cvariable_relation_upd_const
                         typ_heap_simps')
   apply (intro conjI)
-       subgoal by (clarsimp simp: cmap_relation_def map_comp_update projectKO_opts_defs inj_eq)
-      apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-      apply simp
-      apply (rule cendpoint_relation_upd_tcb_no_queues, assumption+)
-       subgoal by fastforce
-      subgoal by fastforce
+      subgoal by (clarsimp simp: cmap_relation_def map_comp_update projectKO_opts_defs inj_eq)
      apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
      apply simp
-     apply (rule cnotification_relation_upd_tcb_no_queues, assumption+)
+     apply (rule cendpoint_relation_upd_tcb_no_queues, assumption+)
       subgoal by fastforce
      subgoal by fastforce
-    apply (erule cready_queues_relation_not_queue_ptrs)
+    apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+    apply simp
+    apply (rule cnotification_relation_upd_tcb_no_queues, assumption+)
      subgoal by fastforce
     subgoal by fastforce
    subgoal by (clarsimp simp: carch_state_relation_def typ_heap_simps')
   by (simp add: cmachine_state_relation_def)
 
-lemma rf_sr_tcb_update_no_queue_helper:
-  "(s, s'\<lparr> globals := globals s' \<lparr> t_hrs_' := t_hrs_' (globals (undefined
-              \<lparr> globals := (undefined \<lparr> t_hrs_' := f (globals s') (t_hrs_' (globals s')) \<rparr>)\<rparr>))\<rparr>\<rparr>) \<in> rf_sr
-          \<Longrightarrow> (s, globals_update (\<lambda>v. t_hrs_'_update (f v) v) s') \<in> rf_sr"
-  by (simp cong: StateSpace.state.fold_congs globals.fold_congs)
-
-lemmas rf_sr_tcb_update_no_queue2
-    = rf_sr_tcb_update_no_queue_helper [OF rf_sr_tcb_update_no_queue, simplified]
+lemmas rf_sr_tcb_update_no_queue2 =
+  rf_sr_obj_update_helper[OF rf_sr_tcb_update_no_queue, simplified]
 
 lemma tcb_queue_relation_not_in_q:
   "ctcb_ptr_to_tcb_ptr x \<notin> set xs \<Longrightarrow>
@@ -1464,13 +1410,7 @@ lemma rf_sr_tcb_update_not_in_queue:
     apply (drule(1) map_to_ko_atI')
     apply (drule sym_refs_ko_atD', clarsimp+)
     subgoal by blast
-   apply (simp add: cready_queues_relation_def, erule allEI)
    apply (clarsimp simp: Let_def)
-    apply (subst tcb_queue_relation_not_in_q)
-   apply clarsimp
-    apply (drule valid_queues_obj_at'D, clarsimp)
-    apply (clarsimp simp: obj_at'_def projectKOs inQ_def)
-   subgoal by simp
   apply (simp add: carch_state_relation_def)
   by (simp add: cmachine_state_relation_def)
 
diff --git a/proof/crefine/RISCV64/Tcb_C.thy b/proof/crefine/RISCV64/Tcb_C.thy
index b1ed7a22b0..e3b4086348 100644
--- a/proof/crefine/RISCV64/Tcb_C.thy
+++ b/proof/crefine/RISCV64/Tcb_C.thy
@@ -60,8 +60,6 @@ lemma doMachineOp_sched:
   done
 
 context begin interpretation Arch . (*FIXME: arch_split*)
-crunch queues[wp]: setupReplyMaster "valid_queues"
-  (simp: crunch_simps wp: crunch_wps)
 
 crunch curThread [wp]: restart "\<lambda>s. P (ksCurThread s)"
   (wp: crunch_wps simp: crunch_simps)
@@ -398,9 +396,10 @@ lemma hrs_mem_update_cong:
 
 lemma setPriority_ccorres:
   "ccorres dc xfdc
-      (\<lambda>s. tcb_at' t s \<and> Invariants_H.valid_queues s \<and>  ksCurDomain s \<le> maxDomain \<and>
-           valid_queues' s \<and> valid_objs' s \<and> weak_sch_act_wf (ksSchedulerAction s) s \<and> (priority \<le> maxPriority))
-      (UNIV \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr t} \<inter> {s. prio_' s = ucast priority})
+      (\<lambda>s. tcb_at' t s \<and> ksCurDomain s \<le> maxDomain \<and>
+           valid_objs' s \<and> weak_sch_act_wf (ksSchedulerAction s) s \<and> (priority \<le> maxPriority) \<and>
+           pspace_aligned' s \<and> pspace_distinct' s)
+      ({s. tptr_' s = tcb_ptr_to_ctcb_ptr t} \<inter> {s. prio_' s = ucast priority})
       [] (setPriority t priority) (Call setPriority_'proc)"
   apply (cinit lift: tptr_' prio_')
    apply (ctac(no_vcg) add: tcbSchedDequeue_ccorres)
@@ -423,7 +422,7 @@ lemma setPriority_ccorres:
         apply (ctac add: possibleSwitchTo_ccorres)
        apply (rule ccorres_return_Skip')
       apply (wp isRunnable_wp)
-     apply (wpsimp wp: hoare_drop_imps threadSet_valid_queues threadSet_valid_objs'
+     apply (wpsimp wp: hoare_drop_imps threadSet_valid_objs'
                        weak_sch_act_wf_lift_linear threadSet_pred_tcb_at_state
                        threadSet_tcbDomain_triv
                  simp: st_tcb_at'_def o_def split: if_splits)
@@ -432,18 +431,13 @@ lemma setPriority_ccorres:
                  where Q="\<lambda>rv s.
                           obj_at' (\<lambda>_. True) t s \<and>
                           priority \<le> maxPriority \<and>
-                          Invariants_H.valid_queues s \<and>
                           ksCurDomain s \<le> maxDomain \<and>
                           valid_objs' s \<and>
-                          valid_queues' s \<and>
                           weak_sch_act_wf (ksSchedulerAction s) s \<and>
-                          (\<forall>d p. \<not> t \<in> set (ksReadyQueues s (d, p)))"])
-    apply (wp weak_sch_act_wf_lift_linear tcbSchedDequeue_valid_queues tcbSchedDequeue_nonq)
+                          pspace_aligned' s \<and> pspace_distinct' s"])
+    apply (wp weak_sch_act_wf_lift_linear valid_tcb'_def)
    apply (clarsimp simp: valid_tcb'_tcbPriority_update)
   apply clarsimp
-  apply (frule (1) valid_objs'_maxDomain[where t=t])
-  apply (frule (1) valid_objs'_maxPriority[where t=t])
-  apply simp
   done
 
 lemma setMCPriority_ccorres:
@@ -688,12 +682,12 @@ lemma invokeTCB_ThreadControl_ccorres:
                         apply (clarsimp simp : guard_is_UNIV_def Collect_const_mem)
                        apply (rule hoare_strengthen_post[
                                     where Q= "\<lambda>rv s.
-                                              Invariants_H.valid_queues s \<and>
                                               valid_objs' s \<and>
                                               weak_sch_act_wf (ksSchedulerAction s) s \<and>
                                               ((\<exists>a b. priority = Some (a, b)) \<longrightarrow>
                                                    tcb_at' target s \<and> ksCurDomain s \<le> maxDomain \<and>
-                                                   valid_queues' s \<and>  fst (the priority) \<le> maxPriority)"])
+                                                   fst (the priority) \<le> maxPriority) \<and>
+                                              pspace_aligned' s \<and> pspace_distinct' s"])
                         apply (strengthen sch_act_wf_weak)
                         apply (wp hoare_weak_lift_imp)
                        apply (clarsimp split: if_splits)
@@ -782,12 +776,12 @@ lemma invokeTCB_ThreadControl_ccorres:
                apply (clarsimp simp : guard_is_UNIV_def Collect_const_mem)
               apply (simp cong: conj_cong)
               apply (rule hoare_strengthen_post[
-                            where Q="\<lambda>a b. (Invariants_H.valid_queues b \<and>
-                                       valid_objs' b \<and>
+                            where Q="\<lambda>a b. (valid_objs' b \<and>
                                        sch_act_wf (ksSchedulerAction b) b \<and>
+                                       pspace_aligned' b \<and> pspace_distinct' b \<and>
                                        ((\<exists>a b. priority = Some (a, b)) \<longrightarrow>
                                           tcb_at'  target b \<and>
-                                          ksCurDomain b \<le> maxDomain \<and> valid_queues' b \<and>
+                                          ksCurDomain b \<le> maxDomain \<and>
                                           fst (the priority) \<le> maxPriority)) \<and>
                                        ((case snd (the buf)
                                            of None \<Rightarrow> 0
@@ -809,15 +803,15 @@ lemma invokeTCB_ThreadControl_ccorres:
                prefer 2
                apply fastforce
               apply (strengthen cte_is_derived_capMasterCap_strg
-                                invs_queues invs_weak_sch_act_wf invs_sch_act_wf'
+                                invs_weak_sch_act_wf invs_sch_act_wf'
                                 invs_valid_objs' invs_mdb' invs_pspace_aligned',
                             simp add: o_def)
               apply (rule_tac P="is_aligned (fst (the buf)) msg_align_bits"
                        in hoare_gen_asm)
               apply (wp threadSet_ipcbuffer_trivial hoare_weak_lift_imp
                      | simp
-                     | strengthen invs_sch_act_wf' invs_valid_objs' invs_weak_sch_act_wf invs_queues
-                                  invs_valid_queues' | wp hoare_drop_imps)+
+                     | strengthen invs_sch_act_wf' invs_valid_objs' invs_weak_sch_act_wf
+                     | wp hoare_drop_imps)+
              apply (clarsimp simp: guard_is_UNIV_def Collect_const_mem
                                    option_to_0_def
                             split: option.split_asm)
@@ -826,7 +820,7 @@ lemma invokeTCB_ThreadControl_ccorres:
              apply (rule ccorres_return_C_errorE, simp+)[1]
             apply vcg
            apply (simp add: conj_comms cong: conj_cong)
-           apply (strengthen invs_ksCurDomain_maxDomain')
+           apply (strengthen invs_ksCurDomain_maxDomain' invs_pspace_distinct')
            apply (wp hoare_vcg_const_imp_lift_R cteDelete_invs')
           apply simp
           apply (rule ccorres_split_nothrow_novcg_dc)
@@ -843,8 +837,7 @@ lemma invokeTCB_ThreadControl_ccorres:
          apply (rule conjI)
           apply (clarsimp simp: objBits_simps' word_bits_conv case_option_If2 if_n_0_0 valid_cap'_def
                                 capAligned_def obj_at'_def projectKOs)
-         apply (clarsimp simp: invs_valid_objs' invs_valid_queues'
-                               Invariants_H.invs_queues invs_ksCurDomain_maxDomain')
+         apply (fastforce simp: invs_valid_objs' invs_ksCurDomain_maxDomain')
         apply (rule ccorres_Cond_rhs_Seq)
          apply (rule ccorres_rhs_assoc)+
          apply csymbr
@@ -1081,7 +1074,7 @@ lemma restart_ccorres:
         apply (ctac(no_vcg) add: tcbSchedEnqueue_ccorres)
          apply (ctac add: possibleSwitchTo_ccorres)
         apply (wp weak_sch_act_wf_lift)[1]
-       apply (wp sts_valid_queues setThreadState_st_tcb)[1]
+       apply (wp sts_valid_objs' setThreadState_st_tcb)[1]
       apply (simp add: valid_tcb_state'_def)
       apply wp
       apply (wp (once) sch_act_wf_lift, (wp tcb_in_cur_domain'_lift)+)
@@ -1698,7 +1691,7 @@ lemma invokeTCB_WriteRegisters_ccorres[where S=UNIV]:
   apply (clarsimp simp: frame_gp_registers_convs word_less_nat_alt
                         sysargs_rel_def n_frameRegisters_def n_msgRegisters_def
                   split: if_split_asm)
-  apply (simp add: invs_weak_sch_act_wf invs_valid_objs' invs_queues)
+  apply (simp add: invs_weak_sch_act_wf invs_valid_objs')
   apply (fastforce dest!: global'_no_ex_cap simp: invs'_def valid_state'_def)
   done
 
@@ -3163,7 +3156,8 @@ lemma decodeTCBConfigure_ccorres:
    apply (rule conjI, fastforce)
    apply (drule interpret_excaps_eq)
    apply (clarsimp simp: cte_wp_at_ctes_of valid_tcb_state'_def numeral_eqs le_ucast_ucast_le
-                         tcb_at_invs' invs_valid_objs' invs_queues invs_sch_act_wf'
+                         tcb_at_invs' invs_valid_objs' invs_sch_act_wf'
+                         invs_pspace_aligned' invs_pspace_distinct'
                          ct_in_state'_def pred_tcb_at'_def obj_at'_def tcb_st_refs_of'_def)
    apply (erule disjE; simp add: objBits_defs mask_def)
   apply (clarsimp simp: idButNot_def interpret_excaps_test_null
@@ -4461,9 +4455,8 @@ lemma invokeTCB_SetTLSBase_ccorres:
        apply (rule ccorres_return_CE, simp+)[1]
       apply (wpsimp wp: hoare_drop_imp simp: guard_is_UNIV_def)+
    apply vcg
-  apply (clarsimp simp: tlsBaseRegister_def RISCV64.tlsBaseRegister_def
-                        invs_weak_sch_act_wf invs_queues C_register_defs
-                 split: if_split)
+  apply (fastforce simp: tlsBaseRegister_def RISCV64.tlsBaseRegister_def
+                         invs_weak_sch_act_wf C_register_defs)
   done
 
 lemma decodeSetTLSBase_ccorres:
diff --git a/proof/crefine/RISCV64/Wellformed_C.thy b/proof/crefine/RISCV64/Wellformed_C.thy
index f28a56f303..f7924396c6 100644
--- a/proof/crefine/RISCV64/Wellformed_C.thy
+++ b/proof/crefine/RISCV64/Wellformed_C.thy
@@ -151,10 +151,6 @@ where
 abbreviation
   "ep_queue_relation \<equiv> tcb_queue_relation tcbEPNext_C tcbEPPrev_C"
 
-abbreviation
-  "sched_queue_relation \<equiv> tcb_queue_relation tcbSchedNext_C tcbSchedPrev_C"
-
-
 definition
 wordSizeCase :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" where
 "wordSizeCase a b \<equiv> (if bitSize (undefined::machine_word) = 32
diff --git a/proof/crefine/X64/ADT_C.thy b/proof/crefine/X64/ADT_C.thy
index d113aa6f15..049d7689c0 100644
--- a/proof/crefine/X64/ADT_C.thy
+++ b/proof/crefine/X64/ADT_C.thy
@@ -75,8 +75,8 @@ lemma Basic_sem_eq:
 
 lemma setTCBContext_C_corres:
   "\<lbrakk> ccontext_relation tc tc'; t' = tcb_ptr_to_ctcb_ptr t \<rbrakk> \<Longrightarrow>
-  corres_underlying rf_sr nf nf' dc (pspace_domain_valid and tcb_at' t) \<top>
-    (threadSet (\<lambda>tcb. tcb \<lparr> tcbArch := atcbContextSet tc (tcbArch tcb)\<rparr>) t) (setTCBContext_C tc' t')"
+   corres_underlying rf_sr nf nf' dc (pspace_domain_valid and tcb_at' t) \<top>
+     (threadSet (\<lambda>tcb. tcb \<lparr> tcbArch := atcbContextSet tc (tcbArch tcb)\<rparr>) t) (setTCBContext_C tc' t')"
   apply (simp add: setTCBContext_C_def exec_C_def Basic_sem_eq corres_underlying_def)
   apply clarsimp
   apply (simp add: threadSet_def bind_assoc split_def exec_gets)
@@ -107,8 +107,6 @@ lemma setTCBContext_C_corres:
   apply (simp add: cep_relations_drop_fun_upd)
   apply (apply_conjunct \<open>match conclusion in \<open>fpu_null_state_relation _\<close> \<Rightarrow>
          \<open>simp add: fpu_null_state_heap_update_span_disjoint[OF tcb_at'_non_kernel_data_ref]\<close>\<close>)
-  apply (apply_conjunct \<open>match conclusion in \<open>cready_queues_relation _ _ _\<close> \<Rightarrow>
-         \<open>erule cready_queues_relation_not_queue_ptrs; rule ext; simp split: if_split\<close>\<close>)
   apply (drule ko_at_projectKO_opt)
   apply (erule (2) cmap_relation_upd_relI)
     apply (simp add: ctcb_relation_def carch_tcb_relation_def)
@@ -619,25 +617,51 @@ lemma tcb_queue_rel'_unique:
   apply (erule(2) tcb_queue_rel_unique)
   done
 
-definition
-  cready_queues_to_H
-  :: "(tcb_C ptr \<rightharpoonup> tcb_C) \<Rightarrow> (tcb_queue_C[num_tcb_queues]) \<Rightarrow> word8 \<times> word8 \<Rightarrow> machine_word list"
+
+definition tcb_queue_C_to_tcb_queue :: "tcb_queue_C \<Rightarrow> tcb_queue" where
+  "tcb_queue_C_to_tcb_queue q \<equiv>
+     TcbQueue (if head_C q = NULL then None else Some (ctcb_ptr_to_tcb_ptr (head_C q)))
+              (if end_C q = NULL then None else Some (ctcb_ptr_to_tcb_ptr (end_C q)))"
+
+definition cready_queues_to_H ::
+  "tcb_queue_C[num_tcb_queues] \<Rightarrow> (domain \<times> priority \<Rightarrow> ready_queue)"
   where
-  "cready_queues_to_H h_tcb cs \<equiv> \<lambda>(qdom, prio). if ucast minDom \<le> qdom \<and> qdom \<le> ucast maxDom
-              \<and> ucast seL4_MinPrio \<le> prio \<and> prio \<le> ucast seL4_MaxPrio
-   then THE aq. let cqueue = index cs (cready_queues_index_to_C qdom prio)
-    in sched_queue_relation' h_tcb aq (head_C cqueue) (StateRelation_C.end_C cqueue)
-   else []"
+  "cready_queues_to_H cs \<equiv>
+     \<lambda>(qdom, prio).
+       if qdom \<le> maxDomain \<and> prio \<le> maxPriority
+       then let cqueue = index cs (cready_queues_index_to_C qdom prio)
+             in tcb_queue_C_to_tcb_queue cqueue
+       else TcbQueue None None"
 
 lemma cready_queues_to_H_correct:
-  "cready_queues_relation (clift s) cs as \<Longrightarrow>
-   cready_queues_to_H (clift s) cs = as"
-  apply (clarsimp simp: cready_queues_to_H_def cready_queues_relation_def
-                   fun_eq_iff)
-  apply (rule the_equality)
-   apply simp
-  apply (clarsimp simp: Let_def)
-  apply (rule_tac hp="clift s" in tcb_queue_rel'_unique, simp_all add: lift_t_NULL)
+  "\<lbrakk>cready_queues_relation (ksReadyQueues s) (ksReadyQueues_' ch);
+    no_0_obj' s; ksReadyQueues_asrt s; pspace_aligned' s; pspace_distinct' s\<rbrakk>
+   \<Longrightarrow> cready_queues_to_H (ksReadyQueues_' ch) = ksReadyQueues s"
+  apply (clarsimp simp: cready_queues_to_H_def cready_queues_relation_def Let_def)
+  apply (clarsimp simp: fun_eq_iff)
+  apply (rename_tac d p)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply (clarsimp simp: ready_queue_relation_def ksReadyQueues_asrt_def)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply clarsimp
+  apply (frule (3) obj_at'_tcbQueueHead_ksReadyQueues)
+  apply (frule (3) obj_at'_tcbQueueEnd_ksReadyQueues)
+  apply (frule tcbQueueHead_iff_tcbQueueEnd)
+  apply (rule conjI)
+   apply (clarsimp simp: tcb_queue_C_to_tcb_queue_def ctcb_queue_relation_def option_to_ctcb_ptr_def)
+   apply (case_tac "tcbQueueHead (ksReadyQueues s (d, p)) = None")
+    apply (clarsimp simp: tcb_queue.expand)
+   apply clarsimp
+   apply (rename_tac queue_head queue_end)
+   apply (prop_tac "tcb_at' queue_head s", fastforce simp: tcbQueueEmpty_def obj_at'_def)
+   apply (prop_tac "tcb_at' queue_end s", fastforce simp: tcbQueueEmpty_def obj_at'_def)
+   apply (drule kernel.tcb_at_not_NULL)+
+   apply (fastforce simp: tcb_queue.expand kernel.ctcb_ptr_to_ctcb_ptr)
+  apply (clarsimp simp: tcbQueueEmpty_def ctcb_queue_relation_def option_to_ctcb_ptr_def
+                 split: option.splits;
+         metis tcb_queue.exhaust_sel word_not_le)
   done
 
 (* showing that cpspace_relation is actually unique >>>*)
@@ -786,12 +810,15 @@ lemma cthread_state_rel_imp_eq:
   apply (cases y, simp_all add: ThreadState_defs)+
   done
 
-lemma ksPSpace_valid_objs_tcbBoundNotification_nonzero:
-  "\<exists>s. ksPSpace s = ah \<and> no_0_obj' s \<and> valid_objs' s
-     \<Longrightarrow> map_to_tcbs ah p = Some tcb \<Longrightarrow> tcbBoundNotification tcb \<noteq> Some 0"
+lemma map_to_tcbs_Some_refs_nonzero:
+  "\<lbrakk>map_to_tcbs (ksPSpace s) p = Some tcb; no_0_obj' s; valid_objs' s\<rbrakk>
+   \<Longrightarrow> tcbBoundNotification tcb \<noteq> Some 0
+       \<and> tcbSchedPrev tcb \<noteq> Some 0
+       \<and> tcbSchedNext tcb \<noteq> Some 0"
+  supply word_neq_0_conv[simp del]
   apply (clarsimp simp: map_comp_def split: option.splits)
-  apply (erule(1) valid_objsE')
-  apply (clarsimp simp: projectKOs valid_obj'_def valid_tcb'_def)
+  apply (erule (1) valid_objsE')
+  apply (fastforce simp: projectKOs valid_obj'_def valid_tcb'_def)
   done
 
 lemma atcbContextGet_inj[simp]:
@@ -802,34 +829,75 @@ lemma ccontext_relation_imp_eq2:
   "\<lbrakk>ccontext_relation (atcbContextGet t) x; ccontext_relation (atcbContextGet t') x\<rbrakk> \<Longrightarrow> t = t'"
   by (auto dest: ccontext_relation_imp_eq)
 
+lemma tcb_ptr_to_ctcb_ptr_inj:
+  "tcb_ptr_to_ctcb_ptr x = tcb_ptr_to_ctcb_ptr y \<Longrightarrow> x = y"
+  by (auto simp: tcb_ptr_to_ctcb_ptr_def ctcb_offset_def)
+
+lemma
+  assumes "pspace_aligned' as" "pspace_distinct' as" "valid_tcb' atcb as"
+  shows tcb_at'_tcbBoundNotification:
+    "bound (tcbBoundNotification atcb) \<longrightarrow> ntfn_at' (the (tcbBoundNotification atcb)) as"
+  and tcb_at'_tcbSchedPrev:
+    "tcbSchedPrev atcb \<noteq> None \<longrightarrow> tcb_at' (the (tcbSchedPrev atcb)) as"
+  and tcb_at'_tcbSchedNext:
+    "tcbSchedNext atcb \<noteq> None \<longrightarrow> tcb_at' (the (tcbSchedNext atcb)) as"
+  using assms
+  by (clarsimp simp: valid_tcb'_def obj_at'_def)+
+
 lemma cpspace_tcb_relation_unique:
-  assumes tcbs: "cpspace_tcb_relation ah ch" "cpspace_tcb_relation ah' ch"
-      and   vs: "\<exists>s. ksPSpace s = ah \<and> no_0_obj' s \<and> valid_objs' s"
-      and   vs': "\<exists>s. ksPSpace s = ah' \<and> no_0_obj' s \<and> valid_objs' s"
-  assumes ctes: " \<forall>tcb tcb'. (\<exists>p. map_to_tcbs ah p = Some tcb \<and>
-                                  map_to_tcbs ah' p = Some tcb') \<longrightarrow>
-                  (\<forall>x\<in>ran tcb_cte_cases. fst x tcb' = fst x tcb)"
-  shows "map_to_tcbs ah' = map_to_tcbs ah"
+  assumes tcbs: "cpspace_tcb_relation (ksPSpace as) ch" "cpspace_tcb_relation (ksPSpace as') ch"
+  assumes   vs: "no_0_obj' as" "valid_objs' as"
+  assumes  vs': "no_0_obj' as'" "valid_objs' as'"
+  assumes   ad: "pspace_aligned' as" "pspace_distinct' as"
+  assumes  ad': "pspace_aligned' as'" "pspace_distinct' as'"
+  assumes ctes: "\<forall>tcb tcb'. (\<exists>p. map_to_tcbs (ksPSpace as) p = Some tcb \<and>
+                                 map_to_tcbs (ksPSpace as') p = Some tcb') \<longrightarrow>
+                 (\<forall>x\<in>ran tcb_cte_cases. fst x tcb' = fst x tcb)"
+  shows "map_to_tcbs (ksPSpace as') = map_to_tcbs (ksPSpace as)"
   using tcbs(2) tcbs(1)
   apply (clarsimp simp add: cmap_relation_def)
   apply (drule inj_image_inv[OF inj_tcb_ptr_to_ctcb_ptr])+
   apply (simp add: tcb_ptr_to_ctcb_ptr_def[abs_def] ctcb_offset_def)
   apply (rule ext)
-  apply (case_tac "x:dom (map_to_tcbs ah)")
+  apply (case_tac "x \<in> dom (map_to_tcbs (ksPSpace as))")
    apply (drule bspec, assumption)+
    apply (simp add: dom_def Collect_eq, drule_tac x=x in spec)
    apply clarsimp
    apply (rename_tac p x y)
    apply (cut_tac ctes)
    apply (drule_tac x=x in spec, drule_tac x=y in spec, erule impE, fastforce)
-   apply (frule ksPSpace_valid_objs_tcbBoundNotification_nonzero[OF vs])
-   apply (frule ksPSpace_valid_objs_tcbBoundNotification_nonzero[OF vs'])
+   apply (frule map_to_tcbs_Some_refs_nonzero[OF _ vs])
+   apply (frule map_to_tcbs_Some_refs_nonzero[OF _ vs'])
+   apply (rename_tac atcb atcb')
+   apply (prop_tac "valid_tcb' atcb as")
+    apply (fastforce intro: vs ad map_to_ko_atI tcb_ko_at_valid_objs_valid_tcb')
+   apply (prop_tac "valid_tcb' atcb' as'")
+    apply (fastforce intro: vs' ad' map_to_ko_atI tcb_ko_at_valid_objs_valid_tcb')
+   apply (frule tcb_at'_tcbSchedPrev[OF ad])
+   apply (frule tcb_at'_tcbSchedPrev[OF ad'])
+   apply (frule tcb_at'_tcbSchedNext[OF ad])
+   apply (frule tcb_at'_tcbSchedNext[OF ad'])
    apply (thin_tac "map_to_tcbs x y = Some z" for x y z)+
-   apply (case_tac x, case_tac y, case_tac "the (clift ch (tcb_Ptr (p+0x400)))")
+   apply (case_tac "the (clift ch (tcb_Ptr (p + 2 ^ ctcb_size_bits)))")
    apply (clarsimp simp: ctcb_relation_def ran_tcb_cte_cases)
-   apply (clarsimp simp: option_to_ptr_def option_to_0_def split: option.splits)
-   apply (auto simp: cfault_rel_imp_eq cthread_state_rel_imp_eq carch_tcb_relation_def
-                     ccontext_relation_imp_eq2 up_ucast_inj_eq ctcb_size_bits_def)
+   apply (clarsimp simp: option_to_ctcb_ptr_def option_to_ptr_def option_to_0_def)
+   apply (rule tcb.expand)
+   apply clarsimp
+   apply (intro conjI)
+        apply (simp add: cthread_state_rel_imp_eq)
+       apply (simp add: cfault_rel_imp_eq)
+      apply (case_tac "tcbBoundNotification atcb'", case_tac "tcbBoundNotification atcb"; clarsimp)
+      apply (clarsimp split: option.splits)
+     apply (case_tac "tcbSchedPrev atcb'"; case_tac "tcbSchedPrev atcb"; clarsimp)
+       apply (force dest!: kernel.tcb_at_not_NULL)
+      apply (force dest!: kernel.tcb_at_not_NULL)
+     apply (force simp: tcb_ptr_to_ctcb_ptr_inj)
+    apply (case_tac "tcbSchedNext atcb'"; case_tac "tcbSchedNext atcb"; clarsimp)
+      apply (force dest!: kernel.tcb_at_not_NULL)
+     apply (force dest!: kernel.tcb_at_not_NULL)
+    apply (force simp: tcb_ptr_to_ctcb_ptr_inj)
+   apply (force simp: carch_tcb_relation_def ccontext_relation_imp_eq2)
+  apply auto
   done
 
 lemma tcb_queue_rel_clift_unique:
@@ -860,10 +928,6 @@ lemma ksPSpace_valid_pspace_ntfnBoundTCB_nonzero:
   apply (clarsimp simp: projectKOs valid_obj'_def valid_ntfn'_def)
   done
 
-lemma tcb_ptr_to_ctcb_ptr_inj:
-  "tcb_ptr_to_ctcb_ptr x = tcb_ptr_to_ctcb_ptr y \<Longrightarrow> x = y"
-  by (auto simp: tcb_ptr_to_ctcb_ptr_def ctcb_offset_def)
-
 lemma cpspace_ntfn_relation_unique:
   assumes ntfns: "cpspace_ntfn_relation ah ch" "cpspace_ntfn_relation ah' ch"
       and   vs: "\<exists>s. ksPSpace s = ah \<and> valid_pspace' s"
@@ -1213,8 +1277,8 @@ proof -
                        OF valid_objs'_imp_wf_asid_pool'[OF valid_objs]
                           valid_objs'_imp_wf_asid_pool'[OF valid_objs']])
     apply (drule (1) cpspace_tcb_relation_unique)
-       apply (fastforce intro: no_0_objs no_0_objs' valid_objs valid_objs')
-      apply (fastforce intro: no_0_objs no_0_objs' valid_objs valid_objs')
+       apply (fastforce intro: no_0_objs no_0_objs' valid_objs valid_objs')+
+      apply (fastforce intro: aligned distinct aligned' distinct')+
      apply (intro allI impI,elim exE conjE)
      apply (rule_tac p=p in map_to_ctes_tcb_ctes, assumption)
       apply (frule (1) map_to_ko_atI[OF _ aligned distinct])
@@ -1266,7 +1330,7 @@ lemma ksPSpace_eq_imp_valid_tcb'_eq:
   by (auto simp: ksPSpace_eq_imp_obj_at'_eq[OF ksPSpace]
                  ksPSpace_eq_imp_valid_cap'_eq[OF ksPSpace]
                  ksPSpace_eq_imp_typ_at'_eq[OF ksPSpace]
-                 valid_tcb'_def valid_tcb_state'_def valid_bound_ntfn'_def
+                 valid_tcb'_def valid_tcb_state'_def valid_bound_ntfn'_def valid_bound_tcb'_def
           split: thread_state.splits option.splits)
 
 lemma ksPSpace_eq_imp_valid_arch_obj'_eq:
@@ -1429,7 +1493,7 @@ where
     ksDomSchedule = cDomSchedule_to_H kernel_all_global_addresses.ksDomSchedule,
     ksCurDomain = ucast (ksCurDomain_' s),
     ksDomainTime = ksDomainTime_' s,
-    ksReadyQueues = cready_queues_to_H (clift (t_hrs_' s)) (ksReadyQueues_' s),
+    ksReadyQueues = cready_queues_to_H (ksReadyQueues_' s),
     ksReadyQueuesL1Bitmap = cbitmap_L1_to_H (ksReadyQueuesL1Bitmap_' s),
     ksReadyQueuesL2Bitmap = cbitmap_L2_to_H (ksReadyQueuesL2Bitmap_' s),
     ksCurThread = ctcb_ptr_to_tcb_ptr (ksCurThread_' s),
@@ -1451,16 +1515,16 @@ lemma trivial_eq_conj: "B = C \<Longrightarrow> (A \<and> B) = (A \<and> C)"
 lemma cstate_to_H_correct:
   assumes valid: "valid_state' as"
   assumes cstate_rel: "cstate_relation as cs"
+  assumes rdyqs: "ksReadyQueues_asrt as"
   shows "cstate_to_H cs = as \<lparr>ksMachineState:=  observable_memory (ksMachineState as) (user_mem' as)\<rparr>"
   apply (subgoal_tac "cstate_to_machine_H cs = observable_memory (ksMachineState as) (user_mem' as)")
    apply (rule kernel_state.equality, simp_all add: cstate_to_H_def)
-                      apply (rule cstate_to_pspace_H_correct)
+                    apply (rule cstate_to_pspace_H_correct)
                      using valid
                      apply (simp add: valid_state'_def)
                     using cstate_rel valid
                     apply (clarsimp simp: cstate_relation_def cpspace_relation_def Let_def
-                      observable_memory_def valid_state'_def
-                      valid_pspace'_def)
+                                          observable_memory_def valid_state'_def valid_pspace'_def)
                    using cstate_rel
                    apply (clarsimp simp: cstate_relation_def cpspace_relation_def Let_def prod_eq_iff)
                   using cstate_rel
@@ -1468,10 +1532,10 @@ lemma cstate_to_H_correct:
                  using valid cstate_rel
                  apply (rule mk_gsUntypedZeroRanges_correct)
                 subgoal
-                using cstate_rel
-                by (fastforce simp: cstate_relation_def cpspace_relation_def
-                                    Let_def ghost_size_rel_def unat_eq_0
-                            split: if_split)
+                  using cstate_rel
+                  by (fastforce simp: cstate_relation_def cpspace_relation_def
+                                      Let_def ghost_size_rel_def unat_eq_0
+                              split: if_split)
                using valid cstate_rel
                apply (rule cDomScheduleIdx_to_H_correct)
                using cstate_rel
@@ -1485,8 +1549,13 @@ lemma cstate_to_H_correct:
             using cstate_rel
             apply (clarsimp simp: cstate_relation_def Let_def)
            apply (rule cready_queues_to_H_correct)
-           using cstate_rel
-           apply (clarsimp simp: cstate_relation_def Let_def)
+               using cstate_rel rdyqs
+               apply (fastforce intro!: cready_queues_to_H_correct
+                                  simp: cstate_relation_def Let_def)
+              using valid apply (fastforce simp: valid_state'_def)
+             using rdyqs apply fastforce
+            using valid apply (fastforce simp: valid_state'_def)
+           using valid apply (fastforce simp: valid_state'_def)
           using cstate_rel
           apply (clarsimp simp: cstate_relation_def Let_def)
           using cstate_rel
diff --git a/proof/crefine/X64/ArchMove_C.thy b/proof/crefine/X64/ArchMove_C.thy
index 26bc611b55..7186d5fb65 100644
--- a/proof/crefine/X64/ArchMove_C.thy
+++ b/proof/crefine/X64/ArchMove_C.thy
@@ -249,14 +249,8 @@ lemma sign_extend_canonical_address:
   "(x = sign_extend 47 x) = canonical_address x"
   by (fastforce simp: sign_extended_iff_sign_extend canonical_address_sign_extended)
 
-crunches Arch.switchToThread
-  for valid_queues'[wp]: valid_queues'
-  (simp: crunch_simps)
 crunches switchToIdleThread
   for ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
-crunches switchToIdleThread, switchToThread
-  for valid_pspace'[wp]: valid_pspace'
-  (simp: whenE_def crunch_simps)
 
 lemma setCurrentUserCR3_valid_arch_state'[wp]:
   "\<lbrace>valid_arch_state' and K (valid_cr3' c)\<rbrace> setCurrentUserCR3 c \<lbrace>\<lambda>_. valid_arch_state'\<rbrace>"
diff --git a/proof/crefine/X64/Arch_C.thy b/proof/crefine/X64/Arch_C.thy
index c0dd0e17ba..6d39829d42 100644
--- a/proof/crefine/X64/Arch_C.thy
+++ b/proof/crefine/X64/Arch_C.thy
@@ -1247,8 +1247,8 @@ lemma decodeX64PageTableInvocation_ccorres:
                                  sch_act_wf (ksSchedulerAction b) b \<and> cte_wp_at' (\<lambda>_. True) slot b"
                                  in hoare_strengthen_post)
          apply wp
-        apply (clarsimp simp: isCap_simps invs_valid_objs' valid_cap'_def valid_tcb_state'_def
-                              invs_arch_state' invs_no_0_obj')
+        apply (fastforce simp: isCap_simps invs_valid_objs' valid_cap'_def valid_tcb_state'_def
+                               invs_arch_state' invs_no_0_obj')
        apply vcg
       apply wp
      apply simp
@@ -1854,7 +1854,7 @@ lemma performPageGetAddress_ccorres:
    apply clarsimp
    apply (rule conseqPre, vcg)
    apply clarsimp
-  apply (clarsimp simp: invs_no_0_obj' tcb_at_invs' invs_queues invs_valid_objs' invs_sch_act_wf'
+  apply (clarsimp simp: invs_no_0_obj' tcb_at_invs' invs_valid_objs' invs_sch_act_wf'
                         rf_sr_ksCurThread msgRegisters_unfold
                         seL4_MessageInfo_lift_def message_info_to_H_def mask_def)
   apply (cases isCall)
@@ -2223,9 +2223,9 @@ lemma decodeX86ModeMapPage_ccorres:
     apply (wp injection_wp[OF refl] createMappingEntries_wf)
    apply (simp add: all_ex_eq_helper)
    apply (vcg exspec=createSafeMappingEntries_PDPTE_modifies)
-  by (clarsimp simp: invs_valid_objs' tcb_at_invs' vmsz_aligned_addrFromPPtr' invs_queues
-                     valid_tcb_state'_def invs_sch_act_wf' ThreadState_defs rf_sr_ksCurThread
-                     arch_invocation_label_defs mask_def isCap_simps)
+  by (fastforce simp: invs_valid_objs' tcb_at_invs' vmsz_aligned_addrFromPPtr'
+                      valid_tcb_state'_def invs_sch_act_wf' ThreadState_defs rf_sr_ksCurThread
+                      arch_invocation_label_defs mask_def isCap_simps)
 
 lemma valid_cap'_PageCap_kernel_mappings:
   "\<lbrakk>pspace_in_kernel_mappings' s; isPageCap cap; valid_cap' (ArchObjectCap cap) s\<rbrakk>
@@ -3236,7 +3236,8 @@ lemma decodeX64PageDirectoryInvocation_ccorres:
                                  sch_act_wf (ksSchedulerAction b) b \<and> cte_wp_at' (\<lambda>_. True) slot b"
                         in hoare_strengthen_post)
          apply wp
-        apply (clarsimp simp: isCap_simps invs_valid_objs' valid_cap'_def valid_tcb_state'_def invs_arch_state' invs_no_0_obj')
+        apply (fastforce simp: isCap_simps invs_valid_objs' valid_cap'_def valid_tcb_state'_def
+                               invs_arch_state' invs_no_0_obj')
        apply vcg
       apply wp
      apply simp
@@ -4389,10 +4390,10 @@ lemma decodeX64MMUInvocation_ccorres:
     apply (clarsimp simp: invs_valid_objs')
     apply (rule conjI, fastforce)
     apply (clarsimp simp: ctes_of_valid' invs_valid_objs' isCap_simps)
-    apply (clarsimp simp: ex_cte_cap_wp_to'_def cte_wp_at_ctes_of
-                          invs_sch_act_wf' dest!: isCapDs(1))
+    apply (clarsimp simp: ex_cte_cap_wp_to'_def cte_wp_at_ctes_of invs_pspace_distinct'
+                          invs_sch_act_wf' invs_pspace_aligned'
+                    dest!: isCapDs(1))
     apply (intro conjI)
-            apply (simp add: Invariants_H.invs_queues)
            apply (simp add: valid_tcb_state'_def)
           apply (fastforce elim!: pred_tcb'_weakenE dest!: st_tcb_at_idle_thread')
          apply (clarsimp simp: st_tcb_at'_def obj_at'_def)
@@ -4548,7 +4549,7 @@ lemma invokeX86PortIn8_ccorres:
   notes Collect_const[simp del]
   shows
   "ccorres ((intr_and_se_rel \<circ> Inr) \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
-       (valid_objs' and valid_queues and ct_in_state' ((=) Restart) and
+       (valid_objs' and ct_in_state' ((=) Restart) and pspace_aligned' and pspace_distinct' and
         (\<lambda>s. ksCurThread s = thread \<and> sch_act_wf (ksSchedulerAction s) s))
        (UNIV \<inter> \<lbrace>\<acute>invLabel = scast Kernel_C.X86IOPortIn8\<rbrace>
              \<inter> \<lbrace>\<acute>port = port\<rbrace>
@@ -4636,7 +4637,7 @@ lemma invokeX86PortIn16_ccorres:
   notes Collect_const[simp del]
   shows
   "ccorres ((intr_and_se_rel \<circ> Inr) \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
-       (valid_objs' and valid_queues and ct_in_state' ((=) Restart) and
+       (valid_objs' and ct_in_state' ((=) Restart) and pspace_aligned' and pspace_distinct' and
         (\<lambda>s. ksCurThread s = thread \<and> sch_act_wf (ksSchedulerAction s) s))
        (UNIV \<inter> \<lbrace>\<acute>invLabel = scast Kernel_C.X86IOPortIn16\<rbrace>
              \<inter> \<lbrace>\<acute>port = port\<rbrace>
@@ -4724,7 +4725,7 @@ lemma invokeX86PortIn32_ccorres:
   notes Collect_const[simp del]
   shows
   "ccorres ((intr_and_se_rel \<circ> Inr) \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
-       (valid_objs' and valid_queues and ct_in_state' ((=) Restart) and
+       (valid_objs' and ct_in_state' ((=) Restart) and pspace_aligned' and pspace_distinct' and
         (\<lambda>s. ksCurThread s = thread \<and> sch_act_wf (ksSchedulerAction s) s))
        (UNIV \<inter> \<lbrace>\<acute>invLabel = scast Kernel_C.X86IOPortIn32\<rbrace>
              \<inter> \<lbrace>\<acute>port = port\<rbrace>
@@ -5365,8 +5366,8 @@ proof -
                                       and sch_act_simple and cte_wp_at' \<top> slot
                                       and (\<lambda>s. thread = ksCurThread s)" in hoare_strengthen_post)
                apply (wpsimp wp: getSlotCap_wp)
-              apply (clarsimp simp: unat_less_2p_word_bits invs_queues invs_valid_objs'
-                                    valid_tcb_state'_def
+              apply (clarsimp simp: unat_less_2p_word_bits invs_valid_objs'
+                                    valid_tcb_state'_def invs_pspace_aligned' invs_pspace_distinct'
                                     invs_sch_act_wf' st_tcb_strg'[rule_format] st_tcb_at'_def obj_at'_def
                                     projectKOs word_le_not_less
                              split: thread_state.splits)
@@ -5472,7 +5473,7 @@ proof -
                 apply (rule ccorres_return_CE, simp+)[1]
                apply (rule ccorres_return_C_errorE, simp+)[1]
               apply wp
-             apply (wpsimp wp: ct_in_state'_set sts_running_valid_queues)
+             apply (wpsimp wp: ct_in_state'_set sts_valid_objs')
             apply (simp add: Collect_const_mem intr_and_se_rel_def cintr_def exception_defs)
             apply (vcg exspec=setThreadState_modifies)
            apply clarsimp
@@ -5516,7 +5517,7 @@ proof -
                 apply (rule ccorres_return_CE, simp+)[1]
                apply (rule ccorres_return_C_errorE, simp+)[1]
               apply wp
-             apply (wpsimp wp: ct_in_state'_set sts_running_valid_queues)
+             apply (wpsimp wp: ct_in_state'_set sts_valid_objs')
             apply (simp add: Collect_const_mem intr_and_se_rel_def cintr_def exception_defs)
             apply (vcg exspec=setThreadState_modifies)
            apply clarsimp
@@ -5559,7 +5560,7 @@ proof -
                apply (rule ccorres_return_CE, simp+)[1]
               apply (rule ccorres_return_C_errorE, simp+)[1]
              apply wp
-            apply (wpsimp wp: ct_in_state'_set sts_running_valid_queues)
+            apply (wpsimp wp: ct_in_state'_set sts_valid_objs')
            apply (simp add: Collect_const_mem intr_and_se_rel_def cintr_def exception_defs)
            apply (vcg exspec=setThreadState_modifies)
           apply clarsimp
@@ -5727,7 +5728,7 @@ proof -
      apply (rule syscall_error_throwError_ccorres_n)
      apply (clarsimp simp: syscall_error_to_H_cases)
     apply (clarsimp simp: arch_invocation_label_defs sysargs_rel_to_n valid_tcb_state'_def tcb_at_invs'
-                          invs_queues invs_sch_act_wf' ct_active_st_tcb_at_minor' rf_sr_ksCurThread
+                          invs_sch_act_wf' ct_active_st_tcb_at_minor' rf_sr_ksCurThread
                           ucast_mask_drop[where n=16, simplified mask_def, simplified])
     apply (safe, simp_all add: unat_eq_0 unat_eq_1)
            apply (clarsimp dest!: unat_length_2_helper simp: ThreadState_defs mask_def syscall_error_rel_def
diff --git a/proof/crefine/X64/Detype_C.thy b/proof/crefine/X64/Detype_C.thy
index 9d042490be..eae4571c82 100644
--- a/proof/crefine/X64/Detype_C.thy
+++ b/proof/crefine/X64/Detype_C.thy
@@ -1686,36 +1686,10 @@ proof -
     done
 
   moreover
-  from invs have "valid_queues s" ..
-  hence "\<And>p. \<forall>t \<in> set (ksReadyQueues s p). tcb_at' t s \<and> ko_wp_at' live' t s"
-    apply (clarsimp simp: valid_queues_def valid_queues_no_bitmap_def)
-    apply (drule spec, drule spec)
-    apply clarsimp
-    apply (drule (1) bspec)
-    apply (rule conjI)
-    apply (erule obj_at'_weakenE)
-    apply simp
-    apply (simp add: obj_at'_real_def)
-    apply (erule ko_wp_at'_weakenE)
-    apply (clarsimp simp: live'_def projectKOs inQ_def)
-    done
-  hence tat: "\<And>p. \<forall>t \<in> set (ksReadyQueues s p). tcb_at' t s"
-    and  tlive: "\<And>p. \<forall>t \<in> set (ksReadyQueues s p). ko_wp_at' live' t s"
-    by auto
   from sr have
-    "cready_queues_relation (clift ?th_s)
-        (ksReadyQueues_' (globals s')) (ksReadyQueues s)"
-    unfolding cready_queues_relation_def rf_sr_def cstate_relation_def
-              cpspace_relation_def
-    apply (clarsimp simp: Let_def all_conj_distrib)
-    apply (drule spec, drule spec, drule mp)
-    apply fastforce
-    apply ((subst lift_t_typ_region_bytes, rule cm_disj_tcb, assumption+,
-      simp_all add: objBits_simps archObjSize_def pageBits_def projectKOs)[1])+
-      \<comment> \<open>waiting ...\<close>
-    apply (simp add: tcb_queue_relation_live_restrict
-                     [OF D.valid_untyped tat tlive rl])
-    done
+    "cready_queues_relation (ksReadyQueues s) (ksReadyQueues_' (globals s'))"
+    unfolding cready_queues_relation_def rf_sr_def cstate_relation_def cpspace_relation_def
+    by (clarsimp simp: Let_def all_conj_distrib)
 
   moreover
   from cs have clift:
diff --git a/proof/crefine/X64/Finalise_C.thy b/proof/crefine/X64/Finalise_C.thy
index c9d67ec922..ad5b1dd96b 100644
--- a/proof/crefine/X64/Finalise_C.thy
+++ b/proof/crefine/X64/Finalise_C.thy
@@ -17,6 +17,108 @@ declare if_split [split del]
 definition
   "option_map2 f m = option_map f \<circ> m"
 
+definition ksReadyQueues_head_end_2 :: "(domain \<times> priority \<Rightarrow> ready_queue) \<Rightarrow> bool" where
+  "ksReadyQueues_head_end_2 qs \<equiv>
+     \<forall>d p. tcbQueueHead (qs (d, p)) \<noteq> None \<longleftrightarrow> tcbQueueEnd (qs (d, p)) \<noteq> None"
+
+abbreviation "ksReadyQueues_head_end s \<equiv> ksReadyQueues_head_end_2 (ksReadyQueues s)"
+
+lemmas ksReadyQueues_head_end_def = ksReadyQueues_head_end_2_def
+
+lemma ksReadyQueues_asrt_ksReadyQueues_head_end:
+  "ksReadyQueues_asrt s \<Longrightarrow> ksReadyQueues_head_end s"
+  by (fastforce dest: tcbQueueHead_iff_tcbQueueEnd
+                simp: ready_queue_relation_def ksReadyQueues_asrt_def ksReadyQueues_head_end_def)
+
+lemma tcbSchedEnqueue_ksReadyQueues_head_end[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>ksReadyQueues_head_end\<rbrace>"
+  unfolding tcbSchedEnqueue_def tcbQueuePrepend_def setQueue_def
+  apply (wpsimp wp: threadSet_wp threadGet_wp simp: bitmap_fun_defs)
+  apply (clarsimp simp: tcbQueueEmpty_def obj_at'_def ksReadyQueues_head_end_def split: if_splits)
+  done
+
+lemma ksReadyQueues_head_end_ksSchedulerAction_update[simp]:
+  "ksReadyQueues_head_end (s\<lparr>ksSchedulerAction := ChooseNewThread\<rparr>) = ksReadyQueues_head_end s"
+  by (simp add: ksReadyQueues_head_end_def)
+
+crunches rescheduleRequired
+  for ksReadyQueues_head_end[wp]: ksReadyQueues_head_end
+
+lemma setThreadState_ksReadyQueues_head_end[wp]:
+  "setThreadState ts tcbPtr \<lbrace>ksReadyQueues_head_end\<rbrace>"
+  unfolding setThreadState_def
+  by (wpsimp wp: threadSet_wp threadGet_wp simp: bitmap_fun_defs)
+
+definition ksReadyQueues_head_end_tcb_at'_2 ::
+  "(domain \<times> priority \<Rightarrow> ready_queue) \<Rightarrow> (obj_ref \<rightharpoonup> tcb) \<Rightarrow> bool" where
+  "ksReadyQueues_head_end_tcb_at'_2 qs tcbs \<equiv>
+     \<forall>d p. (\<forall>head. tcbQueueHead (qs (d, p)) = Some head \<longrightarrow> tcbs head \<noteq> None)
+           \<and> (\<forall>end. tcbQueueEnd (qs (d, p)) = Some end \<longrightarrow> tcbs end \<noteq> None)"
+
+abbreviation "ksReadyQueues_head_end_tcb_at' s \<equiv>
+  ksReadyQueues_head_end_tcb_at'_2 (ksReadyQueues s) (tcbs_of' s)"
+
+lemmas ksReadyQueues_head_end_tcb_at'_def = ksReadyQueues_head_end_tcb_at'_2_def
+
+lemma ksReadyQueues_asrt_ksReadyQueues_head_end_tcb_at':
+  "\<lbrakk>ksReadyQueues_asrt s; pspace_aligned' s; pspace_distinct' s\<rbrakk>
+   \<Longrightarrow> ksReadyQueues_head_end_tcb_at' s"
+  apply (clarsimp simp: ready_queue_relation_def ksReadyQueues_asrt_def
+                        ksReadyQueues_head_end_tcb_at'_def)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply (clarsimp simp: list_queue_relation_def)
+  apply (intro conjI impI allI)
+   apply (case_tac "ts = []", clarsimp)
+   apply (fastforce dest!: heap_path_head hd_in_set
+                     simp: opt_pred_def  tcbQueueEmpty_def split: option.splits)
+  apply (fastforce simp: queue_end_valid_def opt_pred_def tcbQueueEmpty_def
+                  split: option.splits)
+  done
+
+lemma tcbSchedEnqueue_ksReadyQueues_head_end_tcb_at'[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>ksReadyQueues_head_end_tcb_at'\<rbrace>"
+  unfolding tcbSchedEnqueue_def tcbQueuePrepend_def setQueue_def
+  apply (wpsimp wp: threadSet_wp threadGet_wp simp: bitmap_fun_defs)
+  apply (clarsimp simp: ksReadyQueues_head_end_tcb_at'_def split: if_splits)
+  done
+
+lemma ksReadyQueues_head_end_tcb_at'_ksSchedulerAction_update[simp]:
+  "ksReadyQueues_head_end_tcb_at' (s\<lparr>ksSchedulerAction := ChooseNewThread\<rparr>)
+   = ksReadyQueues_head_end_tcb_at' s"
+  by (simp add: ksReadyQueues_head_end_tcb_at'_def)
+
+crunches rescheduleRequired
+  for ksReadyQueues_head_end_tcb_at'[wp]: ksReadyQueues_head_end_tcb_at'
+
+lemma setThreadState_ksReadyQueues_head_end_tcb_at'[wp]:
+  "setThreadState ts tcbPtr \<lbrace>ksReadyQueues_head_end_tcb_at'\<rbrace>"
+  unfolding setThreadState_def
+  apply (wpsimp wp: threadSet_wp)
+  apply (fastforce simp: ksReadyQueues_head_end_tcb_at'_def split: if_splits)
+  done
+
+lemma head_end_ksReadyQueues_':
+  "\<lbrakk> (s, s') \<in> rf_sr; ksReadyQueues_head_end s; ksReadyQueues_head_end_tcb_at' s;
+     pspace_aligned' s; pspace_distinct' s;
+     d \<le> maxDomain; p \<le> maxPriority \<rbrakk>
+   \<Longrightarrow> head_C (index (ksReadyQueues_' (globals s')) (cready_queues_index_to_C d p)) = NULL
+       \<longleftrightarrow> end_C (index (ksReadyQueues_' (globals s')) (cready_queues_index_to_C d p)) = NULL"
+  apply (frule (2) rf_sr_ctcb_queue_relation[where d=d and p=p])
+  apply (clarsimp simp: ksReadyQueues_head_end_def)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply (clarsimp simp: ksReadyQueues_head_end_tcb_at'_def)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply (clarsimp simp: ctcb_queue_relation_def option_to_ctcb_ptr_def split: option.splits)
+  apply (rename_tac "end" head end_tcb head_tcb)
+  apply (prop_tac "tcb_at' head s \<and> tcb_at' end s")
+   apply (fastforce intro!: aligned'_distinct'_ko_wp_at'I
+                      simp: obj_at'_real_def opt_map_def split: option.splits)
+  apply (fastforce dest: tcb_at_not_NULL)
+  done
+
 lemma tcbSchedEnqueue_cslift_spec:
   "\<forall>s. \<Gamma>\<turnstile>\<^bsub>/UNIV\<^esub> \<lbrace>s. \<exists>d v. option_map2 tcbPriority_C (cslift s) \<acute>tcb = Some v
                        \<and> unat v \<le> numPriorities
@@ -28,7 +130,9 @@ lemma tcbSchedEnqueue_cslift_spec:
                                            \<noteq> None
                              \<and> option_map2 tcbDomain_C (cslift s)
                                    (head_C (index \<acute>ksReadyQueues (unat (d*0x100 + v))))
-                                           \<noteq> None)\<rbrace>
+                                           \<noteq> None)
+                       \<and> (head_C (index \<acute>ksReadyQueues (unat (d * 0x100 + v))) \<noteq> NULL
+                          \<longleftrightarrow> end_C (index \<acute>ksReadyQueues (unat (d * 0x100 + v))) \<noteq> NULL)\<rbrace>
        Call tcbSchedEnqueue_'proc
       {s'. option_map2 tcbEPNext_C (cslift s') = option_map2 tcbEPNext_C (cslift s)
            \<and> option_map2 tcbEPPrev_C (cslift s') = option_map2 tcbEPPrev_C (cslift s)
@@ -45,8 +149,8 @@ lemma tcbSchedEnqueue_cslift_spec:
   apply (rule conjI)
    apply (clarsimp simp: typ_heap_simps cong: if_cong)
    apply (simp split: if_split)
-  apply (clarsimp simp: typ_heap_simps if_Some_helper cong: if_cong)
-  by (simp split: if_split)
+  by (auto simp: typ_heap_simps' if_Some_helper numPriorities_def
+           cong: if_cong split: if_splits)
 
 lemma setThreadState_cslift_spec:
   "\<forall>s. \<Gamma>\<turnstile>\<^bsub>/UNIV\<^esub> \<lbrace>s. s \<Turnstile>\<^sub>c \<acute>tptr \<and> (\<forall>x. ksSchedulerAction_' (globals s) = tcb_Ptr x
@@ -142,8 +246,9 @@ lemma ctcb_relation_tcbPriority_maxPriority_numPriorities:
   done
 
 lemma tcbSchedEnqueue_cslift_precond_discharge:
-  "\<lbrakk> (s, s') \<in> rf_sr; obj_at' (P :: tcb \<Rightarrow> bool) x s;
-        valid_queues s; valid_objs' s \<rbrakk> \<Longrightarrow>
+  "\<lbrakk> (s, s') \<in> rf_sr; obj_at' (P :: tcb \<Rightarrow> bool) x s; valid_objs' s ;
+     ksReadyQueues_head_end s; ksReadyQueues_head_end_tcb_at' s;
+     pspace_aligned' s; pspace_distinct' s\<rbrakk> \<Longrightarrow>
    (\<exists>d v. option_map2 tcbPriority_C (cslift s') (tcb_ptr_to_ctcb_ptr x) = Some v
         \<and> unat v < numPriorities
         \<and> option_map2 tcbDomain_C (cslift s') (tcb_ptr_to_ctcb_ptr x) = Some d
@@ -154,31 +259,49 @@ lemma tcbSchedEnqueue_cslift_precond_discharge:
                                     \<noteq> None
                   \<and> option_map2 tcbDomain_C (cslift s')
                      (head_C (index (ksReadyQueues_' (globals s')) (unat (d*0x100 + v))))
-                                    \<noteq> None))"
+                                    \<noteq> None)
+        \<and> (head_C (index (ksReadyQueues_' (globals s')) (unat (d * 0x100 + v))) \<noteq> NULL
+           \<longleftrightarrow> end_C (index (ksReadyQueues_' (globals s')) (unat (d * 0x100 + v))) \<noteq> NULL))"
   apply (drule(1) obj_at_cslift_tcb)
   apply (clarsimp simp: typ_heap_simps' option_map2_def)
+  apply (rename_tac tcb tcb')
   apply (frule_tac t=x in valid_objs'_maxPriority, fastforce simp: obj_at'_def)
   apply (frule_tac t=x in valid_objs'_maxDomain, fastforce simp: obj_at'_def)
   apply (drule_tac P="\<lambda>tcb. tcbPriority tcb \<le> maxPriority" in obj_at_ko_at2', simp)
   apply (drule_tac P="\<lambda>tcb. tcbDomain tcb \<le> maxDomain" in obj_at_ko_at2', simp)
   apply (simp add: ctcb_relation_tcbDomain_maxDomain_numDomains
                    ctcb_relation_tcbPriority_maxPriority_numPriorities)
-  apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko"
-              in rf_sr_sched_queue_relation)
+  apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb" in rf_sr_ctcb_queue_relation)
     apply (simp add: maxDom_to_H maxPrio_to_H)+
+  apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb" in head_end_ksReadyQueues_', fastforce+)
   apply (simp add: cready_queues_index_to_C_def2 numPriorities_def le_maxDomain_eq_less_numDomains)
   apply (clarsimp simp: ctcb_relation_def)
   apply (frule arg_cong[where f=unat], subst(asm) unat_ucast_up_simp, simp)
-  apply (frule tcb_queue'_head_end_NULL)
-   apply (erule conjunct1[OF valid_queues_valid_q])
-  apply (frule(1) tcb_queue_relation_qhead_valid')
-   apply (simp add: valid_queues_valid_q)
-  apply (clarsimp simp: h_t_valid_clift_Some_iff)
+  apply (frule (3) head_end_ksReadyQueues_', fastforce+)
+  apply (clarsimp simp: ksReadyQueues_head_end_def)
+  apply (drule_tac x="tcbDomain tcb" in spec)
+  apply (drule_tac x="tcbPriority tcb" in spec)
+  apply (prop_tac "\<not> tcbQueueEmpty ((ksReadyQueues s (tcbDomain tcb, tcbPriority tcb)))")
+   apply (clarsimp simp: tcbQueueEmpty_def ctcb_queue_relation_def option_to_ctcb_ptr_def
+                  split: option.splits)
+  apply (clarsimp simp: ksReadyQueues_head_end_tcb_at'_def)
+  apply (drule_tac x="tcbDomain tcb" in spec)
+  apply (drule_tac x="tcbPriority tcb" in spec)
+  apply clarsimp
+  apply (clarsimp simp: tcbQueueEmpty_def)
+  apply (rename_tac head "end" head_tcb end_tcb)
+  apply (prop_tac "tcb_at' head s")
+   apply (fastforce intro: aligned'_distinct'_ko_wp_at'I
+                     simp: obj_at'_real_def opt_map_def split: option.splits)
+  apply (frule_tac thread=head in obj_at_cslift_tcb)
+   apply fastforce
+  apply (clarsimp dest: obj_at_cslift_tcb simp: ctcb_queue_relation_def option_to_ctcb_ptr_def)
   done
 
 lemma cancel_all_ccorres_helper:
   "ccorres dc xfdc
-      (\<lambda>s. valid_objs' s \<and> valid_queues s
+      (\<lambda>s. valid_objs' s \<and> pspace_aligned' s \<and> pspace_distinct' s
+             \<and> ksReadyQueues_head_end s \<and> ksReadyQueues_head_end_tcb_at' s
              \<and> (\<forall>t\<in>set ts. tcb_at' t s \<and> t \<noteq> 0)
              \<and> sch_act_wf (ksSchedulerAction s) s)
       {s'. \<exists>p. ep_queue_relation (cslift s') ts
@@ -233,11 +356,11 @@ next
            apply (erule cmap_relationE1 [OF cmap_relation_tcb])
             apply (erule ko_at_projectKO_opt)
            apply (fastforce intro: typ_heap_simps)
-          apply (wp sts_running_valid_queues | simp)+
+          apply (wp sts_valid_objs' | simp)+
         apply (rule ceqv_refl)
        apply (rule "Cons.hyps")
       apply (wp sts_valid_objs' sts_sch_act sch_act_wf_lift hoare_vcg_const_Ball_lift
-                sts_running_valid_queues sts_st_tcb' setThreadState_oa_queued | simp)+
+                sts_st_tcb' | simp)+
 
      apply (vcg exspec=setThreadState_cslift_spec exspec=tcbSchedEnqueue_cslift_spec)
     apply (clarsimp simp: tcb_at_not_NULL Collect_const_mem valid_tcb_state'_def
@@ -251,16 +374,13 @@ next
                            st_tcb_at'_def
                     split: scheduler_action.split_asm)
      apply (rename_tac word)
-     apply (frule_tac x=word in tcbSchedEnqueue_cslift_precond_discharge)
-        apply simp
-       apply clarsimp
-      apply clarsimp
-     apply clarsimp
+     apply (frule_tac x=word in tcbSchedEnqueue_cslift_precond_discharge; clarsimp?)
+     apply simp
     apply clarsimp
     apply (rule conjI)
      apply (frule(3) tcbSchedEnqueue_cslift_precond_discharge)
      apply clarsimp
-    apply clarsimp
+    apply clarsimp+
     apply (subst ep_queue_relation_shift, fastforce)
     apply (drule_tac x="tcb_ptr_to_ctcb_ptr thread"
                 in fun_cong)+
@@ -269,11 +389,17 @@ next
     done
 qed
 
+crunches setEndpoint, setNotification
+  for ksReadyQueues_head_end[wp]: ksReadyQueues_head_end
+  and ksReadyQueues_head_end_tcb_at'[wp]: ksReadyQueues_head_end_tcb_at'
+  (simp: updateObject_default_def)
+
 lemma cancelAllIPC_ccorres:
   "ccorres dc xfdc
-   (invs') (UNIV \<inter> {s. epptr_' s = Ptr epptr}) []
+   invs' (UNIV \<inter> {s. epptr_' s = Ptr epptr}) []
    (cancelAllIPC epptr) (Call cancelAllIPC_'proc)"
   apply (cinit lift: epptr_')
+   apply (rule ccorres_stateAssert)
    apply (rule ccorres_symb_exec_l [OF _ getEndpoint_inv _ empty_fail_getEndpoint])
     apply (rule_tac xf'=ret__unsigned_longlong_'
                 and val="case ep of IdleEP \<Rightarrow> scast EPState_Idle
@@ -288,7 +414,7 @@ lemma cancelAllIPC_ccorres:
        apply (simp add: cendpoint_relation_def Let_def
                  split: endpoint.split_asm)
       apply ceqv
-     apply (rule_tac A="invs' and ko_at' ep epptr"
+     apply (rule_tac A="invs' and ksReadyQueues_asrt and ko_at' ep epptr"
               in ccorres_guard_imp2[where A'=UNIV])
       apply wpc
         apply (rename_tac list)
@@ -330,12 +456,11 @@ lemma cancelAllIPC_ccorres:
              apply ceqv
             apply (ctac add: rescheduleRequired_ccorres)
            apply (wp weak_sch_act_wf_lift_linear
-                     cancelAllIPC_mapM_x_valid_queues
                   | simp)+
               apply (rule mapM_x_wp', wp)+
              apply (wp sts_st_tcb')
              apply (clarsimp split: if_split)
-            apply (rule mapM_x_wp', wp)+
+            apply (rule mapM_x_wp', wp sts_valid_objs')+
            apply (clarsimp simp: valid_tcb_state'_def)
           apply (simp add: guard_is_UNIV_def)
          apply (wp set_ep_valid_objs' hoare_vcg_const_Ball_lift
@@ -379,18 +504,21 @@ lemma cancelAllIPC_ccorres:
             apply (rule cancel_all_ccorres_helper)
            apply ceqv
           apply (ctac add: rescheduleRequired_ccorres)
-         apply (wp cancelAllIPC_mapM_x_valid_queues)
-         apply (wp mapM_x_wp' weak_sch_act_wf_lift_linear
+         apply (wp mapM_x_wp' weak_sch_act_wf_lift_linear sts_valid_objs'
                    sts_st_tcb' | clarsimp simp: valid_tcb_state'_def split: if_split)+
         apply (simp add: guard_is_UNIV_def)
        apply (wp set_ep_valid_objs' hoare_vcg_const_Ball_lift
                  weak_sch_act_wf_lift_linear)
       apply vcg
-     apply (clarsimp simp: valid_ep'_def invs_valid_objs' invs_queues)
+     apply (clarsimp simp: valid_ep'_def invs_valid_objs')
      apply (rule cmap_relationE1[OF cmap_relation_ep], assumption)
       apply (erule ko_at_projectKO_opt)
      apply (frule obj_at_valid_objs', clarsimp+)
      apply (clarsimp simp: projectKOs valid_obj'_def valid_ep'_def)
+     apply (frule invs_pspace_aligned')
+     apply (frule invs_pspace_distinct')
+     apply (frule ksReadyQueues_asrt_ksReadyQueues_head_end)
+     apply (frule (2) ksReadyQueues_asrt_ksReadyQueues_head_end_tcb_at')
      subgoal by (auto simp: typ_heap_simps cendpoint_relation_def
                        Let_def tcb_queue_relation'_def
                        invs_valid_objs' valid_objs'_maxDomain valid_objs'_maxPriority
@@ -402,9 +530,10 @@ lemma cancelAllIPC_ccorres:
 
 lemma cancelAllSignals_ccorres:
   "ccorres dc xfdc
-   (invs') (UNIV \<inter> {s. ntfnPtr_' s = Ptr ntfnptr}) []
+   invs' (UNIV \<inter> {s. ntfnPtr_' s = Ptr ntfnptr}) []
    (cancelAllSignals ntfnptr) (Call cancelAllSignals_'proc)"
   apply (cinit lift: ntfnPtr_')
+   apply (rule ccorres_stateAssert)
    apply (rule ccorres_symb_exec_l [OF _ get_ntfn_inv' _ empty_fail_getNotification])
     apply (rule_tac xf'=ret__unsigned_longlong_'
                 and val="case ntfnObj ntfn of IdleNtfn \<Rightarrow> scast NtfnState_Idle
@@ -419,7 +548,7 @@ lemma cancelAllSignals_ccorres:
        apply (simp add: cnotification_relation_def Let_def
                  split: ntfn.split_asm)
       apply ceqv
-     apply (rule_tac A="invs' and ko_at' ntfn ntfnptr"
+     apply (rule_tac A="invs' and ksReadyQueues_asrt and ko_at' ntfn ntfnptr"
               in ccorres_guard_imp2[where A'=UNIV])
       apply wpc
         apply (simp add: notification_state_defs ccorres_cond_iffs)
@@ -460,8 +589,7 @@ lemma cancelAllSignals_ccorres:
             apply (rule cancel_all_ccorres_helper)
            apply ceqv
           apply (ctac add: rescheduleRequired_ccorres)
-         apply (wp cancelAllIPC_mapM_x_valid_queues)
-         apply (wp mapM_x_wp' weak_sch_act_wf_lift_linear
+         apply (wp mapM_x_wp' weak_sch_act_wf_lift_linear sts_valid_objs'
                    sts_st_tcb' | clarsimp simp: valid_tcb_state'_def split: if_split)+
         apply (simp add: guard_is_UNIV_def)
        apply (wp set_ntfn_valid_objs' hoare_vcg_const_Ball_lift
@@ -472,10 +600,14 @@ lemma cancelAllSignals_ccorres:
       apply (erule ko_at_projectKO_opt)
      apply (frule obj_at_valid_objs', clarsimp+)
      apply (clarsimp simp add: valid_obj'_def valid_ntfn'_def projectKOs)
+     apply (frule invs_pspace_aligned')
+     apply (frule invs_pspace_distinct')
+     apply (frule ksReadyQueues_asrt_ksReadyQueues_head_end)
+     apply (frule (2) ksReadyQueues_asrt_ksReadyQueues_head_end_tcb_at')
      subgoal by (auto simp: typ_heap_simps cnotification_relation_def
-                       Let_def tcb_queue_relation'_def
-                       invs_valid_objs' valid_objs'_maxDomain valid_objs'_maxPriority
-               intro!: obj_at_conj')
+                            Let_def tcb_queue_relation'_def
+                            invs_valid_objs' valid_objs'_maxDomain valid_objs'_maxPriority
+                      intro!: obj_at_conj')
     apply (clarsimp simp: guard_is_UNIV_def)
    apply (wp getNotification_wp)
   apply clarsimp
@@ -556,16 +688,16 @@ lemma tcb_queue_relation2_cong:
 
 context kernel_m begin
 
-lemma setThreadState_ccorres_valid_queues'_simple:
-  "ccorres dc xfdc (\<lambda>s. tcb_at' thread s \<and> valid_queues' s \<and> \<not> runnable' st \<and> sch_act_simple s)
+lemma setThreadState_ccorres_simple:
+  "ccorres dc xfdc (\<lambda>s. tcb_at' thread s \<and> \<not> runnable' st \<and> sch_act_simple s)
    ({s'. (\<forall>cl fl. cthread_state_relation_lifted st (cl\<lparr>tsType_CL := ts_' s' && mask 4\<rparr>, fl))}
     \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr thread}) []
          (setThreadState st thread) (Call setThreadState_'proc)"
   apply (cinit lift: tptr_' cong add: call_ignore_cong)
     apply (ctac (no_vcg) add: threadSet_tcbState_simple_corres)
    apply (ctac add: scheduleTCB_ccorres_valid_queues'_simple)
-  apply (wp threadSet_valid_queues'_and_not_runnable')
-  apply (clarsimp simp: weak_sch_act_wf_def valid_queues'_def)
+  apply (wp threadSet_tcbState_st_tcb_at')
+  apply (fastforce simp: weak_sch_act_wf_def)
   done
 
 lemma updateRestartPC_ccorres:
@@ -581,9 +713,7 @@ lemma updateRestartPC_ccorres:
   done
 
 crunches updateRestartPC
-  for valid_queues'[wp]: valid_queues'
-  and sch_act_simple[wp]: sch_act_simple
-  and valid_queues[wp]: Invariants_H.valid_queues
+  for sch_act_simple[wp]: sch_act_simple
   and valid_objs'[wp]: valid_objs'
   and tcb_at'[wp]: "tcb_at' p"
 
@@ -627,21 +757,12 @@ lemma suspend_ccorres:
           apply (ctac (no_vcg) add: updateRestartPC_ccorres)
          apply (rule ccorres_return_Skip)
         apply ceqv
-       apply (ctac(no_vcg) add: setThreadState_ccorres_valid_queues'_simple)
-        apply (ctac add: tcbSchedDequeue_ccorres')
-       apply (rule_tac Q="\<lambda>_.
-                           (\<lambda>s. \<forall>t' d p. (t' \<in> set (ksReadyQueues s (d, p)) \<longrightarrow>
-                                 obj_at' (\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d
-                                                              \<and> tcbPriority tcb = p) t' s \<and>
-                   (t' \<noteq> thread \<longrightarrow> st_tcb_at' runnable' t' s)) \<and>
-                   distinct (ksReadyQueues s (d, p))) and valid_queues' and valid_objs' and tcb_at' thread"
-                 in hoare_post_imp)
+       apply (ctac(no_vcg) add: setThreadState_ccorres_simple)
+        apply (ctac add: tcbSchedDequeue_ccorres)
+       apply (rule_tac Q="\<lambda>_. valid_objs' and tcb_at' thread and pspace_aligned' and pspace_distinct'"
+                    in hoare_post_imp)
         apply clarsimp
-        apply (drule_tac x="t" in spec)
-        apply (drule_tac x=d in spec)
-        apply (drule_tac x=p in spec)
-        apply (clarsimp elim!: obj_at'_weakenE simp: inQ_def)
-       apply (wp sts_valid_queues_partial)[1]
+       apply (wp sts_valid_objs')[1]
       apply clarsimp
       apply (wpsimp simp: valid_tcb_state'_def)
      apply clarsimp
@@ -656,8 +777,7 @@ lemma suspend_ccorres:
       apply (rule cancelIPC_sch_act_simple)
      apply (rule cancelIPC_tcb_at'[where t=thread])
     apply (rule delete_one_conc_fr.cancelIPC_invs)
-   apply (fastforce simp: invs_valid_queues' invs_queues invs_valid_objs'
-                          valid_tcb_state'_def)
+   apply (fastforce simp: invs_valid_objs' valid_tcb_state'_def)
   apply (auto simp: ThreadState_defs)
   done
 
@@ -1747,23 +1867,6 @@ lemma ep_queue_relation_shift2:
   apply (clarsimp split: option.split_asm)
   done
 
-lemma sched_queue_relation_shift:
-  "(option_map2 tcbSchedNext_C (f (cslift s))
-         = option_map2 tcbSchedNext_C (cslift s)
-    \<and> option_map2 tcbSchedPrev_C (f (cslift s))
-         = option_map2 tcbSchedPrev_C (cslift s))
-     \<Longrightarrow>  sched_queue_relation (f (cslift s)) ts qPrev qHead
-          =  sched_queue_relation (cslift s) ts qPrev qHead"
-  apply clarsimp
-  apply (induct ts arbitrary: qPrev qHead)
-   apply simp
-  apply simp
-  apply (simp add: option_map2_def fun_eq_iff
-                   map_option_case)
-  apply (drule_tac x=qHead in spec)+
-  apply (clarsimp split: option.split_asm)
-  done
-
 lemma cendpoint_relation_udpate_arch:
   "\<lbrakk> cslift x p = Some tcb ; cendpoint_relation (cslift x) v v' \<rbrakk>
     \<Longrightarrow> cendpoint_relation ((cslift x)(p \<mapsto> tcbArch_C_update f tcb)) v v'"
diff --git a/proof/crefine/X64/Interrupt_C.thy b/proof/crefine/X64/Interrupt_C.thy
index f623cebd71..4f21490401 100644
--- a/proof/crefine/X64/Interrupt_C.thy
+++ b/proof/crefine/X64/Interrupt_C.thy
@@ -258,7 +258,7 @@ lemma decodeIRQHandlerInvocation_ccorres:
     apply (simp add: syscall_error_to_H_cases)
    apply simp
   apply (clarsimp simp: Collect_const_mem tcb_at_invs')
-  apply (clarsimp simp: invs_queues invs_valid_objs'
+  apply (clarsimp simp: invs_valid_objs'
                         ct_in_state'_def
                         ccap_rights_relation_def
                         mask_def[where n=4] ThreadState_defs)
@@ -274,7 +274,7 @@ lemma decodeIRQHandlerInvocation_ccorres:
                     excaps_map_def excaps_in_mem_def word_less_nat_alt hd_conv_nth
                     slotcap_in_mem_def valid_tcb_state'_def
              dest!: interpret_excaps_eq split: bool.splits)+
-     apply (auto dest: st_tcb_at_idle_thread' ctes_of_valid')[4]
+     apply (auto dest: st_tcb_at_idle_thread' ctes_of_valid')[6]
     apply (drule ctes_of_valid')
      apply fastforce
     apply (clarsimp simp add:valid_cap_simps' X64.maxIRQ_def)
@@ -863,9 +863,9 @@ from assms show ?thesis
               apply (rule hoare_weaken_pre[where P="?pre"])
                apply (rule isIRQActive_wp)
               apply (clarsimp simp: sysargs_rel_to_n unat_less_2p_word_bits
-                                    invs_valid_objs' tcb_at_invs' invs_queues valid_tcb_state'_def
+                                    invs_valid_objs' tcb_at_invs' valid_tcb_state'_def
                                     invs_sch_act_wf' ct_in_state'_def cte_wp_at_weakenE'
-                                    pred_tcb'_weakenE)
+                                    pred_tcb'_weakenE invs_pspace_aligned' invs_pspace_distinct')
               apply (subst pred_tcb'_weakenE, assumption, fastforce)+
               apply (rule conjI)
                apply (rule TrueI)
@@ -962,9 +962,9 @@ from assms show ?thesis
                           apply (rule hoare_weaken_pre[where P="?pre"])
                            apply wp
                           apply (clarsimp simp: invs_valid_objs' tcb_at_invs'
-                                                invs_queues valid_tcb_state'_def
+                                                valid_tcb_state'_def invs_pspace_aligned'
                                                 invs_sch_act_wf' ct_in_state'_def
-                                                cte_wp_at_weakenE')
+                                                cte_wp_at_weakenE' invs_pspace_distinct')
                           apply (subst pred_tcb'_weakenE, assumption, fastforce)+
                           apply (intro conjI impI)
                             apply (rule TrueI)+
@@ -995,7 +995,7 @@ from assms show ?thesis
      apply clarsimp
      apply (fastforce simp: guard_is_UNIV_def interpret_excaps_eq excaps_map_def
                       split: Product_Type.prod.split)
-    apply (auto simp: invs_queues invs_valid_objs' ct_in_state'_def irqIntOffset_def
+    apply (auto simp: invs_valid_objs' ct_in_state'_def irqIntOffset_def
                       ccap_rights_relation_def mask_def[where n=4]
                       ThreadState_defs rf_sr_ksCurThread cte_wp_at_ctes_of
                       sysargs_rel_def sysargs_rel_n_def
diff --git a/proof/crefine/X64/Invoke_C.thy b/proof/crefine/X64/Invoke_C.thy
index 55ed9207d4..c973fecac7 100644
--- a/proof/crefine/X64/Invoke_C.thy
+++ b/proof/crefine/X64/Invoke_C.thy
@@ -79,15 +79,14 @@ lemma setDomain_ccorres:
                             and (\<lambda>s. curThread = ksCurThread s)"
               in hoare_strengthen_post)
       apply (wp threadSet_all_invs_but_sch_extra)
-     apply (clarsimp simp: valid_pspace_valid_objs' st_tcb_at_def[symmetric]
-                           sch_act_simple_def st_tcb_at'_def weak_sch_act_wf_def
-                    split: if_splits)
+     apply (fastforce simp: valid_pspace_valid_objs' st_tcb_at_def[symmetric]
+                            sch_act_simple_def st_tcb_at'_def weak_sch_act_wf_def
+                     split: if_splits)
     apply (simp add: guard_is_UNIV_def)
-   apply (rule_tac Q="\<lambda>_. invs' and tcb_at' t and sch_act_simple
-                          and (\<lambda>s. curThread = ksCurThread s \<and> (\<forall>p. t \<notin> set (ksReadyQueues s p)))"
+   apply (rule_tac Q="\<lambda>_. invs' and tcb_at' t and sch_act_simple and (\<lambda>s. curThread = ksCurThread s)"
             in hoare_strengthen_post)
     apply (wp weak_sch_act_wf_lift_linear tcbSchedDequeue_not_queued
-              tcbSchedDequeue_not_in_queue hoare_vcg_imp_lift hoare_vcg_all_lift)
+              hoare_vcg_imp_lift hoare_vcg_all_lift)
    apply (clarsimp simp: invs'_def valid_pspace'_def valid_state'_def)
   apply (fastforce simp: valid_tcb'_def tcb_cte_cases_def
                          invs'_def valid_state'_def valid_pspace'_def)
@@ -195,8 +194,8 @@ lemma decodeDomainInvocation_ccorres:
    apply clarsimp
    apply (vcg exspec=getSyscallArg_modifies)
 
-  apply (clarsimp simp: valid_tcb_state'_def invs_valid_queues' invs_valid_objs'
-                        invs_queues invs_sch_act_wf' ct_in_state'_def pred_tcb_at'
+  apply (clarsimp simp: valid_tcb_state'_def invs_valid_objs'
+                        invs_sch_act_wf' ct_in_state'_def pred_tcb_at'
                         rf_sr_ksCurThread word_sle_def word_sless_def sysargs_rel_to_n
                         mask_eq_iff_w2p mask_eq_iff_w2p word_size ThreadState_defs)
   apply (rule conjI)
@@ -206,7 +205,7 @@ lemma decodeDomainInvocation_ccorres:
    apply (drule_tac x="extraCaps ! 0" and P="\<lambda>v. valid_cap' (fst v) s" in bspec)
     apply (clarsimp simp: nth_mem interpret_excaps_test_null excaps_map_def)
    apply (clarsimp simp: valid_cap_simps' pred_tcb'_weakenE active_runnable')
-   apply (rule conjI)
+   apply (intro conjI; fastforce?)
     apply (fastforce simp: tcb_st_refs_of'_def elim:pred_tcb'_weakenE)
    apply (simp add: word_le_nat_alt unat_ucast unat_numDomains_to_H le_maxDomain_eq_less_numDomains)
   apply (clarsimp simp: ccap_relation_def cap_to_H_simps cap_thread_cap_lift)
@@ -758,15 +757,15 @@ lemma decodeCNodeInvocation_ccorres:
                               apply simp
                               apply (wp injection_wp_E[OF refl])
                               apply (rule hoare_post_imp_R)
-                               apply (rule_tac Q'="\<lambda>rv. valid_pspace' and valid_queues
+                               apply (rule_tac Q'="\<lambda>rv. valid_pspace'
                                                     and valid_cap' rv and valid_objs'
                                                          and tcb_at' thread and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)"
                                            in hoare_vcg_R_conj)
                                 apply (rule deriveCap_Null_helper[OF deriveCap_derived])
                                apply wp
                               apply (clarsimp simp: cte_wp_at_ctes_of)
-                              apply (simp add: is_derived'_def badge_derived'_def
-                                               valid_tcb_state'_def)
+                              apply (fastforce simp: is_derived'_def badge_derived'_def
+                                                     valid_tcb_state'_def)
                              apply (simp add: Collect_const_mem all_ex_eq_helper)
                              apply (vcg exspec=deriveCap_modifies)
                             apply wp
@@ -834,14 +833,14 @@ lemma decodeCNodeInvocation_ccorres:
                                   apply (simp add: conj_comms valid_tcb_state'_def)
                                   apply (wp injection_wp_E[OF refl])
                                   apply (rule hoare_post_imp_R)
-                                   apply (rule_tac Q'="\<lambda>rv. valid_pspace' and valid_queues
+                                   apply (rule_tac Q'="\<lambda>rv. valid_pspace'
                                                         and valid_cap' rv and valid_objs'
                                                              and tcb_at' thread and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)"
                                                in hoare_vcg_R_conj)
                                     apply (rule deriveCap_Null_helper [OF deriveCap_derived])
                                    apply wp
                                   apply (clarsimp simp: cte_wp_at_ctes_of)
-                                  apply (simp add: is_derived'_def badge_derived'_def)
+                                  apply (fastforce simp: is_derived'_def badge_derived'_def)
                                  apply (simp add: Collect_const_mem all_ex_eq_helper)
                                  apply (vcg exspec=deriveCap_modifies)
                                 apply (simp add: Collect_const_mem)
@@ -949,12 +948,14 @@ lemma decodeCNodeInvocation_ccorres:
                      apply (rule_tac Q'="\<lambda>a b. cte_wp_at' (\<lambda>x. True) a b \<and> invs' b \<and>
                        tcb_at' thread b  \<and> sch_act_wf (ksSchedulerAction b) b \<and> valid_tcb_state' Restart b
                        \<and> Q2 b" for Q2 in  hoare_post_imp_R)
-                       prefer 2
-                       apply (clarsimp simp:cte_wp_at_ctes_of)
-                       apply (drule ctes_of_valid')
-                         apply (erule invs_valid_objs')
-                        apply (clarsimp simp:valid_updateCapDataI invs_queues invs_valid_objs' invs_valid_pspace')
-                       apply (assumption)
+                      prefer 2
+                      apply (clarsimp simp:cte_wp_at_ctes_of)
+                      apply (drule ctes_of_valid')
+                       apply (erule invs_valid_objs')
+                      apply (frule invs_pspace_aligned')
+                      apply (frule invs_pspace_distinct')
+                      apply (clarsimp simp:valid_updateCapDataI invs_valid_objs' invs_valid_pspace')
+                      apply assumption
                      apply (wp hoare_vcg_all_lift_R injection_wp_E[OF refl]
                                lsfco_cte_at' hoare_vcg_const_imp_lift_R
                            )+
@@ -1349,7 +1350,7 @@ lemma decodeCNodeInvocation_ccorres:
    apply simp
    apply (vcg exspec=getSyscallArg_modifies)
   apply (clarsimp simp: valid_tcb_state'_def invs_valid_objs' invs_valid_pspace'
-                        ct_in_state'_def pred_tcb_at' invs_queues
+                        ct_in_state'_def pred_tcb_at'
                         cur_tcb'_def word_sle_def word_sless_def
                         unat_lt2p[where 'a=machine_word_len, folded word_bits_def])
   apply (rule conjI)
@@ -1381,9 +1382,6 @@ end
 
 context begin interpretation Arch . (*FIXME: arch_split*)
 
-crunch valid_queues[wp]: insertNewCap "valid_queues"
-  (wp: crunch_wps)
-
 lemmas setCTE_def3 = setCTE_def2[THEN eq_reflection]
 
 lemma setCTE_sch_act_wf[wp]:
@@ -3299,7 +3297,7 @@ lemma decodeUntypedInvocation_ccorres_helper:
                       and sch_act_simple and ct_active'" in hoare_post_imp_R)
                    prefer 2
                    apply (clarsimp simp: invs_valid_objs' invs_mdb'
-                      invs_queues ct_in_state'_def pred_tcb_at')
+                                         ct_in_state'_def pred_tcb_at')
                    apply (subgoal_tac "ksCurThread s \<noteq> ksIdleThread sa")
                     prefer 2
                     apply clarsimp
diff --git a/proof/crefine/X64/IpcCancel_C.thy b/proof/crefine/X64/IpcCancel_C.thy
index dc119f4023..b02cee0a07 100644
--- a/proof/crefine/X64/IpcCancel_C.thy
+++ b/proof/crefine/X64/IpcCancel_C.thy
@@ -13,12 +13,12 @@ context kernel_m
 begin
 
 lemma cready_queues_index_to_C_in_range':
-  assumes prems: "qdom \<le> ucast maxDom" "prio \<le> ucast maxPrio"
+  assumes prems: "qdom \<le> maxDomain" "prio \<le> maxPriority"
   shows "cready_queues_index_to_C qdom prio < num_tcb_queues"
 proof -
   have P: "unat prio < numPriorities"
     using prems
-    by (simp add: numPriorities_def seL4_MaxPrio_def Suc_le_lessD unat_le_helper)
+    by (simp add: numPriorities_def Suc_le_lessD unat_le_helper maxDomain_def maxPriority_def)
   have Q: "unat qdom < numDomains"
     using prems
     by (simp add: maxDom_to_H le_maxDomain_eq_less_numDomains word_le_nat_alt)
@@ -32,36 +32,18 @@ lemmas cready_queues_index_to_C_in_range =
 
 lemma cready_queues_index_to_C_inj:
   "\<lbrakk> cready_queues_index_to_C qdom prio = cready_queues_index_to_C qdom' prio';
-     prio \<le> ucast maxPrio; prio' \<le> ucast maxPrio \<rbrakk> \<Longrightarrow> prio = prio' \<and> qdom = qdom'"
+     prio \<le> maxPriority; prio' \<le> maxPriority \<rbrakk> \<Longrightarrow> prio = prio' \<and> qdom = qdom'"
   apply (rule context_conjI)
-  apply (auto simp: cready_queues_index_to_C_def numPriorities_def
+  apply (auto simp: cready_queues_index_to_C_def numPriorities_def maxPriority_def
                     seL4_MaxPrio_def word_le_nat_alt dest: arg_cong[where f="\<lambda>x. x mod 256"])
   done
 
 lemma cready_queues_index_to_C_distinct:
-  "\<lbrakk> qdom = qdom' \<longrightarrow> prio \<noteq> prio'; prio \<le> ucast maxPrio; prio' \<le> ucast maxPrio \<rbrakk>
+  "\<lbrakk> qdom = qdom' \<longrightarrow> prio \<noteq> prio'; prio \<le> maxPriority; prio' \<le> maxPriority \<rbrakk>
    \<Longrightarrow> cready_queues_index_to_C qdom prio \<noteq> cready_queues_index_to_C qdom' prio'"
   apply (auto simp: cready_queues_index_to_C_inj)
   done
 
-lemma cstate_relation_ksReadyQueues_update:
-  "\<lbrakk> cstate_relation hs cs; arr = ksReadyQueues_' cs;
-     sched_queue_relation' (clift (t_hrs_' cs)) v (head_C v') (end_C v');
-     qdom \<le> ucast maxDom; prio \<le> ucast maxPrio \<rbrakk>
-    \<Longrightarrow> cstate_relation (ksReadyQueues_update (\<lambda>qs. qs ((qdom, prio) := v)) hs)
-                        (ksReadyQueues_'_update (\<lambda>_. Arrays.update arr
-                                                        (cready_queues_index_to_C qdom prio) v') cs)"
-  apply (clarsimp simp: cstate_relation_def Let_def
-                        cmachine_state_relation_def
-                        carch_state_relation_def carch_globals_def
-                        cready_queues_relation_def seL4_MinPrio_def minDom_def)
-  apply (frule cready_queues_index_to_C_in_range, assumption)
-  apply clarsimp
-  apply (frule_tac qdom=qdoma and prio=prioa in cready_queues_index_to_C_in_range, assumption)
-  apply (frule cready_queues_index_to_C_distinct, assumption+)
-  apply clarsimp
-  done
-
 lemma cmap_relation_drop_fun_upd:
   "\<lbrakk> cm x = Some v; \<And>v''. rel v'' v = rel v'' v' \<rbrakk>
       \<Longrightarrow> cmap_relation am (cm (x \<mapsto> v')) f rel
@@ -72,16 +54,6 @@ lemma cmap_relation_drop_fun_upd:
   apply (auto split: if_split)
   done
 
-lemma valid_queuesD':
-  "\<lbrakk> obj_at' (inQ d p) t s; valid_queues' s \<rbrakk>
-        \<Longrightarrow> t \<in> set (ksReadyQueues s (d, p))"
-  by (simp add: valid_queues'_def)
-
-lemma invs_valid_queues'[elim!]:
-  "invs' s \<Longrightarrow> valid_queues' s"
-  by (simp add: invs'_def valid_state'_def)
-
-
 lemma ntfn_ptr_get_queue_spec:
   "\<forall>s. \<Gamma> \<turnstile> {\<sigma>. s = \<sigma> \<and> \<sigma> \<Turnstile>\<^sub>c \<^bsup>\<sigma>\<^esup>ntfnPtr} \<acute>ret__struct_tcb_queue_C :== PROC ntfn_ptr_get_queue(\<acute>ntfnPtr)
        \<lbrace>head_C \<acute>ret__struct_tcb_queue_C = Ptr (ntfnQueue_head_CL (notification_lift (the (cslift s \<^bsup>s\<^esup>ntfnPtr)))) \<and>
@@ -236,22 +208,19 @@ lemma cancelSignal_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-            \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-           apply simp
-           apply (rule cendpoint_relation_ntfn_queue [OF invs_sym'], assumption+)
-           apply simp
-           apply (erule (1) map_to_ko_atI')
-          \<comment> \<open>ntfn relation\<close>
-          apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
-          apply (simp add: cnotification_relation_def Let_def NtfnState_Idle_def)
-          apply (simp add: carch_state_relation_def carch_globals_def)
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         apply (clarsimp simp: comp_def)
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+          apply simp
+          apply (rule cendpoint_relation_ntfn_queue [OF invs_sym'], assumption+)
+          apply simp
+          apply (erule (1) map_to_ko_atI')
+         \<comment> \<open>ntfn relation\<close>
+         apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
+         apply (simp add: cnotification_relation_def Let_def NtfnState_Idle_def)
+         apply (simp add: carch_state_relation_def carch_globals_def)
         apply (clarsimp simp: carch_state_relation_def carch_globals_def
                               typ_heap_simps' packed_heap_update_collapse_hrs
                               fpu_null_state_heap_update_tag_disj_simps
@@ -275,33 +244,30 @@ lemma cancelSignal_ccorres_helper:
       apply (elim conjE)
       apply (intro conjI)
            \<comment> \<open>tcb relation\<close>
-           apply (erule ctcb_relation_null_queue_ptrs)
-           apply (clarsimp simp: comp_def)
-          \<comment> \<open>ep relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-          apply simp
-          apply (rule cendpoint_relation_ntfn_queue)
-              apply fastforce
-             apply assumption+
-          apply simp
-          apply (erule (1) map_to_ko_atI')
+          apply (erule ctcb_relation_null_ep_ptrs)
+          apply (clarsimp simp: comp_def)
+         \<comment> \<open>ep relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cendpoint_relation_ntfn_queue)
+             apply fastforce
+            apply assumption+
+         apply simp
+         apply (erule (1) map_to_ko_atI')
          \<comment> \<open>ntfn relation\<close>
-         apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
-          apply (simp add: cnotification_relation_def Let_def isWaitingNtfn_def
-                    split: ntfn.splits split del: if_split)
-          apply (erule iffD1 [OF tcb_queue_relation'_cong [OF refl _ _ refl], rotated -1])
-           apply (clarsimp simp add: h_t_valid_clift_Some_iff)
-           apply (subst tcb_queue_relation'_next_sign; assumption?)
-            apply fastforce
-           apply (simp add: notification_lift_def sign_extend_sign_extend_eq)
-          apply (clarsimp simp: h_t_valid_clift_Some_iff notification_lift_def sign_extend_sign_extend_eq)
-          apply (subst tcb_queue_relation'_prev_sign; assumption?)
+        apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
+         apply (simp add: cnotification_relation_def Let_def isWaitingNtfn_def
+                   split: ntfn.splits split del: if_split)
+         apply (erule iffD1 [OF tcb_queue_relation'_cong [OF refl _ _ refl], rotated -1])
+          apply (clarsimp simp add: h_t_valid_clift_Some_iff)
+          apply (subst tcb_queue_relation'_next_sign; assumption?)
            apply fastforce
-          apply simp
+          apply (simp add: notification_lift_def sign_extend_sign_extend_eq)
+         apply (clarsimp simp: h_t_valid_clift_Some_iff notification_lift_def sign_extend_sign_extend_eq)
+         apply (subst tcb_queue_relation'_prev_sign; assumption?)
+          apply fastforce
          apply simp
-        \<comment> \<open>queue relation\<close>
-        apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-        apply (clarsimp simp: comp_def)
+        apply simp
        subgoal by (clarsimp simp: carch_state_relation_def carch_globals_def
                                   fpu_null_state_heap_update_tag_disj_simps
                                   global_ioport_bitmap_heap_update_tag_disj_simps
@@ -470,68 +436,6 @@ lemma isRunnable_ccorres [corres]:
        apply (simp add: ThreadState_defs)+
   done
 
-
-
-lemma tcb_queue_relation_update_head:
-  fixes getNext_update :: "(tcb_C ptr \<Rightarrow> tcb_C ptr) \<Rightarrow> tcb_C \<Rightarrow> tcb_C" and
-  getPrev_update :: "(tcb_C ptr \<Rightarrow> tcb_C ptr) \<Rightarrow> tcb_C \<Rightarrow> tcb_C"
-  assumes qr: "tcb_queue_relation getNext getPrev mp queue NULL qhead"
-  and     qh': "qhead' \<notin> tcb_ptr_to_ctcb_ptr ` set queue"
-  and  cs_tcb: "mp qhead' = Some tcb"
-  and valid_ep: "\<forall>t\<in>set queue. tcb_at' t s" "distinct queue"
-  and     qhN: "qhead' \<noteq> NULL"
-  and     fgN: "fg_cons getNext (getNext_update \<circ> (\<lambda>x _. x))"
-  and     fgP: "fg_cons getPrev (getPrev_update \<circ> (\<lambda>x _. x))"
-  and     npu: "\<And>f t. getNext (getPrev_update f t) = getNext t"
-  and     pnu: "\<And>f t. getPrev (getNext_update f t) = getPrev t"
-  shows   "tcb_queue_relation getNext getPrev
-                 (upd_unless_null qhead (getPrev_update (\<lambda>_. qhead') (the (mp qhead)))
-                       (mp(qhead' := Some (getPrev_update (\<lambda>_. NULL) (getNext_update (\<lambda>_. qhead)  tcb)))))
-                 (ctcb_ptr_to_tcb_ptr qhead' # queue) NULL qhead'"
-  using qr qh' cs_tcb valid_ep qhN
-  apply (subgoal_tac "qhead \<noteq> qhead'")
-  apply (clarsimp simp: pnu upd_unless_null_def fg_consD1 [OF fgN] fg_consD1 [OF fgP] npu)
-  apply (cases queue)
-    apply simp
-   apply (frule (2) tcb_queue_relation_next_not_NULL)
-    apply simp
-   apply (clarsimp simp: fg_consD1 [OF fgN] fg_consD1 [OF fgP] pnu npu)
-   apply (subst tcb_queue_relation_cong [OF refl refl refl, where mp' = mp])
-    apply (clarsimp simp: inj_eq)
-    apply (intro impI conjI)
-     apply (frule_tac x = x in imageI [where f = tcb_ptr_to_ctcb_ptr])
-     apply simp
-    apply simp
-   apply simp
-  apply clarsimp
-  apply (cases queue)
-   apply simp
-  apply simp
-  done
-
-lemma tcbSchedEnqueue_update:
-  assumes sr: "sched_queue_relation' mp queue qhead qend"
-  and     qh': "qhead' \<notin> tcb_ptr_to_ctcb_ptr ` set queue"
-  and  cs_tcb: "mp qhead' = Some tcb"
-  and valid_ep: "\<forall>t\<in>set queue. tcb_at' t s" "distinct queue"
-  and     qhN: "qhead' \<noteq> NULL"
-  shows
-  "sched_queue_relation'
-                   (upd_unless_null qhead (tcbSchedPrev_C_update (\<lambda>_. qhead') (the (mp qhead)))
-                (mp(qhead' \<mapsto> tcb\<lparr>tcbSchedNext_C := qhead, tcbSchedPrev_C := NULL\<rparr>)))
-            (ctcb_ptr_to_tcb_ptr qhead' # queue) qhead' (if qend = NULL then qhead' else qend)"
-  using sr qh' cs_tcb valid_ep qhN
-  apply -
-  apply (erule tcb_queue_relationE')
-  apply (rule tcb_queue_relationI')
-   apply (erule (5) tcb_queue_relation_update_head
-        [where getNext_update = tcbSchedNext_C_update and getPrev_update = tcbSchedPrev_C_update], simp_all)[1]
-  apply simp
-  apply (intro impI)
-  apply (erule (1) tcb_queue_relation_not_NULL')
-  apply simp
-  done
-
 lemma tcb_ptr_to_ctcb_ptr_imageD:
   "x \<in> tcb_ptr_to_ctcb_ptr ` S \<Longrightarrow> ctcb_ptr_to_tcb_ptr x \<in> S"
   apply (erule imageE)
@@ -544,93 +448,6 @@ lemma ctcb_ptr_to_tcb_ptr_imageI:
   apply simp
   done
 
-lemma tcb_queue'_head_end_NULL:
-  assumes qr: "tcb_queue_relation' getNext getPrev mp queue qhead qend"
-  and   tat: "\<forall>t\<in>set queue. tcb_at' t s"
-  shows "(qend = NULL) = (qhead = NULL)"
-  using qr tat
-  apply -
-  apply (erule tcb_queue_relationE')
-  apply (simp add: tcb_queue_head_empty_iff)
-  apply (rule impI)
-  apply (rule tcb_at_not_NULL)
-  apply (erule bspec)
-  apply simp
-  done
-
-lemma tcb_queue_relation_qhead_mem:
-  "\<lbrakk> tcb_queue_relation getNext getPrev mp queue NULL qhead;
-  (\<forall>tcb\<in>set queue. tcb_at' tcb t) \<rbrakk>
-  \<Longrightarrow> qhead \<noteq> NULL \<longrightarrow> ctcb_ptr_to_tcb_ptr qhead \<in> set queue"
-  by (clarsimp simp: tcb_queue_head_empty_iff tcb_queue_relation_head_hd)
-
-lemma tcb_queue_relation_qhead_valid:
-  "\<lbrakk> tcb_queue_relation getNext getPrev (cslift s') queue NULL qhead;
-  (s, s') \<in> rf_sr; (\<forall>tcb\<in>set queue. tcb_at' tcb s) \<rbrakk>
-  \<Longrightarrow> qhead \<noteq> NULL \<longrightarrow> s' \<Turnstile>\<^sub>c qhead"
-  apply (frule (1) tcb_queue_relation_qhead_mem)
-  apply clarsimp
-  apply(drule (3) tcb_queue_memberD)
-  apply (simp add: h_t_valid_clift_Some_iff)
-  done
-
-lemmas tcb_queue_relation_qhead_mem' = tcb_queue_relation_qhead_mem [OF tcb_queue_relation'_queue_rel]
-lemmas tcb_queue_relation_qhead_valid' = tcb_queue_relation_qhead_valid [OF tcb_queue_relation'_queue_rel]
-
-
-lemma valid_queues_valid_q:
-  "valid_queues s \<Longrightarrow> (\<forall>tcb\<in>set (ksReadyQueues s (qdom, prio)). tcb_at' tcb s) \<and> distinct (ksReadyQueues s (qdom, prio))"
-  apply (clarsimp simp: valid_queues_def valid_queues_no_bitmap_def)
-  apply (drule spec [where x = qdom])
-  apply (drule spec [where x = prio])
-  apply clarsimp
-  apply (drule (1) bspec, erule obj_at'_weakenE)
-  apply simp
-  done
-
-lemma invs_valid_q:
-  "invs' s \<Longrightarrow> (\<forall>tcb\<in>set (ksReadyQueues s (qdom, prio)). tcb_at' tcb s) \<and> distinct (ksReadyQueues s (qdom, prio))"
-  apply (rule valid_queues_valid_q)
-  apply (clarsimp simp: invs'_def valid_state'_def)
-  done
-
-lemma tcbQueued_not_in_queues:
-  assumes vq: "valid_queues s"
-  and    objat: "obj_at' (Not \<circ> tcbQueued) thread s"
-  shows   "thread \<notin> set (ksReadyQueues s (d, p))"
-  using vq objat
-  apply -
-  apply clarsimp
-  apply (drule (1) valid_queues_obj_at'D)
-  apply (erule obj_atE')+
-  apply (clarsimp simp: inQ_def)
-  done
-
-
-lemma rf_sr_sched_queue_relation:
-  "\<lbrakk> (s, s') \<in> rf_sr; d \<le> ucast maxDom; p \<le> ucast maxPrio \<rbrakk>
-  \<Longrightarrow> sched_queue_relation' (cslift s') (ksReadyQueues s (d, p))
-                                        (head_C (index (ksReadyQueues_' (globals s'))
-                                                       (cready_queues_index_to_C d p)))
-                                        (end_C (index (ksReadyQueues_' (globals s'))
-                                                      (cready_queues_index_to_C d p)))"
-  unfolding rf_sr_def cstate_relation_def cready_queues_relation_def
-  apply (clarsimp simp: Let_def seL4_MinPrio_def minDom_def)
-  done
-
-lemma ready_queue_not_in:
-  assumes  vq: "valid_queues s"
-  and     inq: "t \<in> set (ksReadyQueues s (d, p))"
-  and     neq: "d \<noteq> d' \<or> p \<noteq> p'"
-  shows   "t \<notin> set (ksReadyQueues s (d', p'))"
-proof
-  assume "t \<in> set (ksReadyQueues s (d', p'))"
-  hence "obj_at' (inQ d' p') t s" using vq by (rule valid_queues_obj_at'D)
-  moreover have "obj_at' (inQ d p) t s" using inq vq by (rule valid_queues_obj_at'D)
-  ultimately show False using neq
-    by (clarsimp elim!: obj_atE' simp: inQ_def)
-qed
-
 lemma ctcb_relation_unat_prio_eq:
   "ctcb_relation tcb tcb' \<Longrightarrow> unat (tcbPriority tcb) = unat (tcbPriority_C tcb')"
   apply (clarsimp simp: ctcb_relation_def)
@@ -664,138 +481,6 @@ lemma threadSet_queued_ccorres [corres]:
   apply (clarsimp simp: typ_heap_simps)
   done
 
-lemma ccorres_pre_getQueue:
-  assumes cc: "\<And>queue. ccorres r xf (P queue) (P' queue) hs (f queue) c"
-  shows   "ccorres r xf (\<lambda>s. P (ksReadyQueues s (d, p)) s \<and> d \<le> maxDomain \<and> p \<le> maxPriority)
-                        {s'. \<forall>queue. (let cqueue = index (ksReadyQueues_' (globals s'))
-                                                         (cready_queues_index_to_C d p) in
-                                      sched_queue_relation' (cslift s') queue (head_C cqueue) (end_C cqueue)) \<longrightarrow> s' \<in> P' queue}
-           hs (getQueue d p >>= (\<lambda>queue. f queue)) c"
-  apply (rule ccorres_guard_imp2)
-  apply (rule ccorres_symb_exec_l2)
-     defer
-     defer
-     apply (rule gq_sp)
-    defer
-    apply (rule ccorres_guard_imp)
-    apply (rule cc)
-     apply clarsimp
-     apply assumption
-    apply assumption
-   apply (clarsimp simp: getQueue_def gets_exs_valid)
-  apply clarsimp
-  apply (drule spec, erule mp)
-  apply (simp add: Let_def)
-  apply (erule rf_sr_sched_queue_relation)
-   apply (simp add: maxDom_to_H maxPrio_to_H)+
-  done
-
-lemma state_relation_queue_update_helper':
-  "\<lbrakk> (s, s') \<in> rf_sr;
-     (\<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s)
-                                       \<and> distinct (ksReadyQueues s (d, p)));
-          globals t = ksReadyQueues_'_update
-             (\<lambda>_. Arrays.update (ksReadyQueues_' (globals s')) prio' q')
-             (t_hrs_'_update f (globals s'));
-          sched_queue_relation' (cslift t) q (head_C q') (end_C q');
-          cslift t |` ( - tcb_ptr_to_ctcb_ptr ` S )
-             = cslift s' |` ( - tcb_ptr_to_ctcb_ptr ` S );
-          option_map tcb_null_sched_ptrs \<circ> cslift t
-            = option_map tcb_null_sched_ptrs \<circ> cslift s';
-          cslift_all_but_tcb_C t s';
-          zero_ranges_are_zero (gsUntypedZeroRanges s) (f (t_hrs_' (globals s')))
-              = zero_ranges_are_zero (gsUntypedZeroRanges s) (t_hrs_' (globals s'));
-          hrs_htd (t_hrs_' (globals t)) = hrs_htd (t_hrs_' (globals s'));
-          prio' = cready_queues_index_to_C qdom prio;
-          \<forall>x \<in> S. obj_at' (inQ qdom prio) x s
-                   \<or> (obj_at' (\<lambda>tcb. tcbPriority tcb = prio) x s
-                       \<and> obj_at' (\<lambda>tcb. tcbDomain tcb = qdom) x s)
-                   \<or> (tcb_at' x s \<and> (\<forall>d' p'. (d' \<noteq> qdom \<or> p' \<noteq> prio)
-                                         \<longrightarrow> x \<notin> set (ksReadyQueues s (d', p'))));
-          S \<noteq> {}; qdom \<le> ucast maxDom; prio \<le> ucast maxPrio \<rbrakk>
-      \<Longrightarrow> (s \<lparr>ksReadyQueues := (ksReadyQueues s)((qdom, prio) := q)\<rparr>, t) \<in> rf_sr"
-  apply (subst(asm) disj_imp_rhs)
-   apply (subst obj_at'_and[symmetric])
-   apply (rule disjI1, erule obj_at'_weakenE, simp add: inQ_def)
-  apply (subst(asm) disj_imp_rhs)
-   apply (subst(asm) obj_at'_and[symmetric])
-   apply (rule conjI, erule obj_at'_weakenE, simp)
-   apply (rule allI, rule allI)
-   apply (drule_tac x=d' in spec)
-   apply (drule_tac x=p' in spec)
-   apply clarsimp
-   apply (drule(1) bspec)
-   apply (clarsimp simp: inQ_def obj_at'_def)
-  apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def)
-  apply (intro conjI)
-      \<comment> \<open>cpspace_relation\<close>
-     apply (erule nonemptyE, drule(1) bspec)
-     apply (clarsimp simp: cpspace_relation_def)
-     apply (drule obj_at_ko_at', clarsimp)
-     apply (rule cmap_relationE1, assumption,
-            erule ko_at_projectKO_opt)
-     apply (frule null_sched_queue)
-     apply (frule null_sched_epD)
-     apply (intro conjI)
-       \<comment> \<open>tcb relation\<close>
-       apply (drule ctcb_relation_null_queue_ptrs,
-              simp_all)[1]
-      \<comment> \<open>endpoint relation\<close>
-      apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-      apply simp
-      apply (erule cendpoint_relation_upd_tcb_no_queues, simp+)
-     \<comment> \<open>ntfn relation\<close>
-     apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-     apply simp
-     apply (erule cnotification_relation_upd_tcb_no_queues, simp+)
-    \<comment> \<open>ready queues\<close>
-    apply (simp add: cready_queues_relation_def Let_def cready_queues_index_to_C_in_range
-                     seL4_MinPrio_def minDom_def)
-    apply clarsimp
-    apply (frule cready_queues_index_to_C_distinct, assumption+)
-    apply (clarsimp simp: cready_queues_index_to_C_in_range all_conj_distrib)
-    apply (rule iffD1 [OF tcb_queue_relation'_cong[OF refl], rotated -1],
-           drule spec, drule spec, erule mp, simp+)
-    apply clarsimp
-    apply (drule_tac x="tcb_ptr_to_ctcb_ptr x" in fun_cong)+
-    apply (clarsimp simp: restrict_map_def
-                   split: if_split_asm)
-   by (auto simp: carch_state_relation_def cmachine_state_relation_def
-           elim!: fpu_null_state_typ_heap_preservation)
-
-lemma state_relation_queue_update_helper:
-  "\<lbrakk> (s, s') \<in> rf_sr; valid_queues s;
-          globals t = ksReadyQueues_'_update
-             (\<lambda>_. Arrays.update (ksReadyQueues_' (globals s')) prio' q')
-             (t_hrs_'_update f (globals s'));
-          sched_queue_relation' (cslift t) q (head_C q') (end_C q');
-          cslift t |` ( - tcb_ptr_to_ctcb_ptr ` S )
-             = cslift s' |` ( - tcb_ptr_to_ctcb_ptr ` S );
-          option_map tcb_null_sched_ptrs \<circ> cslift t
-            = option_map tcb_null_sched_ptrs \<circ> cslift s';
-          cslift_all_but_tcb_C t s';
-          zero_ranges_are_zero (gsUntypedZeroRanges s) (f (t_hrs_' (globals s')))
-              = zero_ranges_are_zero (gsUntypedZeroRanges s) (t_hrs_' (globals s'));
-          hrs_htd (t_hrs_' (globals t)) = hrs_htd (t_hrs_' (globals s'));
-          prio' = cready_queues_index_to_C qdom prio;
-          \<forall>x \<in> S. obj_at' (inQ qdom prio) x s
-                   \<or> (obj_at' (\<lambda>tcb. tcbPriority tcb = prio) x s
-                       \<and> obj_at' (\<lambda>tcb. tcbDomain tcb = qdom) x s)
-                   \<or> (tcb_at' x s \<and> (\<forall>d' p'. (d' \<noteq> qdom \<or> p' \<noteq> prio)
-                                         \<longrightarrow> x \<notin> set (ksReadyQueues s (d', p'))));
-          S \<noteq> {}; qdom \<le> ucast maxDom; prio \<le> ucast maxPrio \<rbrakk>
-      \<Longrightarrow> (s \<lparr>ksReadyQueues := (ksReadyQueues s)((qdom, prio) := q)\<rparr>, t) \<in> rf_sr"
-  apply (subgoal_tac "\<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s)
-                           \<and> distinct(ksReadyQueues s (d, p))")
-   apply (erule(5) state_relation_queue_update_helper', simp_all)
-  apply (clarsimp simp: valid_queues_def valid_queues_no_bitmap_def)
-  apply (drule_tac x=d in spec)
-  apply (drule_tac x=p in spec)
-  apply (clarsimp)
-  apply (drule(1) bspec)
-  apply (erule obj_at'_weakenE, clarsimp)
-  done
-
 (* FIXME: move *)
 lemma cmap_relation_no_upd:
   "\<lbrakk> cmap_relation a c f rel; a p = Some ko; rel ko v; inj f \<rbrakk> \<Longrightarrow> cmap_relation a (c(f p \<mapsto> v)) f rel"
@@ -840,8 +525,8 @@ lemma cready_queues_index_to_C_def2:
 lemma ready_queues_index_spec:
   "\<forall>s. \<Gamma> \<turnstile> {s'. s' = s \<and> (Kernel_Config.numDomains \<le> 1 \<longrightarrow> dom_' s' = 0)}
        Call ready_queues_index_'proc
-       \<lbrace>\<acute>ret__unsigned_long = (dom_' s) * 0x100 + (prio_' s)\<rbrace>"
-  by vcg (simp add: numDomains_sge_1_simp)
+       \<lbrace>\<acute>ret__unsigned_long = (dom_' s) * word_of_nat numPriorities + (prio_' s)\<rbrace>"
+  by vcg (simp add: numDomains_sge_1_simp numPriorities_def)
 
 lemma prio_to_l1index_spec:
   "\<forall>s. \<Gamma> \<turnstile> {s} Call prio_to_l1index_'proc
@@ -936,56 +621,6 @@ lemma cbitmap_L2_relation_bit_set:
   apply (case_tac "da = d" ; clarsimp simp: num_domains_index_updates)
   done
 
-lemma carch_state_relation_enqueue_simp:
-  "carch_state_relation (ksArchState \<sigma>)
-    (t_hrs_'_update f
-      (globals \<sigma>' \<lparr>ksReadyQueuesL1Bitmap_' := l1upd, ksReadyQueuesL2Bitmap_' := l2upd \<rparr>)
-      \<lparr>ksReadyQueues_' := rqupd \<rparr>) =
-   carch_state_relation (ksArchState \<sigma>) (t_hrs_'_update f (globals \<sigma>'))"
-  unfolding carch_state_relation_def
-  by clarsimp
-
-lemma t_hrs_ksReadyQueues_upd_absorb:
-  "t_hrs_'_update f (g s) \<lparr>ksReadyQueues_' := rqupd \<rparr> =
-   t_hrs_'_update f (g s \<lparr>ksReadyQueues_' := rqupd\<rparr>)"
-  by simp
-
-lemma rf_sr_drop_bitmaps_enqueue_helper:
-  "\<lbrakk> (\<sigma>,\<sigma>') \<in> rf_sr ;
-     cbitmap_L1_relation ksqL1upd' ksqL1upd ; cbitmap_L2_relation ksqL2upd' ksqL2upd \<rbrakk>
-   \<Longrightarrow>
-   ((\<sigma>\<lparr>ksReadyQueues := ksqupd, ksReadyQueuesL1Bitmap := ksqL1upd, ksReadyQueuesL2Bitmap := ksqL2upd\<rparr>,
-     \<sigma>'\<lparr>idx_' := i', queue_' := queue_upd',
-        globals := t_hrs_'_update f
-          (globals \<sigma>'
-             \<lparr>ksReadyQueuesL1Bitmap_' := ksqL1upd',
-              ksReadyQueuesL2Bitmap_' := ksqL2upd',
-              ksReadyQueues_' := ksqupd'\<rparr>)\<rparr>) \<in> rf_sr) =
-   ((\<sigma>\<lparr>ksReadyQueues := ksqupd\<rparr>,
-     \<sigma>'\<lparr>idx_' := i', queue_' := queue_upd',
-        globals := t_hrs_'_update f
-          (globals \<sigma>' \<lparr>ksReadyQueues_' := ksqupd'\<rparr>)\<rparr>) \<in> rf_sr)"
-  unfolding rf_sr_def cstate_relation_def Let_def
-             carch_state_relation_def cmachine_state_relation_def
-  by (clarsimp simp: rf_sr_cbitmap_L1_relation rf_sr_cbitmap_L2_relation)
-
-lemma cmachine_state_relation_enqueue_simp:
-  "cmachine_state_relation (ksMachineState \<sigma>)
-    (t_hrs_'_update f
-      (globals \<sigma>' \<lparr>ksReadyQueuesL1Bitmap_' := l1upd, ksReadyQueuesL2Bitmap_' := l2upd \<rparr>)
-      \<lparr>ksReadyQueues_' := rqupd \<rparr>) =
-   cmachine_state_relation (ksMachineState \<sigma>) (t_hrs_'_update f (globals \<sigma>'))"
-  unfolding cmachine_state_relation_def
-  by clarsimp
-
-lemma tcb_queue_relation'_empty_ksReadyQueues:
-  "\<lbrakk> sched_queue_relation' (cslift x) (q s) NULL NULL ; \<forall>t\<in> set (q s). tcb_at' t s  \<rbrakk> \<Longrightarrow> q s = []"
-  apply (clarsimp simp add: tcb_queue_relation'_def)
-  apply (subst (asm) eq_commute)
-  apply (cases "q s" rule: rev_cases, simp)
-  apply (clarsimp simp: tcb_at_not_NULL)
-  done
-
 lemma invert_prioToL1Index_c_simp:
   "p \<le> maxPriority
    \<Longrightarrow>
@@ -999,13 +634,247 @@ lemma c_invert_assist: "3 - (ucast (p :: priority) >> 6 :: machine_word) < 4"
   using prio_ucast_shiftr_wordRadix_helper'[simplified wordRadix_def]
   by - (rule word_less_imp_diff_less, simp_all)
 
+lemma addToBitmap_ccorres:
+  "ccorres dc xfdc
+     (K (tdom \<le> maxDomain \<and> prio \<le> maxPriority)) (\<lbrace>\<acute>dom = ucast tdom\<rbrace> \<inter> \<lbrace>\<acute>prio = ucast prio\<rbrace>) hs
+     (addToBitmap tdom prio) (Call addToBitmap_'proc)"
+  supply prio_and_dom_limit_helpers[simp] invert_prioToL1Index_c_simp[simp]
+  apply (rule ccorres_from_vcg)
+  apply (rule allI, rule conseqPre, vcg)
+  apply clarsimp
+  apply (frule maxDomain_le_unat_ucast_explicit)
+  apply (clarsimp simp: getQueue_def gets_def get_def setQueue_def modify_def
+                        put_def bind_def return_def bitmap_fun_defs)
+  apply (intro conjI impI allI)
+   apply (fastforce simp: c_invert_assist l2BitmapSize_def' wordRadix_def)
+  apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
+                        carch_state_relation_def cmachine_state_relation_def)
+  apply (rule conjI)
+   apply (clarsimp intro!: cbitmap_L1_relation_bit_set)
+  apply (fastforce dest!: cbitmap_L2_relation_bit_set simp: wordRadix_def mask_def)
+  done
+
+lemma rf_sr_tcb_update_twice:
+  "h_t_valid (hrs_htd (hrs2 (globals s') (t_hrs_' (gs2 (globals s'))))) c_guard
+      (ptr (t_hrs_' (gs2 (globals s'))) (globals s'))
+    \<Longrightarrow> ((s, globals_update (\<lambda>gs. t_hrs_'_update (\<lambda>ths.
+        hrs_mem_update (heap_update (ptr ths gs :: tcb_C ptr) (v ths gs))
+            (hrs_mem_update (heap_update (ptr ths gs) (v' ths gs)) (hrs2 gs ths))) (gs2 gs)) s') \<in> rf_sr)
+    = ((s, globals_update (\<lambda>gs. t_hrs_'_update (\<lambda>ths.
+        hrs_mem_update (heap_update (ptr ths gs) (v ths gs)) (hrs2 gs ths)) (gs2 gs)) s') \<in> rf_sr)"
+  by (simp add: rf_sr_def cstate_relation_def Let_def
+                cpspace_relation_def typ_heap_simps'
+                carch_state_relation_def cmachine_state_relation_def
+                packed_heap_update_collapse_hrs)
+
+lemmas rf_sr_tcb_update_no_queue_gen2 =
+  rf_sr_obj_update_helper[OF rf_sr_tcb_update_no_queue_gen, simplified]
+
+lemma tcb_queue_prepend_ccorres:
+  "ccorres ctcb_queue_relation ret__struct_tcb_queue_C_'
+     (\<lambda>s. tcb_at' tcbPtr s
+          \<and> (tcbQueueHead queue \<noteq> None \<longleftrightarrow> tcbQueueEnd queue \<noteq> None)
+          \<and> (\<forall>head. tcbQueueHead queue = Some head \<longrightarrow> tcb_at' head s))
+     (\<lbrace>ctcb_queue_relation queue \<acute>queue\<rbrace> \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr tcbPtr\<rbrace>) hs
+     (tcbQueuePrepend queue tcbPtr) (Call tcb_queue_prepend_'proc)"
+  (is "ccorres _ _ ?abs _ _ _ _")
+  supply if_split[split del]
+  apply (cinit lift: tcb_')
+   \<comment> \<open>cinit is not able to lift queue_' because queue_' is later modified in the C program\<close>
+   apply (rule_tac xf'=queue_' in ccorres_abstract, ceqv, rename_tac cqueue)
+   apply (rule_tac P="ctcb_queue_relation queue cqueue" in ccorres_gen_asm2)
+   apply (rule_tac xf'=ret__unsigned_long_'
+               and val="from_bool (tcbQueueEmpty queue)"
+               and R="?abs"
+               and R'="\<lbrace>\<acute>queue = cqueue\<rbrace>"
+                in ccorres_symb_exec_r_known_rv)
+      apply (rule conseqPre, vcg)
+      apply (fastforce dest: tcb_at_not_NULL
+                       simp: ctcb_queue_relation_def option_to_ctcb_ptr_def tcbQueueEmpty_def)
+     apply ceqv
+    apply (rule_tac r'=ctcb_queue_relation and xf'=queue_' in ccorres_split_nothrow)
+        apply (rule_tac Q="?abs"
+                    and Q'="\<lambda>s'. queue_' s' = cqueue"
+                     in ccorres_cond_both')
+          apply fastforce
+         apply clarsimp
+         apply (rule ccorres_return[where R=\<top>])
+         apply (rule conseqPre, vcg)
+         apply (fastforce simp: ctcb_queue_relation_def option_to_ctcb_ptr_def)
+        apply (rule ccorres_seq_skip'[THEN iffD1])
+        apply (rule ccorres_rhs_assoc)+
+        apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+            apply (rule ccorres_Guard)
+            apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb tcbPtr s
+                                            \<and> head_C cqueue = option_to_ctcb_ptr (tcbQueueHead queue)}"
+                        and R="\<lbrace>head_C cqueue = option_to_ctcb_ptr (tcbQueueHead queue)\<rbrace>"
+                         in threadSet_ccorres_lemma4[where P=\<top> and P'=\<top>])
+             apply (rule conseqPre, vcg)
+             apply clarsimp
+             apply (frule (1) obj_at_cslift_tcb)
+             apply (fastforce intro!: rf_sr_tcb_update_no_queue_gen2
+                                simp: typ_heap_simps' tcb_cte_cases_def cteSizeBits_def
+                                      ctcb_relation_def option_to_ctcb_ptr_def)
+            apply (clarsimp simp: ctcb_relation_def option_to_ctcb_ptr_def split: if_splits)
+           apply ceqv
+          apply simp
+          apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+              apply (rule ccorres_Guard)
+              apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr
+                                              \<and> ko_at' tcb (the (tcbQueueHead queue)) s
+                                              \<and> head_C cqueue = option_to_ctcb_ptr (tcbQueueHead queue)}"
+                          and R="\<lbrace>head_C cqueue = option_to_ctcb_ptr (tcbQueueHead queue)\<rbrace>"
+                           in threadSet_ccorres_lemma4[where P=\<top> and P'=\<top>])
+               apply (rule conseqPre, vcg)
+               apply clarsimp
+               apply (frule (1) obj_at_cslift_tcb)
+               apply (fastforce intro!: rf_sr_tcb_update_no_queue_gen2
+                                  simp: typ_heap_simps' tcb_cte_cases_def cteSizeBits_def
+                                        ctcb_relation_def option_to_ctcb_ptr_def tcbQueueEmpty_def)
+              apply fastforce
+             apply ceqv
+            apply (rule ccorres_return_Skip')
+           apply wpsimp
+          apply vcg
+         apply wpsimp
+        apply vcg
+       apply ceqv
+      apply csymbr
+      apply (fastforce intro: ccorres_return_C')
+     apply wpsimp
+    apply vcg
+   apply clarsimp
+   apply (vcg exspec=tcb_queue_empty_modifies)
+  apply clarsimp
+  apply (frule (1) tcb_at_h_t_valid)
+  by (force dest: tcb_at_h_t_valid
+            simp: ctcb_queue_relation_def option_to_ctcb_ptr_def tcbQueueEmpty_def)
+
+lemma tcb_queue_append_ccorres:
+  "ccorres ctcb_queue_relation ret__struct_tcb_queue_C_'
+     (\<lambda>s. tcb_at' tcbPtr s
+          \<and> (tcbQueueHead queue \<noteq> None \<longleftrightarrow> tcbQueueEnd queue \<noteq> None)
+          \<and> (\<forall>head. tcbQueueHead queue = Some head \<longrightarrow> tcb_at' head s)
+          \<and> (\<forall>end. tcbQueueEnd queue = Some end \<longrightarrow> tcb_at' end s))
+     (\<lbrace>ctcb_queue_relation queue \<acute>queue\<rbrace> \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr tcbPtr\<rbrace>) hs
+     (tcbQueueAppend queue tcbPtr) (Call tcb_queue_append_'proc)"
+  (is "ccorres _ _ ?abs _ _ _ _")
+  supply if_split[split del]
+  apply (cinit lift: tcb_')
+   \<comment> \<open>cinit is not able to lift queue_' because queue_' is later modified in the C program\<close>
+   apply (rule_tac xf'=queue_' in ccorres_abstract, ceqv, rename_tac cqueue)
+   apply (rule_tac P="ctcb_queue_relation queue cqueue
+                      \<and> (tcbQueueHead queue \<noteq> None \<longleftrightarrow> tcbQueueEnd queue \<noteq> None)"
+                in ccorres_gen_asm2)
+   apply (rule_tac xf'=ret__unsigned_long_'
+               and val="from_bool (tcbQueueEmpty queue)"
+               and R="?abs"
+               and R'="\<lbrace>\<acute>queue = cqueue\<rbrace>"
+                in ccorres_symb_exec_r_known_rv)
+      apply (rule conseqPre, vcg)
+      apply (fastforce dest: tcb_at_not_NULL
+                       simp: ctcb_queue_relation_def option_to_ctcb_ptr_def tcbQueueEmpty_def)
+     apply ceqv
+    apply (rule_tac r'=ctcb_queue_relation and xf'=queue_' in ccorres_split_nothrow)
+        apply (rule_tac Q="?abs"
+                    and Q'="\<lambda>s'. queue_' s' = cqueue"
+                     in ccorres_cond_both')
+          apply (fastforce dest: tcb_at_not_NULL
+                           simp: ctcb_queue_relation_def option_to_ctcb_ptr_def)
+         apply clarsimp
+         apply (rule ccorres_return[where R=\<top>])
+         apply (rule conseqPre, vcg)
+         apply (fastforce simp: ctcb_queue_relation_def option_to_ctcb_ptr_def)
+        apply (rule ccorres_seq_skip'[THEN iffD1])
+        apply (rule ccorres_rhs_assoc)+
+        apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+            apply (rule ccorres_Guard)
+            apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb tcbPtr s
+                                            \<and> end_C cqueue = option_to_ctcb_ptr (tcbQueueEnd queue)}"
+                        and R="\<lbrace>end_C cqueue = option_to_ctcb_ptr (tcbQueueEnd queue)\<rbrace>"
+                         in threadSet_ccorres_lemma4[where P=\<top> and P'=\<top>])
+             apply (rule conseqPre, vcg)
+             apply clarsimp
+             apply (frule (1) obj_at_cslift_tcb)
+             apply (fastforce intro!: rf_sr_tcb_update_no_queue_gen2
+                                simp: typ_heap_simps' tcb_cte_cases_def cteSizeBits_def
+                                      ctcb_relation_def option_to_ctcb_ptr_def)
+            apply (clarsimp simp: ctcb_relation_def option_to_ctcb_ptr_def split: if_splits)
+           apply ceqv
+          apply simp
+          apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+              apply (rule ccorres_Guard)
+              apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr
+                                              \<and> ko_at' tcb (the (tcbQueueEnd queue)) s
+                                              \<and> end_C cqueue = option_to_ctcb_ptr (tcbQueueEnd queue)}"
+                          and R="\<lbrace>end_C cqueue = option_to_ctcb_ptr (tcbQueueEnd queue)\<rbrace>"
+                           in threadSet_ccorres_lemma4[where P=\<top> and P'=\<top>])
+               apply (rule conseqPre, vcg)
+               apply clarsimp
+               apply (frule (1) obj_at_cslift_tcb)
+               apply (fastforce intro!: rf_sr_tcb_update_no_queue_gen2
+                                  simp: typ_heap_simps' tcb_cte_cases_def cteSizeBits_def
+                                        ctcb_relation_def option_to_ctcb_ptr_def tcbQueueEmpty_def)
+              apply fastforce
+             apply ceqv
+            apply (rule ccorres_return_Skip')
+           apply wpsimp
+          apply vcg
+         apply wpsimp
+        apply vcg
+       apply ceqv
+      apply csymbr
+      apply (fastforce intro: ccorres_return_C')
+     apply wpsimp
+    apply vcg
+   apply (vcg exspec=tcb_queue_empty_modifies)
+  apply clarsimp
+  apply (frule (1) tcb_at_h_t_valid)
+  by (force dest: tcb_at_h_t_valid
+            simp: ctcb_queue_relation_def option_to_ctcb_ptr_def tcbQueueEmpty_def)
+
+lemma getQueue_ccorres:
+  "ccorres ctcb_queue_relation queue_'
+     (K (tdom \<le> maxDomain \<and> prio \<le> maxPriority))
+     \<lbrace>\<acute>idx = word_of_nat (cready_queues_index_to_C tdom prio)\<rbrace> hs
+     (getQueue tdom prio) (\<acute>queue :== \<acute>ksReadyQueues.[unat \<acute>idx])"
+  apply (rule ccorres_from_vcg)
+  apply (rule allI, rule conseqPre, vcg)
+  apply (clarsimp simp: getQueue_def gets_def get_def bind_def return_def)
+  apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def)
+  apply (frule (1) cready_queues_index_to_C_in_range)
+  apply (clarsimp simp: unat_of_nat_eq cready_queues_relation_def)
+  done
+
+lemma setQueue_ccorres:
+  "ctcb_queue_relation queue cqueue \<Longrightarrow>
+   ccorres dc xfdc
+     (K (tdom \<le> maxDomain \<and> prio \<le> maxPriority))
+     \<lbrace>\<acute>idx = word_of_nat (cready_queues_index_to_C tdom prio)\<rbrace> hs
+     (setQueue tdom prio queue)
+     (Basic (\<lambda>s. globals_update
+                  (ksReadyQueues_'_update
+                   (\<lambda>_. Arrays.update (ksReadyQueues_' (globals s)) (unat (idx_' s)) cqueue)) s))"
+  apply (rule ccorres_from_vcg)
+  apply (rule allI, rule conseqPre, vcg)
+  apply (clarsimp simp: setQueue_def get_def modify_def put_def bind_def)
+  apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
+                        carch_state_relation_def cmachine_state_relation_def)
+  apply (frule (1) cready_queues_index_to_C_in_range)
+  apply (clarsimp simp: unat_of_nat_eq cready_queues_relation_def)
+  apply (frule cready_queues_index_to_C_distinct, assumption+)
+  apply (frule_tac qdom=d and prio=p in cready_queues_index_to_C_in_range)
+   apply fastforce
+  apply clarsimp
+  done
+
+crunch (empty_fail) empty_fail[wp]: isRunnable
+
 lemma tcbSchedEnqueue_ccorres:
   "ccorres dc xfdc
-           (valid_queues and tcb_at' t and valid_objs')
-           (UNIV \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace>)
-           hs
-           (tcbSchedEnqueue t)
-           (Call tcbSchedEnqueue_'proc)"
+     (tcb_at' t and valid_objs' and pspace_aligned' and pspace_distinct')
+     \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace> hs
+     (tcbSchedEnqueue t) (Call tcbSchedEnqueue_'proc)"
 proof -
   note prio_and_dom_limit_helpers[simp] word_sle_def[simp] maxDom_to_H[simp] maxPrio_to_H[simp]
   note invert_prioToL1Index_c_simp[simp]
@@ -1016,24 +885,12 @@ proof -
 
   show ?thesis
     apply (cinit lift: tcb_')
-     apply (rule_tac r'="\<lambda>rv rv'. rv = to_bool rv'" and xf'="ret__unsigned_longlong_'"
-              in ccorres_split_nothrow)
-         apply (rule threadGet_vcg_corres)
-         apply (rule allI, rule conseqPre, vcg)
-         apply clarsimp
-         apply (drule obj_at_ko_at', clarsimp)
-         apply (drule spec, drule(1) mp, clarsimp)
-         apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-        apply ceqv
-       apply (simp add: when_def unless_def del: Collect_const split del: if_split)
-       apply (rule ccorres_cond[where R=\<top>])
-         apply (simp add: to_bool_def)
-        apply (rule ccorres_rhs_assoc)+
-        apply csymbr
-        apply csymbr
-        apply csymbr
-        apply csymbr
-        apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="dom_'" in ccorres_split_nothrow)
+     apply (rule ccorres_stateAssert)+
+     apply (rule ccorres_symb_exec_l)
+        apply (rule ccorres_assert)
+        apply (thin_tac runnable)
+        apply (rule_tac r'="\<lambda>rv rv'. rv = to_bool rv'" and xf'="ret__unsigned_longlong_'"
+                     in ccorres_split_nothrow)
             apply (rule threadGet_vcg_corres)
             apply (rule allI, rule conseqPre, vcg)
             apply clarsimp
@@ -1041,245 +898,244 @@ proof -
             apply (drule spec, drule(1) mp, clarsimp)
             apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
            apply ceqv
-          apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="prio_'" in ccorres_split_nothrow)
-              apply (rule threadGet_vcg_corres)
-              apply (rule allI, rule conseqPre, vcg)
-              apply clarsimp
-              apply (drule obj_at_ko_at', clarsimp)
-              apply (drule spec, drule(1) mp, clarsimp)
-              apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-             apply ceqv
-            apply (rule ccorres_rhs_assoc2)+
-            apply (simp only: bind_assoc[symmetric])
-            apply (rule ccorres_split_nothrow_novcg_dc)
-               prefer 2
-               apply (rule ccorres_move_c_guard_tcb)
-               apply simp
-               apply ctac
-              prefer 2
-              apply (wp, clarsimp, wp+)
-             apply (rule_tac P="\<lambda>s. valid_queues s \<and> (\<forall>p. t \<notin> set (ksReadyQueues s p))
-                                  \<and> (\<exists>tcb. ko_at' tcb t s \<and> tcbDomain tcb =rva
-                                  \<and> tcbPriority tcb = rvb \<and> valid_tcb' tcb s)"
-                         and P'=UNIV in ccorres_from_vcg)
-             apply (rule allI, rule conseqPre, vcg)
-             apply (clarsimp simp: getQueue_def gets_def get_def setQueue_def modify_def
-                                   put_def bind_def return_def bitmap_fun_defs null_def)
-             apply (clarsimp simp: queue_in_range valid_tcb'_def)
-             apply (rule conjI; clarsimp simp: queue_in_range)
-              (* queue is empty, set t to be new queue *)
-              apply (drule (1) obj_at_cslift_tcb)
-              apply clarsimp
-              apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb"
-                       in rf_sr_sched_queue_relation)
-                apply clarsimp
-               apply clarsimp
-              apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL)
-               apply (simp add: valid_queues_valid_q)
-              apply (subgoal_tac
-                      "head_C (ksReadyQueues_' (globals x)
-                         .[cready_queues_index_to_C (tcbDomain tcb) (tcbPriority tcb)]) = NULL")
-               prefer 2
-               apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL; simp add: valid_queues_valid_q)
-              apply (subgoal_tac
-                       "end_C (ksReadyQueues_' (globals x)
-                          .[cready_queues_index_to_C (tcbDomain tcb) (tcbPriority tcb)]) = NULL")
-               prefer 2
-               apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL[symmetric]; simp add: valid_queues_valid_q)
-              apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                        unat_trans_ucast_helper\<close>)
-              apply (frule maxDomain_le_unat_ucast_explicit)
-              apply (clarsimp simp: cready_queues_index_to_C_def numPriorities_def)
-              apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-              apply (simp add: t_hrs_ksReadyQueues_upd_absorb)
-
-              apply (rule conjI)
-               apply (clarsimp simp: l2BitmapSize_def' wordRadix_def c_invert_assist)
-              apply (subst rf_sr_drop_bitmaps_enqueue_helper, assumption)
-                apply (fastforce intro: cbitmap_L1_relation_bit_set)
-               apply (fastforce intro: cbitmap_L2_relation_bit_set simp: wordRadix_def mask_def)
-
-              apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb" in rf_sr_sched_queue_relation)
-                apply clarsimp
-               apply clarsimp
-              apply (drule_tac qhead'="tcb_ptr_to_ctcb_ptr t" and s=\<sigma> in tcbSchedEnqueue_update,
-                     simp_all add: valid_queues_valid_q)[1]
-               apply (rule tcb_at_not_NULL, erule obj_at'_weakenE, simp)
-              apply (erule(1) state_relation_queue_update_helper[where S="{t}"],
-                     (simp | rule globals.equality)+,
-                     simp_all add: cready_queues_index_to_C_def2 numPriorities_def
-                                   t_hrs_ksReadyQueues_upd_absorb upd_unless_null_def
-                                   typ_heap_simps)[1]
-               apply (fastforce simp: tcb_null_sched_ptrs_def typ_heap_simps c_guard_clift
-                                elim: obj_at'_weaken)+
-             apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                       unat_trans_ucast_helper\<close>)
-             apply clarsimp
-             apply (rule conjI; clarsimp simp: queue_in_range)
-              (* invalid, disagreement between C and Haskell on emptiness of queue *)
-              apply (drule (1) obj_at_cslift_tcb)
-              apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-              apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb" in rf_sr_sched_queue_relation)
-                apply clarsimp
-               apply clarsimp
-              apply (clarsimp simp: cready_queues_index_to_C_def numPriorities_def)
-              apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL)
-               apply (simp add: valid_queues_valid_q)
-              apply clarsimp
-              apply (drule tcb_queue_relation'_empty_ksReadyQueues; simp add: valid_queues_valid_q)
-             (* queue was not empty, add t to queue and leave bitmaps alone *)
-             apply (drule (1) obj_at_cslift_tcb)
-             apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-             apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb" in rf_sr_sched_queue_relation)
-               apply clarsimp
-              apply clarsimp
-             apply (clarsimp simp: cready_queues_index_to_C_def numPriorities_def)
-             apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL)
-              apply (simp add: valid_queues_valid_q)
-             apply clarsimp
-             apply (frule_tac t=\<sigma> in tcb_queue_relation_qhead_mem')
-              apply (simp add: valid_queues_valid_q)
-             apply (frule(1) tcb_queue_relation_qhead_valid')
-              apply (simp add: valid_queues_valid_q)
-             apply (clarsimp simp: typ_heap_simps h_t_valid_clift_Some_iff numPriorities_def
-                                   cready_queues_index_to_C_def2)
-             apply (drule_tac qhead'="tcb_ptr_to_ctcb_ptr t" and s=\<sigma> in tcbSchedEnqueue_update,
-                    simp_all add: valid_queues_valid_q)[1]
+          apply (simp add: when_def unless_def del: Collect_const split del: if_split)
+          apply (rule ccorres_cond[where R=\<top>])
+            apply (simp add: to_bool_def)
+           apply (rule ccorres_rhs_assoc)+
+           apply csymbr
+           apply csymbr
+           apply csymbr
+           apply csymbr
+           apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="dom_'" in ccorres_split_nothrow)
+               apply (rule threadGet_vcg_corres)
+               apply (rule allI, rule conseqPre, vcg)
                apply clarsimp
-
-              apply (rule tcb_at_not_NULL, erule obj_at'_weakenE, simp)
-             apply (frule(2) obj_at_cslift_tcb[OF valid_queues_obj_at'D])
-             apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-             apply (erule_tac S="{t, v}" for v in state_relation_queue_update_helper,
-                    (simp | rule globals.equality)+,
-                    simp_all add: typ_heap_simps if_Some_helper numPriorities_def
-                                  cready_queues_index_to_C_def2 upd_unless_null_def
-                             del: fun_upd_restrict_conv
-                             cong: if_cong
-                             split del: if_split)[1]
-                 apply simp
-                 apply (rule conjI)
+               apply (drule obj_at_ko_at', clarsimp)
+               apply (drule spec, drule(1) mp, clarsimp)
+               apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+              apply ceqv
+             apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="prio_'" in ccorres_split_nothrow)
+                 apply (rule threadGet_vcg_corres)
+                 apply (rule allI, rule conseqPre, vcg)
+                 apply clarsimp
+                 apply (drule obj_at_ko_at', clarsimp)
+                 apply (drule spec, drule(1) mp, clarsimp)
+                 apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+                apply ceqv
+               apply (rule ccorres_rhs_assoc2)+
+               apply (simp only: bind_assoc[symmetric])
+               apply (rule ccorres_split_nothrow_novcg_dc)
+                  prefer 2
+                  apply (rule ccorres_move_c_guard_tcb)
+                  apply (simp only: dc_def[symmetric])
+                  apply ctac
+                 apply (rule ccorres_rhs_assoc)+
+                 apply (rule ccorres_symb_exec_r)
+                   apply (rule ccorres_Guard_Seq)
+                   apply (simp add: bind_assoc)
+                   apply (ctac add: getQueue_ccorres)
+                     apply (rename_tac queue cqueue)
+                     apply (rule_tac xf'=ret__unsigned_long_'
+                                 and val="from_bool (tcbQueueEmpty queue)"
+                                 and R="\<lambda>s. \<not> tcbQueueEmpty queue \<longrightarrow> tcb_at' (the (tcbQueueHead queue)) s
+                                            \<and> (tcbQueueHead queue \<noteq> None \<longleftrightarrow> tcbQueueEnd queue \<noteq> None)"
+                                 and R'="{s'. queue_' s' = cqueue}"
+                                  in ccorres_symb_exec_r_known_rv)
+                        apply (rule conseqPre, vcg)
+                        apply (fastforce dest: tcb_at_not_NULL
+                                         simp: ctcb_queue_relation_def option_to_ctcb_ptr_def
+                                               tcbQueueEmpty_def)
+                       apply ceqv
+                      apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                          apply (rule ccorres_cond[where R=\<top>])
+                            apply fastforce
+                           apply (ctac add: addToBitmap_ccorres)
+                          apply (rule ccorres_return_Skip)
+                         apply ceqv
+                        apply (ctac add: tcb_queue_prepend_ccorres)
+                          apply (rule ccorres_Guard)
+                          apply (rule setQueue_ccorres)
+                          apply fastforce
+                         apply wpsimp
+                        apply (vcg exspec=tcb_queue_prepend_modifies)
+                       apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift')
+                      apply (vcg exspec=addToBitmap_modifies)
+                     apply vcg
+                    apply wpsimp
+                   apply vcg
                   apply clarsimp
-                  apply (drule_tac s="tcb_ptr_to_ctcb_ptr t" in sym, simp)
-                 apply (clarsimp simp add: fun_upd_twist)
-                prefer 4
-                apply (simp add: obj_at'_weakenE[OF _ TrueI])
-                apply (rule disjI1, erule (1) valid_queues_obj_at'D)
-               apply clarsimp
-              apply (fastforce simp: tcb_null_sched_ptrs_def)
-             apply (simp add: fpu_state_preservation[OF _ h_t_valid_clift] typ_heap_simps')
-            apply (simp add: typ_heap_simps c_guard_clift)
-            apply (simp add: guard_is_UNIV_def)
-           apply simp
-           apply (wp threadGet_wp)
-          apply vcg
-         apply simp
-         apply (wp threadGet_wp)
-        apply vcg
-       apply (rule ccorres_return_Skip)
-      apply simp
-      apply (wp threadGet_wp)
-     apply vcg
-    apply (fastforce simp: valid_objs'_def obj_at'_def ran_def projectKOs typ_at'_def
-                           valid_obj'_def inQ_def
-                    dest!: valid_queues_obj_at'D)
-  done
+                  apply vcg
+                 apply (rule conseqPre, vcg)
+                 apply clarsimp
+                apply wpsimp
+               apply (clarsimp simp: guard_is_UNIV_def)
+              apply (wpsimp wp: threadGet_wp)
+             apply vcg
+            apply clarsimp
+            apply (wpsimp wp: threadGet_wp)
+           apply vcg
+          apply (rule ccorres_return_Skip)
+         apply (wpsimp wp: threadGet_wp)
+        apply (vcg expsec=thread_state_get_tcbQueued_modifies)
+       apply wpsimp
+      apply (wpsimp wp: isRunnable_wp)
+     apply wpsimp
+    apply normalise_obj_at'
+    apply (rename_tac tcb)
+    apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+    apply (clarsimp simp: valid_tcb'_def)
+    apply (frule (1) obj_at_cslift_tcb)
+    apply (rule conjI)
+     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
+     apply (frule (3) obj_at'_tcbQueueHead_ksReadyQueues)
+     apply (force dest!: tcbQueueHead_iff_tcbQueueEnd simp: tcbQueueEmpty_def obj_at'_def)
+    apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+    apply (rule conjI)
+     apply (clarsimp simp: maxDomain_def)
+    apply (cut_tac qdom="tcbDomain tcb" and prio="tcbPriority tcb"
+                in cready_queues_index_to_C_in_range)
+      apply fastforce
+     apply fastforce
+    apply (clarsimp simp: word_less_nat_alt cready_queues_index_to_C_def2)
+    done
 qed
 
-lemmas tcbSchedDequeue_update
-    = tcbDequeue_update[where tn=tcbSchedNext_C and tn_update=tcbSchedNext_C_update
-                          and tp=tcbSchedPrev_C and tp_update=tcbSchedPrev_C_update,
-                        simplified]
-
-lemma tcb_queue_relation_prev_next:
-  "\<lbrakk> tcb_queue_relation tn tp mp queue qprev qhead;
-     tcbp \<in> set queue; distinct (ctcb_ptr_to_tcb_ptr qprev # queue);
-     \<forall>t \<in> set queue. tcb_at' t s; qprev \<noteq> tcb_Ptr 0 \<longrightarrow> mp qprev \<noteq> None;
-     mp (tcb_ptr_to_ctcb_ptr tcbp) = Some tcb \<rbrakk>
-      \<Longrightarrow> (tn tcb \<noteq> tcb_Ptr 0 \<longrightarrow> tn tcb \<in> tcb_ptr_to_ctcb_ptr ` set queue
-                       \<and> mp (tn tcb) \<noteq> None \<and> tn tcb \<noteq> tcb_ptr_to_ctcb_ptr tcbp)
-        \<and> (tp tcb \<noteq> tcb_Ptr 0 \<longrightarrow> (tp tcb \<in> tcb_ptr_to_ctcb_ptr ` set queue
-                                         \<or> tp tcb = qprev)
-                       \<and> mp (tp tcb) \<noteq> None \<and> tp tcb \<noteq> tcb_ptr_to_ctcb_ptr tcbp)
-        \<and> (tn tcb \<noteq> tcb_Ptr 0 \<longrightarrow> tn tcb \<noteq> tp tcb)"
-  apply (induct queue arbitrary: qprev qhead)
-   apply simp
-  apply simp
-  apply (erule disjE)
-   apply clarsimp
-   apply (case_tac "queue")
-    apply clarsimp
-   apply clarsimp
-   apply (rule conjI)
-    apply clarsimp
-   apply clarsimp
-   apply (drule_tac f=ctcb_ptr_to_tcb_ptr in arg_cong[where y="tp tcb"], simp)
-  apply clarsimp
-  apply fastforce
-  done
-
-lemma tcb_queue_relation_prev_next':
-  "\<lbrakk> tcb_queue_relation' tn tp mp queue qhead qend; tcbp \<in> set queue; distinct queue;
-       \<forall>t \<in> set queue. tcb_at' t s; mp (tcb_ptr_to_ctcb_ptr tcbp) = Some tcb \<rbrakk>
-      \<Longrightarrow> (tn tcb \<noteq> tcb_Ptr 0 \<longrightarrow> tn tcb \<in> tcb_ptr_to_ctcb_ptr ` set queue
-                       \<and> mp (tn tcb) \<noteq> None \<and> tn tcb \<noteq> tcb_ptr_to_ctcb_ptr tcbp)
-        \<and> (tp tcb \<noteq> tcb_Ptr 0 \<longrightarrow> tp tcb \<in> tcb_ptr_to_ctcb_ptr ` set queue
-                       \<and> mp (tp tcb) \<noteq> None \<and> tp tcb \<noteq> tcb_ptr_to_ctcb_ptr tcbp)
-        \<and> (tn tcb \<noteq> tcb_Ptr 0 \<longrightarrow> tn tcb \<noteq> tp tcb)"
-  apply (clarsimp simp: tcb_queue_relation'_def split: if_split_asm)
-  apply (drule(1) tcb_queue_relation_prev_next, simp_all)
-   apply (fastforce dest: tcb_at_not_NULL)
-  apply clarsimp
-  done
-
-(* L1 bitmap only updated if L2 entry bits end up all zero *)
-lemma rf_sr_drop_bitmaps_dequeue_helper_L2:
-  "\<lbrakk> (\<sigma>,\<sigma>') \<in> rf_sr ;
-     cbitmap_L2_relation ksqL2upd' ksqL2upd \<rbrakk>
-   \<Longrightarrow>
-((\<sigma>\<lparr>ksReadyQueues := ksqupd,
-   ksReadyQueuesL2Bitmap := ksqL2upd\<rparr>,
- \<sigma>'\<lparr>idx_' := i',
-   queue_' := queue_upd',
-   globals := globals \<sigma>'
-     \<lparr>ksReadyQueuesL2Bitmap_' := ksqL2upd',
-      ksReadyQueues_' := ksqupd'\<rparr>\<rparr>)
-         \<in> rf_sr)
- =
-((\<sigma>\<lparr>ksReadyQueues := ksqupd\<rparr>,
- \<sigma>'\<lparr>idx_' := i',
-   queue_' := queue_upd',
-   globals := globals \<sigma>'
-     \<lparr>ksReadyQueues_' := ksqupd'\<rparr>\<rparr>) \<in> rf_sr)
-"
-  unfolding rf_sr_def cstate_relation_def Let_def
-             carch_state_relation_def cmachine_state_relation_def
-  by (clarsimp simp: rf_sr_cbitmap_L1_relation rf_sr_cbitmap_L2_relation)
-
-lemma rf_sr_drop_bitmaps_dequeue_helper:
-  "\<lbrakk> (\<sigma>,\<sigma>') \<in> rf_sr ;
-     cbitmap_L1_relation ksqL1upd' ksqL1upd ; cbitmap_L2_relation ksqL2upd' ksqL2upd \<rbrakk>
-   \<Longrightarrow>
-((\<sigma>\<lparr>ksReadyQueues := ksqupd,
-   ksReadyQueuesL2Bitmap := ksqL2upd,
-   ksReadyQueuesL1Bitmap := ksqL1upd\<rparr>,
- \<sigma>'\<lparr>idx_' := i',
-   queue_' := queue_upd',
-   globals := globals \<sigma>'
-     \<lparr>ksReadyQueuesL2Bitmap_' := ksqL2upd',
-      ksReadyQueuesL1Bitmap_' := ksqL1upd',
-      ksReadyQueues_' := ksqupd'\<rparr>\<rparr>)
-         \<in> rf_sr)
- =
-((\<sigma>\<lparr>ksReadyQueues := ksqupd\<rparr>,
- \<sigma>'\<lparr>idx_' := i',
-   queue_' := queue_upd',
-   globals := globals \<sigma>'
-     \<lparr>ksReadyQueues_' := ksqupd'\<rparr>\<rparr>) \<in> rf_sr)
-"
-  unfolding rf_sr_def cstate_relation_def Let_def
-             carch_state_relation_def cmachine_state_relation_def
-  by (clarsimp simp: rf_sr_cbitmap_L1_relation rf_sr_cbitmap_L2_relation)
+lemma tcbSchedAppend_ccorres:
+  "ccorres dc xfdc
+     (tcb_at' t and valid_objs' and pspace_aligned' and pspace_distinct')
+     \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace> hs
+     (tcbSchedAppend t) (Call tcbSchedAppend_'proc)"
+proof -
+  note prio_and_dom_limit_helpers[simp] word_sle_def[simp] maxDom_to_H[simp] maxPrio_to_H[simp]
+  note invert_prioToL1Index_c_simp[simp]
+  (* when numDomains = 1, array bounds checks would become _ = 0 rather than _ < 1, changing the
+     shape of the proof compared to when numDomains > 1 *)
+  note word_less_1[simp del]
+  show ?thesis
+    apply (cinit lift: tcb_')
+     apply (rule ccorres_stateAssert)+
+     apply (rule ccorres_symb_exec_l)
+        apply (rule ccorres_assert)
+        apply (thin_tac "runnable")
+        apply (rule_tac r'="\<lambda>rv rv'. rv = to_bool rv'" and xf'="ret__unsigned_longlong_'"
+                     in ccorres_split_nothrow)
+            apply (rule threadGet_vcg_corres)
+            apply (rule allI, rule conseqPre, vcg)
+            apply clarsimp
+            apply (drule obj_at_ko_at', clarsimp)
+            apply (drule spec, drule(1) mp, clarsimp)
+            apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+           apply ceqv
+          apply (simp add: when_def unless_def del: Collect_const split del: if_split)
+          apply (rule ccorres_cond[where R=\<top>])
+            apply (simp add: to_bool_def)
+           apply (rule ccorres_rhs_assoc)+
+           apply csymbr
+           apply csymbr
+           apply csymbr
+           apply csymbr
+           apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="dom_'" in ccorres_split_nothrow)
+               apply (rule threadGet_vcg_corres)
+               apply (rule allI, rule conseqPre, vcg)
+               apply clarsimp
+               apply (drule obj_at_ko_at', clarsimp)
+               apply (drule spec, drule(1) mp, clarsimp)
+               apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+              apply ceqv
+             apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="prio_'" in ccorres_split_nothrow)
+                 apply (rule threadGet_vcg_corres)
+                 apply (rule allI, rule conseqPre, vcg)
+                 apply clarsimp
+                 apply (drule obj_at_ko_at', clarsimp)
+                 apply (drule spec, drule(1) mp, clarsimp)
+                 apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+                apply ceqv
+               apply (rule ccorres_rhs_assoc2)+
+               apply (simp only: bind_assoc[symmetric])
+               apply (rule ccorres_split_nothrow_novcg_dc)
+                  prefer 2
+                  apply (rule ccorres_move_c_guard_tcb)
+                  apply (simp only: dc_def[symmetric])
+                  apply ctac
+                 apply (rule ccorres_rhs_assoc)+
+                 apply (rule ccorres_symb_exec_r)
+                   apply (rule ccorres_Guard_Seq)
+                   apply (simp add: bind_assoc)
+                   apply (ctac add: getQueue_ccorres)
+                     apply (rename_tac queue cqueue)
+                     apply (rule_tac xf'=ret__unsigned_long_'
+                                 and val="from_bool (tcbQueueEmpty queue)"
+                                 and R="\<lambda>s. \<not> tcbQueueEmpty queue \<longrightarrow> tcb_at' (the (tcbQueueHead queue)) s
+                                            \<and> (tcbQueueHead queue \<noteq> None \<longleftrightarrow> tcbQueueEnd queue \<noteq> None)"
+                                 and R'="{s'. queue_' s' = cqueue}"
+                                  in ccorres_symb_exec_r_known_rv)
+                        apply (rule conseqPre, vcg)
+                        apply (fastforce dest: tcb_at_not_NULL
+                                         simp: ctcb_queue_relation_def option_to_ctcb_ptr_def
+                                               tcbQueueEmpty_def)
+                       apply ceqv
+                      apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                          apply (rule ccorres_cond[where R=\<top>])
+                            apply (fastforce dest!: tcb_at_not_NULL
+                                              simp: ctcb_queue_relation_def option_to_ctcb_ptr_def)
+                           apply (ctac add: addToBitmap_ccorres)
+                          apply (rule ccorres_return_Skip)
+                         apply ceqv
+                        apply (ctac add: tcb_queue_append_ccorres)
+                          apply (rule ccorres_Guard)
+                          apply (rule setQueue_ccorres)
+                          apply fastforce
+                         apply wpsimp
+                        apply (vcg exspec=tcb_queue_prepend_modifies)
+                       apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift')
+                      apply (vcg exspec=addToBitmap_modifies)
+                     apply vcg
+                    apply wpsimp
+                   apply vcg
+                  apply clarsimp
+                  apply vcg
+                 apply (rule conseqPre, vcg)
+                 apply clarsimp
+                apply wpsimp
+               apply (clarsimp simp: guard_is_UNIV_def)
+              apply (wpsimp wp: threadGet_wp)
+             apply vcg
+            apply clarsimp
+            apply (wpsimp wp: threadGet_wp)
+           apply clarsimp
+           apply vcg
+          apply (rule ccorres_return_Skip)
+         apply (wpsimp wp: threadGet_wp)
+        apply (vcg expsec=thread_state_get_tcbQueued_modifies)
+       apply wpsimp
+      apply (wpsimp wp: isRunnable_wp)
+     apply wpsimp
+    apply normalise_obj_at'
+    apply (rename_tac tcb)
+    apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+    apply (clarsimp simp: valid_tcb'_def)
+    apply (frule (1) obj_at_cslift_tcb)
+    apply (rule conjI)
+     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
+     apply (frule (3) obj_at'_tcbQueueHead_ksReadyQueues)
+     apply (frule (3) obj_at'_tcbQueueEnd_ksReadyQueues)
+     apply (force dest!: tcbQueueHead_iff_tcbQueueEnd simp: tcbQueueEmpty_def obj_at'_def)
+    apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+    apply (rule conjI)
+     apply (clarsimp simp: maxDomain_def)
+    apply (cut_tac qdom="tcbDomain tcb" and prio="tcbPriority tcb"
+                in cready_queues_index_to_C_in_range)
+      apply fastforce
+     apply fastforce
+    apply (clarsimp simp: word_less_nat_alt cready_queues_index_to_C_def2 tcbQueueEmpty_def)
+    done
+qed
 
 (* FIXME same proofs as bit_set, maybe can generalise? *)
 lemma cbitmap_L1_relation_bit_clear:
@@ -1296,27 +1152,6 @@ lemma cbitmap_L1_relation_bit_clear:
                      invertL1Index_def l2BitmapSize_def'
                      le_maxDomain_eq_less_numDomains word_le_nat_alt num_domains_index_updates)
 
-lemma cready_queues_relation_empty_queue_helper:
-  "\<lbrakk> tcbDomain ko \<le> maxDomain ; tcbPriority ko \<le> maxPriority ;
-     cready_queues_relation (cslift \<sigma>') (ksReadyQueues_' (globals \<sigma>')) (ksReadyQueues \<sigma>)\<rbrakk>
-   \<Longrightarrow>
-   cready_queues_relation (cslift \<sigma>')
-          (Arrays.update (ksReadyQueues_' (globals \<sigma>')) (unat (tcbDomain ko) * 256 + unat (tcbPriority ko))
-            (tcb_queue_C.end_C_update (\<lambda>_. NULL)
-              (head_C_update (\<lambda>_. NULL)
-                (ksReadyQueues_' (globals \<sigma>').[unat (tcbDomain ko) * 256 + unat (tcbPriority ko)]))))
-          ((ksReadyQueues \<sigma>)((tcbDomain ko, tcbPriority ko) := []))"
-  unfolding cready_queues_relation_def Let_def
-  using maxPrio_to_H[simp] maxDom_to_H[simp]
-  apply clarsimp
-  apply (frule (1) cready_queues_index_to_C_in_range[simplified maxDom_to_H maxPrio_to_H])
-  apply (fold cready_queues_index_to_C_def[simplified numPriorities_def])
-  apply (case_tac "qdom = tcbDomain ko",
-          simp_all add: prio_and_dom_limit_helpers seL4_MinPrio_def
-                        minDom_def)
-   apply (fastforce simp: cready_queues_index_to_C_in_range simp: cready_queues_index_to_C_distinct)+
-  done
-
 lemma cbitmap_L2_relationD:
   "\<lbrakk> cbitmap_L2_relation cbitmap2 abitmap2 ; d \<le> maxDomain ; i < l2BitmapSize \<rbrakk> \<Longrightarrow>
     cbitmap2.[unat d].[i] = abitmap2 (d, i)"
@@ -1346,15 +1181,10 @@ lemma cbitmap_L2_relation_bit_clear:
   apply (case_tac "da = d" ; clarsimp simp: num_domains_index_updates)
   done
 
-lemma tcbSchedDequeue_ccorres':
+lemma removeFromBitmap_ccorres:
   "ccorres dc xfdc
-           ((\<lambda>s. \<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s)
-                     \<and> distinct (ksReadyQueues s (d, p)))
-             and valid_queues' and tcb_at' t and valid_objs')
-           (UNIV \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace>)
-           []
-           (tcbSchedDequeue t)
-           (Call tcbSchedDequeue_'proc)"
+     (K (tdom \<le> maxDomain \<and> prio \<le> maxPriority)) (\<lbrace>\<acute>dom = ucast tdom\<rbrace> \<inter> \<lbrace>\<acute>prio = ucast prio\<rbrace>) hs
+     (removeFromBitmap tdom prio) (Call removeFromBitmap_'proc)"
 proof -
 
   note prio_and_dom_limit_helpers[simp] word_sle_def[simp]
@@ -1363,451 +1193,290 @@ proof -
      shape of the proof compared to when numDomains > 1 *)
   include no_less_1_simps
 
-  have ksQ_tcb_at': "\<And>s ko d p.
-    \<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s)
-                                          \<and> distinct (ksReadyQueues s (d, p)) \<Longrightarrow>
-    \<forall>t\<in>set (ksReadyQueues s (d, p)). tcb_at' t s"
-    by (fastforce dest: spec elim: obj_at'_weakenE)
-
-  have invert_l1_index_limit: "\<And>p. invertL1Index (prioToL1Index p) < 4"
+  have invert_l1_index_limit: "\<And>p. invertL1Index (prioToL1Index p) < l2BitmapSize"
     unfolding invertL1Index_def l2BitmapSize_def' prioToL1Index_def
     by simp
 
   show ?thesis
-  apply (cinit lift: tcb_')
-   apply (rule_tac r'="\<lambda>rv rv'. rv = to_bool rv'" and xf'="ret__unsigned_longlong_'"
-            in ccorres_split_nothrow)
-       apply (rule threadGet_vcg_corres)
-       apply (rule allI, rule conseqPre, vcg)
-       apply clarsimp
-       apply (drule obj_at_ko_at', clarsimp)
-       apply (drule spec, drule(1) mp, clarsimp)
-       apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-      apply ceqv
-     apply (simp add: when_def del: Collect_const split del: if_split)
-     apply (rule ccorres_cond[where R=\<top>])
-       apply (simp add: to_bool_def)
-      apply (rule ccorres_rhs_assoc)+
-      apply csymbr
-      apply csymbr
-      apply csymbr
-      apply csymbr
-      apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="dom_'" in ccorres_split_nothrow)
-          apply (rule threadGet_vcg_corres)
+    supply if_split[split del]
+    (* pull out static assms *)
+    apply simp
+    apply (rule ccorres_grab_asm[where P=\<top>, simplified])
+    apply (cinit lift: dom_' prio_')
+     apply clarsimp
+     apply csymbr
+     apply csymbr
+     (* we can clear up all C guards now *)
+     apply (clarsimp simp: maxDomain_le_unat_ucast_explicit word_and_less')
+     apply (simp add: invert_prioToL1Index_c_simp word_less_nat_alt)
+     apply (simp add: invert_l1_index_limit[simplified l2BitmapSize_def'])
+     apply ccorres_rewrite
+     (* handle L2 update *)
+     apply (rule_tac ccorres_split_nothrow_novcg_dc)
+        apply (rule_tac P=\<top> and P'=UNIV in ccorres_from_vcg)
+        apply (rule allI, rule conseqPre, vcg)
+        apply (clarsimp simp: simpler_gets_def get_def modify_def
+                              put_def bind_def return_def bitmap_fun_defs)
+        apply (frule rf_sr_cbitmap_L2_relation)
+        apply (erule cbitmap_L2_relation_update)
+        apply (erule (1) cbitmap_L2_relation_bit_clear)
+       (* the check on the C side is identical to checking the L2 entry, rewrite the condition *)
+       apply (simp add: getReadyQueuesL2Bitmap_def)
+       apply (rule ccorres_symb_exec_l3, rename_tac l2)
+          apply (rule_tac C'="{s. l2 = 0}"
+                      and Q="\<lambda>s. l2 = ksReadyQueuesL2Bitmap s (tdom, invertL1Index (prioToL1Index prio))"
+                   in ccorres_rewrite_cond_sr[where Q'=UNIV])
+           apply clarsimp
+           apply (frule rf_sr_cbitmap_L2_relation)
+           apply (clarsimp simp: cbitmap_L2_relationD invert_l1_index_limit split: if_split)
+          (* unset L1 bit when L2 entry is empty *)
+          apply (rule ccorres_from_vcg[where P=\<top> and P'=UNIV])
           apply (rule allI, rule conseqPre, vcg)
-          apply clarsimp
-          apply (drule obj_at_ko_at', clarsimp)
-          apply (drule spec, drule(1) mp, clarsimp)
-          apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-         apply ceqv
-        apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="prio_'" in ccorres_split_nothrow)
-            apply (rule threadGet_vcg_corres)
-            apply (rule allI, rule conseqPre, vcg)
-            apply clarsimp
-            apply (drule obj_at_ko_at', clarsimp)
-            apply (drule spec, drule(1) mp, clarsimp)
-            apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+          apply (clarsimp simp: simpler_gets_def get_def modify_def
+                                put_def bind_def return_def bitmap_fun_defs)
+          apply (frule rf_sr_cbitmap_L1_relation)
+          apply (erule cbitmap_L1_relation_update)
+          apply (erule (1) cbitmap_L1_relation_bit_clear)
+         apply wpsimp+
+     apply (fastforce simp: guard_is_UNIV_def)
+    apply clarsimp
+    done
+qed
+
+lemma ctcb_ptr_to_tcb_ptr_option_to_ctcb_ptr[simp]:
+  "ctcb_ptr_to_tcb_ptr (option_to_ctcb_ptr (Some ptr)) = ptr"
+  by (clarsimp simp: option_to_ctcb_ptr_def)
+
+lemma tcb_queue_remove_ccorres:
+  "ccorres ctcb_queue_relation ret__struct_tcb_queue_C_'
+     (\<lambda>s. tcb_at' tcbPtr s \<and> valid_objs' s
+          \<and> (tcbQueueHead queue \<noteq> None \<longleftrightarrow> tcbQueueEnd queue \<noteq> None))
+     (\<lbrace>ctcb_queue_relation queue \<acute>queue\<rbrace> \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr tcbPtr\<rbrace>) hs
+     (tcbQueueRemove queue tcbPtr) (Call tcb_queue_remove_'proc)"
+  (is "ccorres _ _ ?abs _ _ _ _")
+  supply if_split[split del]
+  apply (cinit' lift: tcb_')
+   apply (rename_tac tcb')
+   apply (simp only: tcbQueueRemove_def)
+    \<comment> \<open>cinit is not able to lift queue_' because queue_' is later modified in the C program\<close>
+   apply (rule_tac xf'=queue_' in ccorres_abstract, ceqv, rename_tac cqueue)
+   apply (rule_tac P="ctcb_queue_relation queue cqueue" in ccorres_gen_asm2)
+   apply (rule ccorres_pre_getObject_tcb, rename_tac tcb)
+   apply (rule ccorres_symb_exec_l, rename_tac beforePtrOpt)
+      apply (rule ccorres_symb_exec_l, rename_tac afterPtrOpt)
+         apply (rule ccorres_move_c_guard_tcb)
+         apply (rule_tac xf'="before___ptr_to_struct_tcb_C_'"
+                     and val="option_to_ctcb_ptr beforePtrOpt"
+                     and R="ko_at' tcb tcbPtr and K (tcbSchedPrev tcb = beforePtrOpt)"
+                     and R'=UNIV
+                      in ccorres_symb_exec_r_known_rv)
+            apply (rule conseqPre, vcg)
+            apply (fastforce dest: obj_at_cslift_tcb simp: typ_heap_simps ctcb_relation_def)
            apply ceqv
-          apply (rule ccorres_rhs_assoc2)+
-          apply (simp only: bind_assoc[symmetric])
-          apply (rule ccorres_split_nothrow_novcg_dc)
-             prefer 2
-             apply (rule ccorres_move_c_guard_tcb)
-             apply ctac
-            prefer 2
-            apply (wp, clarsimp, wp+)
-           apply (rule_tac P="(\<lambda>s. \<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s)
-                                         \<and> distinct(ksReadyQueues s (d, p)))
-                                and valid_queues' and obj_at' (inQ rva rvb) t
-                                and (\<lambda>s. rva \<le> maxDomain \<and> rvb \<le> maxPriority)"
-                       and P'=UNIV in ccorres_from_vcg)
-           apply (rule allI, rule conseqPre, vcg)
-           apply (clarsimp simp: getQueue_def gets_def get_def setQueue_def modify_def
-                                 put_def bind_def return_def bitmap_fun_defs when_def
-                                 null_def)
-
-           apply (rule conjI; clarsimp simp: queue_in_range[simplified maxDom_to_H maxPrio_to_H])
-            apply (rule conjI; clarsimp simp: queue_in_range[simplified maxDom_to_H maxPrio_to_H])
-             apply (frule(1) valid_queuesD')
-             apply (drule (1) obj_at_cslift_tcb, clarsimp simp: inQ_def)
-             apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko" in rf_sr_sched_queue_relation)
-               apply (fastforce simp: maxDom_to_H maxPrio_to_H)+
-             apply (frule_tac s=\<sigma> in tcb_queue_relation_prev_next'; (fastforce simp: ksQ_tcb_at')?)
-             apply (drule_tac s=\<sigma> in tcbSchedDequeue_update, assumption,
-                    simp_all add: remove1_filter ksQ_tcb_at')[1]
-             apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                       unat_trans_ucast_helper\<close>)
-             apply (clarsimp simp: maxDomain_le_unat_ucast_explicit)
-             apply (intro conjI;
-                    clarsimp simp: h_val_field_clift'
-                                   h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)+
-               apply (drule(2) filter_empty_unfiltered_contr, simp)+
-             apply (rule conjI; clarsimp)
-              apply (rule conjI)
-               apply (fastforce simp: c_invert_assist l2BitmapSize_def' wordRadix_def)
-              apply (rule conjI; clarsimp)
-               apply (subst rf_sr_drop_bitmaps_dequeue_helper, assumption)
-                 apply (fastforce intro: cbitmap_L1_relation_bit_clear)
-                apply (simp add: invert_prioToL1Index_c_simp)
-                apply (frule rf_sr_cbitmap_L2_relation)
-                apply (clarsimp simp: cbitmap_L2_relation_def
-                                      word_size prioToL1Index_def wordRadix_def mask_def
-                                      word_le_nat_alt
-                                      numPriorities_def wordBits_def l2BitmapSize_def'
-                                      invertL1Index_def numDomains_less_numeric_explicit)
-                apply (case_tac "d = tcbDomain ko"
-                       ; fastforce simp: le_maxDomain_eq_less_numDomains
-                                         numDomains_less_numeric_explicit)
-               apply (drule (1) obj_at_cslift_tcb, clarsimp simp: inQ_def)
-               apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko"
-                        in rf_sr_sched_queue_relation)
-                 apply (fold_subgoals (prefix))[2]
-                subgoal premises prems using prems by (fastforce simp: maxDom_to_H maxPrio_to_H)+
-
-               apply (frule_tac s=\<sigma> in tcb_queue_relation_prev_next', assumption)
-                  prefer 3
-                  apply fastforce
-                 apply (fold_subgoals (prefix))[2]
-                subgoal premises prems using prems by ((fastforce simp: ksQ_tcb_at')+)
-               apply (drule_tac s=\<sigma> in tcbSchedDequeue_update, assumption,
-                      simp_all add: remove1_filter ksQ_tcb_at')[1]
-               (* trivial case, setting queue to empty *)
-               apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def carch_state_relation_def
-                                     cmachine_state_relation_def)
-               apply (erule (2) cready_queues_relation_empty_queue_helper)
-              (* impossible case, C L2 update disagrees with Haskell update *)
-              apply (simp add: invert_prioToL1Index_c_simp)
-              apply (subst (asm) num_domains_index_updates)
-               subgoal by (simp add: le_maxDomain_eq_less_numDomains word_le_nat_alt)
-              apply (subst (asm) Arrays.index_update)
-               apply (simp add: invert_l1_index_limit)
-
-              apply (frule rf_sr_cbitmap_L2_relation)
-              apply (drule_tac i="invertL1Index (prioToL1Index (tcbPriority ko))"
-                       in cbitmap_L2_relationD, assumption)
-               apply (fastforce simp: l2BitmapSize_def' invert_l1_index_limit)
-              apply (fastforce simp: prioToL1Index_def invertL1Index_def mask_def wordRadix_def)
-             (* impossible case *)
-             apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-             apply (drule(2) filter_empty_unfiltered_contr, fastforce)
-
-            apply (frule (1) valid_queuesD')
-            apply (drule (1) obj_at_cslift_tcb, clarsimp simp: inQ_def)
-            apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko"
-                     in rf_sr_sched_queue_relation)
-              apply fold_subgoals[2]
-              apply (fastforce simp: maxDom_to_H maxPrio_to_H)+
-            apply (clarsimp simp: h_val_field_clift'
-                                  h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)
-            apply (frule_tac s=\<sigma> in tcb_queue_relation_prev_next', assumption)
-               prefer 3
-               apply fastforce
-              apply (fold_subgoals (prefix))[2]
-             subgoal premises prems using prems by (fastforce simp: ksQ_tcb_at')+
-            apply (drule_tac s=\<sigma> in tcbSchedDequeue_update, assumption,
-                   simp_all add: remove1_filter ksQ_tcb_at')[1]
-            apply (clarsimp simp:  filter_noteq_op upd_unless_null_def)
-            apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                      unat_trans_ucast_helper\<close>)
-            apply (clarsimp simp: maxDomain_le_unat_ucast_explicit)
-            apply (rule conjI, clarsimp)
-             apply (clarsimp simp: h_val_field_clift'
-                                   h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)
-             apply (rule conjI; clarsimp)
-              apply (simp add: typ_heap_simps)
-              apply (clarsimp simp: h_t_valid_c_guard [OF h_t_valid_field, OF h_t_valid_clift]
-                                    h_t_valid_field[OF h_t_valid_clift] h_t_valid_clift)
-              apply (erule_tac S="set (ksReadyQueues \<sigma> (tcbDomain ko, tcbPriority ko))"
-                       in state_relation_queue_update_helper',
-                     (simp | rule globals.equality)+,
-                     simp_all add: clift_field_update if_Some_helper numPriorities_def
-                                   cready_queues_index_to_C_def2 typ_heap_simps
-                                   maxDom_to_H maxPrio_to_H
-                             cong: if_cong split del: if_split)[1]
-
-               apply (fastforce simp: tcb_null_sched_ptrs_def typ_heap_simps c_guard_clift
-                                elim: obj_at'_weaken)+
-             apply (erule_tac S="set (ksReadyQueues \<sigma> (tcbDomain ko, tcbPriority ko))"
-                      in state_relation_queue_update_helper',
-                    (simp | rule globals.equality)+,
-                    simp_all add: clift_field_update if_Some_helper numPriorities_def
-                                  cready_queues_index_to_C_def2
-                                  maxDom_to_H maxPrio_to_H
-                            cong: if_cong split del: if_split,
-                    simp_all add: typ_heap_simps')[1]
-               subgoal by (fastforce simp: tcb_null_sched_ptrs_def)
-              subgoal by (simp add: fpu_state_preservation[OF _ h_t_valid_clift] typ_heap_simps')
-             subgoal by fastforce
+          apply (rule ccorres_move_c_guard_tcb)
+          apply (rule_tac xf'="after___ptr_to_struct_tcb_C_'"
+                      and val="option_to_ctcb_ptr afterPtrOpt"
+                      and R="ko_at' tcb tcbPtr and K (tcbSchedNext tcb = afterPtrOpt)"
+                       in ccorres_symb_exec_r_known_rv[where R'=UNIV])
+             apply (rule conseqPre, vcg)
+             apply (fastforce dest: obj_at_cslift_tcb simp: typ_heap_simps ctcb_relation_def)
+            apply ceqv
+           apply (rule ccorres_cond_seq)
+           apply (rule ccorres_cond[where R="?abs"])
+             apply (fastforce dest: tcb_at_not_NULL
+                              simp: ctcb_queue_relation_def option_to_ctcb_ptr_def)
+            apply (rule ccorres_rhs_assoc)+
+            apply csymbr
+            apply csymbr
+            apply (fastforce intro: ccorres_return_C')
+           apply (rule ccorres_cond_seq)
+           apply (rule_tac Q="?abs" and Q'=\<top> in ccorres_cond_both')
+             apply (fastforce dest: tcb_at_not_NULL
+                              simp: ctcb_queue_relation_def option_to_ctcb_ptr_def split: if_splits)
             apply clarsimp
-            apply (rule conjI; clarsimp)
-             apply (rule conjI)
-              apply (fastforce simp: c_invert_assist l2BitmapSize_def' wordRadix_def)
-             apply (rule conjI; clarsimp)
-              (* invalid, missing bitmap updates on haskell side *)
-              apply (fold_subgoals (prefix))[2]
-             subgoal premises prems using prems
-               by (fastforce dest!: tcb_queue_relation'_empty_ksReadyQueues
-                              elim: obj_at'_weaken)+
-            apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-            apply (erule_tac S="set (ksReadyQueues \<sigma> (tcbDomain ko, tcbPriority ko))"
-                     in state_relation_queue_update_helper',
-                   (simp | rule globals.equality)+,
-                   simp_all add: clift_field_update if_Some_helper numPriorities_def
-                                 cready_queues_index_to_C_def2
-                                 maxDom_to_H maxPrio_to_H
-                           cong: if_cong split del: if_split)[1]
-               apply (fold_subgoals (prefix))[4]
-            subgoal premises prems using prems
-              by - (fastforce simp: typ_heap_simps c_guard_clift tcb_null_sched_ptrs_def
-                                    clift_heap_update_same[OF h_t_valid_clift]
-                                    fpu_state_preservation[OF _ h_t_valid_clift])+
-           apply (rule conjI; clarsimp simp: queue_in_range[simplified maxDom_to_H maxPrio_to_H])
-            apply (frule (1) valid_queuesD')
-            apply (drule (1) obj_at_cslift_tcb, clarsimp simp: inQ_def)
-            apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko"
-                     in rf_sr_sched_queue_relation)
-              apply (fold_subgoals (prefix))[2]
-             subgoal premises prems using prems by (fastforce simp: maxDom_to_H maxPrio_to_H)+
-            apply (clarsimp simp: h_val_field_clift'
-                                  h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)
-            apply (frule_tac s=\<sigma> in tcb_queue_relation_prev_next')
+            apply (rule ccorres_assert2)
+            apply (rule ccorres_rhs_assoc)+
+            apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                apply (rule ccorres_move_c_guard_tcb)+
+                apply (rule_tac P=\<top> and P'="tcb_at' tcbPtr"
+                            and Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb (the afterPtrOpt) s}"
+                             in threadSet_ccorres_lemma3)
+                 apply (rule conseqPre, vcg)
+                 apply clarsimp
+                 apply (frule (1) obj_at_cslift_tcb)
+                 apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                   simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                         tcb_cte_cases_def cteSizeBits_def)
                 apply fastforce
-               prefer 3
-               apply fastforce
-              apply (fold_subgoals (prefix))[2]
-             subgoal premises prems using prems by (fastforce simp: ksQ_tcb_at')+
-            apply (drule_tac s=\<sigma> in tcbSchedDequeue_update, assumption,
-                   simp_all add: remove1_filter ksQ_tcb_at')[1]
-            apply (clarsimp simp:  filter_noteq_op upd_unless_null_def)
-            apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                      unat_trans_ucast_helper\<close>)
-            apply (clarsimp simp: maxDomain_le_unat_ucast_explicit)
-            apply (rule conjI; clarsimp)
-             apply (clarsimp simp: h_val_field_clift'
-                                   h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)
-             apply (clarsimp simp: typ_heap_simps)
-             apply (rule conjI; clarsimp simp: typ_heap_simps)
-             apply (drule(2) filter_empty_unfiltered_contr[simplified filter_noteq_op], simp)
-            apply (rule conjI)
-             apply (fastforce simp: c_invert_assist l2BitmapSize_def' wordRadix_def)
-            apply (rule conjI; clarsimp)
-             (* impossible case, C L2 update disagrees with Haskell update *)
-             apply (subst (asm) num_domains_index_updates)
-              apply (simp add: le_maxDomain_eq_less_numDomains word_le_nat_alt)
-             apply (subst (asm) Arrays.index_update)
-              subgoal using invert_l1_index_limit
-                by (fastforce simp add: invert_prioToL1Index_c_simp intro: nat_Suc_less_le_imp)
-             apply (frule rf_sr_cbitmap_L2_relation)
-             apply (simp add: invert_prioToL1Index_c_simp)
-             apply (drule_tac i="invertL1Index (prioToL1Index (tcbPriority ko))"
-                      in cbitmap_L2_relationD, assumption)
-              subgoal by (simp add: invert_l1_index_limit l2BitmapSize_def')
-             apply (fastforce simp: prioToL1Index_def invertL1Index_def mask_def wordRadix_def)
-
-            apply (simp add: invert_prioToL1Index_c_simp)
-            apply (subst rf_sr_drop_bitmaps_dequeue_helper_L2, assumption)
-             subgoal by (fastforce dest: rf_sr_cbitmap_L2_relation elim!: cbitmap_L2_relation_bit_clear)
-
-            (* trivial case, setting queue to empty *)
-            apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def carch_state_relation_def
-                                  cmachine_state_relation_def)
-            apply (erule (2) cready_queues_relation_empty_queue_helper)
-
-           apply (frule (1) valid_queuesD')
-           apply (drule (1) obj_at_cslift_tcb, clarsimp simp: inQ_def)
-           apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko"
-                    in rf_sr_sched_queue_relation)
-             apply (fold_subgoals (prefix))[2]
-            subgoal premises prems using prems by (fastforce simp: maxDom_to_H maxPrio_to_H)+
-           apply (clarsimp simp: h_val_field_clift'
-                                 h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)
-           apply (simp add: invert_prioToL1Index_c_simp)
-           apply (frule_tac s=\<sigma> in tcb_queue_relation_prev_next')
-               apply (fastforce simp add: ksQ_tcb_at')+
-           apply (drule_tac s=\<sigma> in tcbSchedDequeue_update, assumption,
-                  simp_all add: remove1_filter ksQ_tcb_at')[1]
-           apply (clarsimp simp: filter_noteq_op upd_unless_null_def)
-           apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                     unat_trans_ucast_helper\<close>)
-           apply (clarsimp simp: maxDomain_le_unat_ucast_explicit)
-           apply (rule conjI, clarsimp)
-            apply (clarsimp simp: h_val_field_clift'
-                                  h_t_valid_clift[THEN h_t_valid_field] h_t_valid_clift)
-            apply (clarsimp simp: typ_heap_simps)
-            apply (rule conjI; clarsimp simp: typ_heap_simps)
-             apply (erule_tac S="set (ksReadyQueues \<sigma> (tcbDomain ko, tcbPriority ko))"
-                      in state_relation_queue_update_helper',
-                    (simp | rule globals.equality)+,
-                    simp_all add: clift_field_update if_Some_helper numPriorities_def
-                                  cready_queues_index_to_C_def2
-                                  maxDom_to_H maxPrio_to_H
-                            cong: if_cong split del: if_split)[1]
-                apply (fastforce simp: tcb_null_sched_ptrs_def)
-               apply (clarsimp simp: typ_heap_simps)
-              apply (fastforce simp: typ_heap_simps)
-             apply (fastforce simp: tcb_null_sched_ptrs_def)
-            apply (erule_tac S="set (ksReadyQueues \<sigma> (tcbDomain ko, tcbPriority ko))"
-                     in state_relation_queue_update_helper',
-                   (simp | rule globals.equality)+,
-                   simp_all add: clift_field_update if_Some_helper numPriorities_def
-                                 cready_queues_index_to_C_def2
-                                 maxDom_to_H maxPrio_to_H
-                           cong: if_cong split del: if_split)[1]
-               apply (fold_subgoals (prefix))[4]
-            subgoal premises prems using prems
-              by - (fastforce simp: typ_heap_simps c_guard_clift tcb_null_sched_ptrs_def
-                                    clift_heap_update_same[OF h_t_valid_clift]
-                                    fpu_state_preservation[OF _ h_t_valid_clift])+
-           apply (clarsimp)
-           apply (rule conjI; clarsimp simp: typ_heap_simps)
-            apply (rule conjI)
-             apply (fastforce simp: c_invert_assist l2BitmapSize_def' wordRadix_def)
-            apply (rule conjI; clarsimp)
-             (* invalid, missing bitmap updates on haskell side *)
-             apply (drule tcb_queue_relation'_empty_ksReadyQueues)
-              apply (fold_subgoals (prefix))[2]
-             subgoal premises prems using prems by (fastforce elim: obj_at'_weaken)+
-            (* invalid, missing bitmap updates on haskell side *)
-            apply (drule tcb_queue_relation'_empty_ksReadyQueues)
-             apply (fold_subgoals (prefix))[2]
-            subgoal premises prems using prems by (fastforce elim: obj_at'_weaken)+
-           apply (erule_tac S="set (ksReadyQueues \<sigma> (tcbDomain ko, tcbPriority ko))"
-                    in state_relation_queue_update_helper',
-                  (simp | rule globals.equality)+,
-                  simp_all add: clift_field_update if_Some_helper numPriorities_def
-                                cready_queues_index_to_C_def2 typ_heap_simps
-                                maxDom_to_H maxPrio_to_H
-                          cong: if_cong split del: if_split)[1]
-            apply (fold_subgoals (prefix))[2]
-           subgoal premises prems using prems
-            by (fastforce simp: typ_heap_simps c_guard_clift tcb_null_sched_ptrs_def)+
-          apply (simp add: guard_is_UNIV_def)
-         apply simp
-         apply (wp threadGet_wp)
-        apply vcg
-       apply simp
-       apply (wp threadGet_wp)
-      apply vcg
-     apply (rule ccorres_return_Skip)
-    apply simp
-    apply (wp threadGet_wp)
-   apply vcg
-  by (fastforce simp: valid_objs'_def obj_at'_def ran_def projectKOs typ_at'_def
-                      valid_obj'_def valid_tcb'_def inQ_def)
-qed
-
-lemma tcbSchedDequeue_ccorres:
-  "ccorres dc xfdc
-           (valid_queues and valid_queues' and tcb_at' t and valid_objs')
-           (UNIV \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace>)
-           []
-           (tcbSchedDequeue t)
-           (Call tcbSchedDequeue_'proc)"
-  apply (rule ccorres_guard_imp [OF tcbSchedDequeue_ccorres'])
-   apply (clarsimp simp: valid_queues_def valid_queues_no_bitmap_def)
-   apply (drule_tac x=d in spec)
-   apply (drule_tac x=p in spec)
-   apply (clarsimp)
-   apply (drule(1) bspec)
-   apply (erule obj_at'_weakenE)
-   apply (clarsimp)+
-  done
-
-lemma tcb_queue_relation_append:
-  "\<lbrakk> tcb_queue_relation tn tp mp queue qprev qhead; queue \<noteq> [];
-     qend' \<notin> tcb_ptr_to_ctcb_ptr ` set queue; mp qend' = Some tcb;
-     queue = queue' @ [ctcb_ptr_to_tcb_ptr qend]; distinct queue;
-     \<forall>x \<in> set queue. tcb_ptr_to_ctcb_ptr x \<noteq> NULL; qend' \<noteq> NULL;
-     \<And>v f g. tn (tn_update f v) = f (tn v) \<and> tp (tp_update g v) = g (tp v)
-                \<and> tn (tp_update f v) = tn v \<and> tp (tn_update g v) = tp v \<rbrakk>
-    \<Longrightarrow> tcb_queue_relation tn tp
-          (mp (qend \<mapsto> tn_update (\<lambda>_. qend') (the (mp qend)),
-               qend' \<mapsto> tn_update (\<lambda>_. NULL) (tp_update (\<lambda>_. qend) tcb)))
-          (queue @ [ctcb_ptr_to_tcb_ptr qend']) qprev qhead"
-  using [[hypsubst_thin = true]]
-  apply clarsimp
-  apply (induct queue' arbitrary: qprev qhead)
-   apply clarsimp
-  apply clarsimp
-  done
-
-lemma tcbSchedAppend_update:
-  assumes sr: "sched_queue_relation' mp queue qhead qend"
-  and     qh': "qend' \<notin> tcb_ptr_to_ctcb_ptr ` set queue"
-  and  cs_tcb: "mp qend' = Some tcb"
-  and valid_ep: "\<forall>t\<in>set queue. tcb_at' t s" "distinct queue"
-  and     qhN: "qend' \<noteq> NULL"
-  shows
-  "sched_queue_relation'
-            (upd_unless_null qend (tcbSchedNext_C_update (\<lambda>_. qend') (the (mp qend)))
-                (mp(qend' \<mapsto> tcb\<lparr>tcbSchedNext_C := NULL, tcbSchedPrev_C := qend\<rparr>)))
-            (queue @ [ctcb_ptr_to_tcb_ptr qend']) (if queue = [] then qend' else qhead) qend'"
-  using sr qh' valid_ep cs_tcb qhN
-  apply -
-  apply (rule rev_cases[where xs=queue])
-   apply (simp add: tcb_queue_relation'_def upd_unless_null_def)
-  apply (clarsimp simp: tcb_queue_relation'_def upd_unless_null_def tcb_at_not_NULL)
-  apply (drule_tac qend'=qend' and tn_update=tcbSchedNext_C_update
-             and tp_update=tcbSchedPrev_C_update and qend="tcb_ptr_to_ctcb_ptr y"
-             in tcb_queue_relation_append, simp_all)
-   apply (fastforce simp add: tcb_at_not_NULL)
-  apply (simp add: fun_upd_twist)
-  done
-
-lemma tcb_queue_relation_qend_mems:
-  "\<lbrakk> tcb_queue_relation' getNext getPrev mp queue qhead qend;
-     \<forall>x \<in> set queue. tcb_at' x s \<rbrakk>
-      \<Longrightarrow> (qend = NULL \<longrightarrow> queue = [])
-       \<and> (qend \<noteq> NULL \<longrightarrow> ctcb_ptr_to_tcb_ptr qend \<in> set queue)"
-  apply (clarsimp simp: tcb_queue_relation'_def)
-  apply (drule bspec, erule last_in_set)
-  apply (simp add: tcb_at_not_NULL)
+               apply ceqv
+              apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                  apply (rule ccorres_move_c_guard_tcb)
+                  apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb tcbPtr s}"
+                               in threadSet_ccorres_lemma3[where P=\<top> and P'=\<top>, simplified])
+                   apply (rule conseqPre, vcg)
+                   apply clarsimp
+                   apply (frule (1) obj_at_cslift_tcb[where thread=tcbPtr])
+                   apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                     simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                           tcb_cte_cases_def cteSizeBits_def)
+                  apply clarsimp
+                 apply ceqv
+                apply (rule ccorres_symb_exec_r)
+                  apply (fastforce intro: ccorres_return_C')
+                 apply vcg
+                apply (rule conseqPre, vcg)
+                apply clarsimp
+               apply wpsimp
+              apply vcg
+             apply wpsimp
+            apply vcg
+           apply (rule ccorres_cond_seq)
+           apply (rule_tac Q="?abs" and Q'=\<top> in ccorres_cond_both')
+             apply (fastforce dest: tcb_at_not_NULL
+                              simp: ctcb_queue_relation_def option_to_ctcb_ptr_def split: if_splits)
+            apply clarsimp
+            apply (rule ccorres_assert2)
+            apply (rule ccorres_rhs_assoc)+
+            apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                apply (rule ccorres_move_c_guard_tcb)+
+                apply (rule_tac P=\<top> and P'="tcb_at' tcbPtr"
+                            and Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb (the beforePtrOpt) s}"
+                             in threadSet_ccorres_lemma3)
+                 apply (rule conseqPre, vcg)
+                 apply clarsimp
+                 apply (frule (1) obj_at_cslift_tcb)
+                 apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                   simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                         tcb_cte_cases_def cteSizeBits_def)
+                apply fastforce
+               apply ceqv
+              apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                  apply (rule ccorres_move_c_guard_tcb)
+                  apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb tcbPtr s}"
+                               in threadSet_ccorres_lemma3[where P=\<top> and P'=\<top>, simplified])
+                   apply (rule conseqPre, vcg)
+                   apply clarsimp
+                   apply (frule (1) obj_at_cslift_tcb[where thread=tcbPtr])
+                   apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                     simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                           tcb_cte_cases_def cteSizeBits_def)
+                  apply clarsimp
+                 apply ceqv
+                apply (rule ccorres_symb_exec_r)
+                  apply (fastforce intro: ccorres_return_C')
+                 apply vcg
+                apply (rule conseqPre, vcg)
+                apply clarsimp
+               apply wpsimp
+              apply vcg
+             apply wpsimp
+            apply vcg
+           apply clarsimp
+           apply (rule ccorres_assert2)+
+           apply (rule ccorres_rhs_assoc)+
+           apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+               apply (rule ccorres_move_c_guard_tcb)+
+               apply (rule_tac Q="\<lambda>s tcb'. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb' (the beforePtrOpt) s}"
+                            in threadSet_ccorres_lemma3[where P=\<top> and P'=\<top>, simplified])
+                apply (rule conseqPre, vcg)
+                apply clarsimp
+                apply (frule (1) obj_at_cslift_tcb)
+                apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                  simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                        tcb_cte_cases_def cteSizeBits_def)
+               apply clarsimp
+              apply ceqv
+             apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                 apply (rule ccorres_move_c_guard_tcb)+
+                 apply (rule_tac P=\<top> and P'="tcb_at' tcbPtr"
+                             and Q="\<lambda>s tcb'. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb' (the afterPtrOpt) s}"
+                              in threadSet_ccorres_lemma3)
+                  apply (rule conseqPre, vcg)
+                  apply clarsimp
+                  apply (frule (1) obj_at_cslift_tcb)
+                  apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                    simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                          tcb_cte_cases_def cteSizeBits_def)
+                 apply clarsimp
+                apply ceqv
+               apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                   apply (rule ccorres_move_c_guard_tcb)
+                   apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb tcbPtr s}"
+                                in threadSet_ccorres_lemma3[where P=\<top> and P'=\<top>, simplified])
+                    apply (rule conseqPre, vcg)
+                    apply clarsimp
+                    apply (frule (1) obj_at_cslift_tcb[where thread=tcbPtr])
+                    apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                      simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                            tcb_cte_cases_def cteSizeBits_def)
+                   apply clarsimp
+                  apply ceqv
+                 apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
+                     apply (rule ccorres_move_c_guard_tcb)
+                     apply (rule_tac Q="\<lambda>s tcb. {s'. (s, s') \<in> rf_sr \<and> ko_at' tcb tcbPtr s}"
+                                  in threadSet_ccorres_lemma3[where P=\<top> and P'=\<top>, simplified])
+                      apply (rule conseqPre, vcg)
+                      apply clarsimp
+                      apply (frule (1) obj_at_cslift_tcb[where thread=tcbPtr])
+                      apply (fastforce elim!: rf_sr_tcb_update_no_queue_gen2
+                                        simp: typ_heap_simps' ctcb_relation_def option_to_ctcb_ptr_def
+                                              tcb_cte_cases_def cteSizeBits_def)
+                     apply fastforce
+                    apply ceqv
+                   apply (fastforce intro: ccorres_return_C')
+                  apply (wpsimp | vcg)+
+  apply (clarsimp split: if_splits)
+  apply normalise_obj_at'
+  apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+  by (intro conjI impI;
+      clarsimp simp: ctcb_queue_relation_def typ_heap_simps option_to_ctcb_ptr_def
+                     valid_tcb'_def valid_bound_tcb'_def)
+
+lemma tcbQueueRemove_tcb_at'_head:
+  "\<lbrace>\<lambda>s. valid_objs' s \<and> (\<forall>head. tcbQueueHead queue = Some head \<longrightarrow> tcb_at' head s)\<rbrace>
+   tcbQueueRemove queue t
+   \<lbrace>\<lambda>rv s. \<not> tcbQueueEmpty rv \<longrightarrow> tcb_at' (the (tcbQueueHead rv)) s\<rbrace>"
+  unfolding tcbQueueRemove_def
+  apply (wpsimp wp: getTCB_wp haskell_assert_wp hoare_vcg_imp_lift')
+  apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+  apply (fastforce simp: valid_tcb'_def valid_bound_tcb'_def tcbQueueEmpty_def obj_at'_def)
   done
 
-lemma tcbSchedAppend_ccorres:
+lemma tcbSchedDequeue_ccorres:
   "ccorres dc xfdc
-           (valid_queues and tcb_at' t and valid_objs')
-           (UNIV \<inter> \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace>)
-           []
-           (tcbSchedAppend t)
-           (Call tcbSchedAppend_'proc)"
+     (tcb_at' t and valid_objs' and pspace_aligned' and pspace_distinct')
+     \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr t\<rbrace> hs
+     (tcbSchedDequeue t) (Call tcbSchedDequeue_'proc)"
 proof -
   note prio_and_dom_limit_helpers[simp] word_sle_def[simp] maxDom_to_H[simp] maxPrio_to_H[simp]
+  note invert_prioToL1Index_c_simp[simp]
 
   (* when numDomains = 1, array bounds checks would become _ = 0 rather than _ < 1, changing the
      shape of the proof compared to when numDomains > 1 *)
   include no_less_1_simps
 
   show ?thesis
-  apply (cinit lift: tcb_')
-   apply (rule_tac r'="\<lambda>rv rv'. rv = to_bool rv'"
-               and xf'="ret__unsigned_longlong_'" in ccorres_split_nothrow)
-       apply (rule threadGet_vcg_corres)
-       apply (rule allI, rule conseqPre, vcg)
-       apply clarsimp
-       apply (drule obj_at_ko_at', clarsimp)
-       apply (drule spec, drule(1) mp, clarsimp)
-       apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-      apply ceqv
-     apply (simp add: when_def unless_def del: Collect_const split del: if_split)
-     apply (rule ccorres_cond[where R=\<top>])
-       apply (simp add: to_bool_def)
-      apply (rule ccorres_rhs_assoc)+
-      apply csymbr
-      apply csymbr
-      apply csymbr
-      apply csymbr
-      apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv"
-          and xf'="dom_'" in ccorres_split_nothrow)
-          apply (rule threadGet_vcg_corres)
-          apply (rule allI, rule conseqPre, vcg)
-          apply clarsimp
-          apply (drule obj_at_ko_at', clarsimp)
-          apply (drule spec, drule(1) mp, clarsimp)
-          apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
-         apply ceqv
-        apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv"
-            and xf'="prio_'" in ccorres_split_nothrow)
+    apply (cinit lift: tcb_')
+     apply (rule ccorres_stateAssert)+
+     apply (rule_tac r'="\<lambda>rv rv'. rv = to_bool rv'" and xf'="ret__unsigned_longlong_'"
+                  in ccorres_split_nothrow)
+         apply (rule threadGet_vcg_corres)
+         apply (rule allI, rule conseqPre, vcg)
+         apply clarsimp
+         apply (drule obj_at_ko_at', clarsimp)
+         apply (drule spec, drule(1) mp, clarsimp)
+         apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+        apply ceqv
+       apply (simp add: when_def del: Collect_const split del: if_split)
+       apply (rule ccorres_cond[where R=\<top>])
+         apply (simp add: to_bool_def)
+        apply (rule ccorres_rhs_assoc)+
+        apply csymbr
+        apply csymbr
+        apply csymbr
+        apply csymbr
+        apply csymbr
+        apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="dom_'" in ccorres_split_nothrow)
             apply (rule threadGet_vcg_corres)
             apply (rule allI, rule conseqPre, vcg)
             apply clarsimp
@@ -1815,123 +1484,78 @@ proof -
             apply (drule spec, drule(1) mp, clarsimp)
             apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
            apply ceqv
-          apply (rule ccorres_rhs_assoc2)+
-          apply (simp only: bind_assoc[symmetric])
-          apply (rule ccorres_split_nothrow_novcg_dc)
-             prefer 2
-             apply (rule ccorres_move_c_guard_tcb)
-             apply ctac
-            prefer 2
-            apply (wp, clarsimp, wp+)
-           apply (rule_tac P="\<lambda>s. valid_queues s \<and> (\<forall>p. t \<notin> set (ksReadyQueues s p))
-                                  \<and> (\<exists>tcb. ko_at' tcb t s \<and> tcbDomain tcb =rva
-                                  \<and> tcbPriority tcb = rvb \<and> valid_tcb' tcb s)"
-                       and P'=UNIV in ccorres_from_vcg)
-           apply (rule allI, rule conseqPre, vcg)
-           apply (clarsimp simp: getQueue_def gets_def get_def setQueue_def modify_def
-                                 put_def bind_def return_def bitmap_fun_defs null_def)
-           apply (clarsimp simp: queue_in_range valid_tcb'_def)
-           apply (rule conjI; clarsimp simp: queue_in_range)
-            apply (drule (1) obj_at_cslift_tcb)
-            apply clarsimp
-            apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb"
-                     in rf_sr_sched_queue_relation)
-              apply clarsimp
-             apply clarsimp
-            apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL)
-             apply (simp add: valid_queues_valid_q)
-            apply (frule_tac s=\<sigma> in tcb_queue_relation_qend_mems,  simp add: valid_queues_valid_q)
-            apply (drule_tac qend'="tcb_ptr_to_ctcb_ptr t" and s=\<sigma> in tcbSchedAppend_update,
-                   simp_all add: valid_queues_valid_q)[1]
-             apply (rule tcb_at_not_NULL, erule obj_at'_weakenE, simp)
-            apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-            apply (simp add: invert_prioToL1Index_c_simp)
-            apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                      unat_trans_ucast_helper\<close>)
-            apply (clarsimp simp: maxDomain_le_unat_ucast_explicit)
-            apply (rule conjI; clarsimp)
-             apply (rule conjI)
-              apply (fastforce simp: c_invert_assist l2BitmapSize_def' wordRadix_def)
-             apply (simp add: t_hrs_ksReadyQueues_upd_absorb)
-             apply (subst rf_sr_drop_bitmaps_enqueue_helper, assumption)
-               apply (fastforce intro: cbitmap_L1_relation_bit_set)
-              subgoal by (fastforce intro: cbitmap_L2_relation_bit_set simp: wordRadix_def mask_def)
-             apply (erule(1) state_relation_queue_update_helper[where S="{t}"],
-                    (simp | rule globals.equality)+,
-                    simp_all add: cready_queues_index_to_C_def2 numPriorities_def
-                                  t_hrs_ksReadyQueues_upd_absorb upd_unless_null_def
-                                  typ_heap_simps)[1]
-               apply (fastforce simp: tcb_null_sched_ptrs_def elim: obj_at'_weaken)
-             apply (fastforce simp: tcb_null_sched_ptrs_def elim: obj_at'_weaken)
-            apply (clarsimp simp: upd_unless_null_def cready_queues_index_to_C_def numPriorities_def)
-           apply (rule conjI, solves \<open>clarsimp simp: le_maxDomain_eq_less_numDomains
-                                                     unat_trans_ucast_helper\<close>)
-           apply (clarsimp simp: maxDomain_le_unat_ucast_explicit)
-           apply (rule conjI; clarsimp simp: queue_in_range)
-            apply (drule (1) obj_at_cslift_tcb)
-            apply clarsimp
-            apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb"
-                     in rf_sr_sched_queue_relation)
-              apply clarsimp
-             apply clarsimp
-            apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL)
-             apply (simp add: valid_queues_valid_q)
-            apply (frule_tac s=\<sigma> in tcb_queue_relation_qend_mems,
-                   simp add: valid_queues_valid_q)
-            apply (drule_tac qend'="tcb_ptr_to_ctcb_ptr t" and s=\<sigma> in tcbSchedAppend_update,
-                   simp_all add: valid_queues_valid_q)[1]
+          apply (rule_tac r'="\<lambda>rv rv'. rv' = ucast rv" and xf'="prio_'" in ccorres_split_nothrow)
+              apply (rule threadGet_vcg_corres)
+              apply (rule allI, rule conseqPre, vcg)
               apply clarsimp
-             apply (rule tcb_at_not_NULL, erule obj_at'_weakenE, simp)
-            apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-            apply (clarsimp simp: upd_unless_null_def cready_queues_index_to_C_def numPriorities_def)
-           apply (drule (1) obj_at_cslift_tcb)
-           apply clarsimp
-           apply (frule_tac d="tcbDomain tcb" and p="tcbPriority tcb"
-                    in rf_sr_sched_queue_relation)
-             apply clarsimp
+              apply (drule obj_at_ko_at', clarsimp)
+              apply (drule spec, drule(1) mp, clarsimp)
+              apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
+             apply ceqv
+            apply (rule ccorres_symb_exec_r)
+              apply (rule ccorres_Guard_Seq)
+              apply (simp add: bind_assoc)
+              apply (ctac add: getQueue_ccorres)
+                apply (rule_tac r'=ctcb_queue_relation and xf'=new_queue_' in ccorres_split_nothrow)
+                    apply (ctac add: tcb_queue_remove_ccorres)
+                   apply ceqv
+                  apply (rename_tac queue' newqueue)
+                  apply (rule ccorres_Guard_Seq)
+                  apply (ctac add: setQueue_ccorres)
+                    apply (rule ccorres_split_nothrow_novcg_dc)
+                       apply ctac
+                      apply (rule_tac xf'=ret__unsigned_long_'
+                                  and val="from_bool (tcbQueueEmpty queue')"
+                                  and R="\<lambda>s. \<not> tcbQueueEmpty queue' \<longrightarrow> tcb_at' (the (tcbQueueHead queue')) s"
+                                  in ccorres_symb_exec_r_known_rv[where R'=UNIV])
+                         apply (rule conseqPre, vcg)
+                         apply (fastforce dest: tcb_at_not_NULL
+                                          simp: ctcb_queue_relation_def option_to_ctcb_ptr_def
+                                                tcbQueueEmpty_def split: option.splits)
+                        apply ceqv
+                       apply (rule ccorres_cond[where R=\<top>])
+                         apply fastforce
+                        apply (ctac add: removeFromBitmap_ccorres)
+                       apply (rule ccorres_return_Skip)
+                      apply vcg
+                     apply (wpsimp wp: hoare_vcg_imp_lift')
+                    apply (clarsimp simp: guard_is_UNIV_def)
+                   apply (wpsimp wp: hoare_vcg_imp_lift')
+                  apply vcg
+                 apply ((wpsimp wp: tcbQueueRemove_tcb_at'_head | wp (once) hoare_drop_imps)+)[1]
+                apply (vcg exspec=tcb_queue_remove_modifies)
+               apply wpsimp
+              apply vcg
+             apply vcg
+            apply (rule conseqPre, vcg)
             apply clarsimp
-           apply (frule_tac s=\<sigma> in tcb_queue'_head_end_NULL)
-            apply (simp add: valid_queues_valid_q)
-           apply (frule_tac s=\<sigma> in tcb_queue_relation_qend_mems,
-                  simp add: valid_queues_valid_q)
-           apply (drule_tac qend'="tcb_ptr_to_ctcb_ptr t" and s=\<sigma> in tcbSchedAppend_update,
-                  simp_all add: valid_queues_valid_q)[1]
-             apply clarsimp
-            apply (rule tcb_at_not_NULL, erule obj_at'_weakenE, simp)
-           apply (clarsimp simp: cready_queues_index_to_C_def2 numPriorities_def)
-           apply (frule(2) obj_at_cslift_tcb[OF valid_queues_obj_at'D])
-           apply (clarsimp simp: h_val_field_clift' h_t_valid_clift)
-           apply (erule_tac S="{t, v}" for v in state_relation_queue_update_helper,
-                  (simp | rule globals.equality)+,
-                  simp_all add: typ_heap_simps if_Some_helper numPriorities_def
-                                cready_queues_index_to_C_def2 upd_unless_null_def
-                           cong: if_cong split del: if_split
-                           del: fun_upd_restrict_conv)[1]
-              apply simp
-              apply (rule conjI)
-               apply clarsimp
-               apply (drule_tac s="tcb_ptr_to_ctcb_ptr t" in sym, simp)
-              apply (clarsimp simp add: fun_upd_twist)
-             prefer 3
-             apply (simp add: obj_at'_weakenE[OF _ TrueI])
-             apply (rule disjI1, erule valid_queues_obj_at'D)
-             subgoal by simp
-            subgoal by simp
-           subgoal by (fastforce simp: tcb_null_sched_ptrs_def)
-          apply (simp add: guard_is_UNIV_def)
-         apply simp
-         apply (wp threadGet_wp)
+           apply (wpsimp wp: threadGet_wp)
+          apply vcg
+         apply clarsimp
+         apply (wpsimp wp: threadGet_wp)
         apply vcg
-       apply simp
-       apply (wp threadGet_wp)
-      apply vcg
-     apply (rule ccorres_return_Skip)
-    apply simp
-    apply (wp threadGet_wp)
-   apply vcg
-  by (fastforce simp: valid_objs'_def obj_at'_def ran_def projectKOs typ_at'_def
-                         valid_obj'_def inQ_def
-                   dest!: valid_queues_obj_at'D)
+       apply (rule ccorres_return_Skip)
+      apply (wpsimp wp: threadGet_wp)
+     apply (vcg expsec=thread_state_get_tcbQueued_modifies)
+    apply normalise_obj_at'
+    apply (rename_tac tcb)
+    apply (frule (1) obj_at_cslift_tcb)
+    apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+    apply (clarsimp simp: valid_tcb'_def)
+    apply (cut_tac qdom="tcbDomain tcb" and prio="tcbPriority tcb"
+                in cready_queues_index_to_C_in_range)
+      apply fastforce
+     apply fastforce
+    apply (rule conjI)
+     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
+     apply (frule (3) obj_at'_tcbQueueHead_ksReadyQueues)
+     apply (force dest!: tcbQueueHead_iff_tcbQueueEnd simp: tcbQueueEmpty_def obj_at'_def)
+    by (fastforce simp: word_less_nat_alt
+                        cready_queues_index_to_C_def2 ctcb_relation_def
+                        typ_heap_simps le_maxDomain_eq_less_numDomains(2) unat_trans_ucast_helper)
 qed
 
 lemma isStopped_spec:
@@ -1979,8 +1603,11 @@ lemma tcb_at_1:
   done
 
 lemma rescheduleRequired_ccorres:
-  "ccorres dc xfdc (valid_queues and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and valid_objs')
-           UNIV [] rescheduleRequired (Call rescheduleRequired_'proc)"
+  "ccorres dc xfdc
+     ((\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and valid_objs'
+      and pspace_aligned' and pspace_distinct')
+     UNIV []
+     rescheduleRequired (Call rescheduleRequired_'proc)"
   apply cinit
    apply (rule ccorres_symb_exec_l)
       apply (rule ccorres_split_nothrow_novcg[where r'=dc and xf'=xfdc])
@@ -2090,10 +1717,12 @@ lemma cguard_UNIV:
   by fastforce
 
 lemma lookupBitmapPriority_le_maxPriority:
-  "\<lbrakk> ksReadyQueuesL1Bitmap s d \<noteq> 0 ; valid_queues s \<rbrakk>
+  "\<lbrakk> ksReadyQueuesL1Bitmap s d \<noteq> 0 ;
+     \<forall>d p. d > maxDomain \<or> p > maxPriority \<longrightarrow> tcbQueueEmpty (ksReadyQueues s (d, p));
+     valid_bitmaps s \<rbrakk>
    \<Longrightarrow> lookupBitmapPriority d s \<le> maxPriority"
-   unfolding valid_queues_def valid_queues_no_bitmap_def
-   by (fastforce dest!: bitmapQ_from_bitmap_lookup bitmapQ_ksReadyQueuesI intro: ccontr)
+  apply (clarsimp simp: valid_bitmaps_def)
+  by (fastforce dest!: bitmapQ_from_bitmap_lookup bitmapQ_ksReadyQueuesI intro: ccontr)
 
 lemma rf_sr_ksReadyQueuesL1Bitmap_not_zero:
   "\<lbrakk> (\<sigma>, s') \<in> rf_sr ; d \<le> maxDomain ; ksReadyQueuesL1Bitmap_' (globals s').[unat d] \<noteq> 0 \<rbrakk>
@@ -2103,10 +1732,10 @@ lemma rf_sr_ksReadyQueuesL1Bitmap_not_zero:
   done
 
 lemma ksReadyQueuesL1Bitmap_word_log2_max:
-    "\<lbrakk>valid_queues s; ksReadyQueuesL1Bitmap s d \<noteq> 0\<rbrakk>
-    \<Longrightarrow> word_log2 (ksReadyQueuesL1Bitmap s d) < l2BitmapSize"
-    unfolding valid_queues_def
-    by (fastforce dest: word_log2_nth_same bitmapQ_no_L1_orphansD)
+  "\<lbrakk>valid_bitmaps s; ksReadyQueuesL1Bitmap s d \<noteq> 0\<rbrakk>
+   \<Longrightarrow> word_log2 (ksReadyQueuesL1Bitmap s d) < l2BitmapSize"
+  unfolding valid_bitmaps_def
+  by (fastforce dest: word_log2_nth_same bitmapQ_no_L1_orphansD)
 
 lemma word_log2_max_word64[simp]:
   "word_log2 (w :: 64 word) < 64"
@@ -2114,7 +1743,7 @@ lemma word_log2_max_word64[simp]:
   by (simp add: word_size)
 
 lemma rf_sr_ksReadyQueuesL2Bitmap_simp:
-  "\<lbrakk> (\<sigma>, s') \<in> rf_sr ; d \<le> maxDomain ; valid_queues \<sigma> ; ksReadyQueuesL1Bitmap \<sigma> d \<noteq> 0 \<rbrakk>
+  "\<lbrakk> (\<sigma>, s') \<in> rf_sr ; d \<le> maxDomain ; valid_bitmaps \<sigma> ; ksReadyQueuesL1Bitmap \<sigma> d \<noteq> 0 \<rbrakk>
    \<Longrightarrow> ksReadyQueuesL2Bitmap_' (globals s').[unat d].[word_log2 (ksReadyQueuesL1Bitmap \<sigma> d)] =
       ksReadyQueuesL2Bitmap \<sigma> (d, word_log2 (ksReadyQueuesL1Bitmap \<sigma> d))"
   apply (frule rf_sr_cbitmap_L2_relation)
@@ -2123,9 +1752,9 @@ lemma rf_sr_ksReadyQueuesL2Bitmap_simp:
   done
 
 lemma ksReadyQueuesL2Bitmap_nonzeroI:
-  "\<lbrakk> d \<le> maxDomain ; valid_queues s ; ksReadyQueuesL1Bitmap s d \<noteq> 0 \<rbrakk>
+  "\<lbrakk> d \<le> maxDomain ; valid_bitmaps s ; ksReadyQueuesL1Bitmap s d \<noteq> 0 \<rbrakk>
    \<Longrightarrow> ksReadyQueuesL2Bitmap s (d, invertL1Index (word_log2 (ksReadyQueuesL1Bitmap s d))) \<noteq> 0"
-   unfolding valid_queues_def
+   unfolding valid_bitmaps_def
    apply clarsimp
    apply (frule bitmapQ_no_L1_orphansD)
     apply (erule word_log2_nth_same)
@@ -2325,9 +1954,9 @@ lemma threadGet_get_obj_at'_has_domain:
 lemma possibleSwitchTo_ccorres:
   shows
   "ccorres dc xfdc
-         (valid_queues and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
+         ((\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
             and st_tcb_at' runnable' t and (\<lambda>s. ksCurDomain s \<le> maxDomain)
-            and valid_objs')
+            and valid_objs' and pspace_aligned' and pspace_distinct')
          ({s. target_' s = tcb_ptr_to_ctcb_ptr t}
           \<inter> UNIV) []
      (possibleSwitchTo t )
@@ -2375,8 +2004,8 @@ lemma possibleSwitchTo_ccorres:
 
 lemma scheduleTCB_ccorres':
   "ccorres dc xfdc
-           (tcb_at' thread and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and valid_queues
-                           and valid_objs')
+           (tcb_at' thread and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
+                           and valid_objs' and pspace_aligned' and pspace_distinct')
            (UNIV \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr thread})
            []
   (do (runnable, curThread, action) \<leftarrow> do
@@ -2426,24 +2055,26 @@ lemma scheduleTCB_ccorres':
            apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
                                  cscheduler_action_relation_def)
           apply wp+
-     apply (simp add: isRunnable_def isStopped_def)
-    apply wp
+   apply (simp add: isRunnable_def isStopped_def)
    apply (simp add: guard_is_UNIV_def)
   apply clarsimp
   apply (clarsimp simp: st_tcb_at'_def obj_at'_def weak_sch_act_wf_def)
   done
 
 lemma scheduleTCB_ccorres_valid_queues'_pre:
-        "ccorresG rf_sr \<Gamma> dc xfdc (tcb_at' thread and st_tcb_at' (not runnable') thread and valid_queues' and valid_queues and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and valid_objs')
-         (UNIV \<inter> \<lbrace>\<acute>tptr = tcb_ptr_to_ctcb_ptr thread\<rbrace>) []
-         (do (runnable, curThread, action) \<leftarrow> do
-             runnable \<leftarrow> isRunnable thread;
-             curThread \<leftarrow> getCurThread;
-             action \<leftarrow> getSchedulerAction;
-             return (runnable, curThread, action) od;
-             when (\<not> runnable \<and> curThread = thread \<and> action = ResumeCurrentThread) rescheduleRequired
-          od)
-         (Call scheduleTCB_'proc)"
+  "ccorresG rf_sr \<Gamma> dc xfdc
+     (tcb_at' thread and st_tcb_at' (not runnable') thread
+      and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
+      and valid_objs' and pspace_aligned' and pspace_distinct')
+     \<lbrace>\<acute>tptr = tcb_ptr_to_ctcb_ptr thread\<rbrace> []
+     (do (runnable, curThread, action) \<leftarrow> do runnable \<leftarrow> isRunnable thread;
+                                             curThread \<leftarrow> getCurThread;
+                                             action \<leftarrow> getSchedulerAction;
+                                             return (runnable, curThread, action)
+                                          od;
+         when (\<not> runnable \<and> curThread = thread \<and> action = ResumeCurrentThread) rescheduleRequired
+      od)
+     (Call scheduleTCB_'proc)"
   supply empty_fail_cond[simp]
   apply (cinit' lift: tptr_')
    apply (rule ccorres_rhs_assoc2)+
@@ -2484,17 +2115,17 @@ lemma scheduleTCB_ccorres_valid_queues'_pre:
                            split: scheduler_action.split_asm)
           apply wp+
      apply (simp add: isRunnable_def isStopped_def)
-    apply wp
    apply (simp add: guard_is_UNIV_def)
   apply (clarsimp simp: st_tcb_at'_def obj_at'_def)
   done
 
-
 lemmas scheduleTCB_ccorres_valid_queues'
     = scheduleTCB_ccorres_valid_queues'_pre[unfolded bind_assoc return_bind split_conv]
 
 lemma rescheduleRequired_ccorres_valid_queues'_simple:
-  "ccorresG rf_sr \<Gamma> dc xfdc (valid_queues' and sch_act_simple) UNIV [] rescheduleRequired (Call rescheduleRequired_'proc)"
+  "ccorresG rf_sr \<Gamma> dc xfdc
+     sch_act_simple UNIV []
+     rescheduleRequired (Call rescheduleRequired_'proc)"
   apply cinit
    apply (rule ccorres_symb_exec_l)
       apply (rule ccorres_split_nothrow_novcg[where r'=dc and xf'=xfdc])
@@ -2527,16 +2158,17 @@ lemma rescheduleRequired_ccorres_valid_queues'_simple:
                  split: scheduler_action.split_asm)
 
 lemma scheduleTCB_ccorres_valid_queues'_pre_simple:
-        "ccorresG rf_sr \<Gamma> dc xfdc (tcb_at' thread and st_tcb_at' (not runnable') thread and valid_queues' and sch_act_simple)
-         (UNIV \<inter> \<lbrace>\<acute>tptr = tcb_ptr_to_ctcb_ptr thread\<rbrace>) []
-         (do (runnable, curThread, action) \<leftarrow> do
-             runnable \<leftarrow> isRunnable thread;
-             curThread \<leftarrow> getCurThread;
-             action \<leftarrow> getSchedulerAction;
-             return (runnable, curThread, action) od;
-             when (\<not> runnable \<and> curThread = thread \<and> action = ResumeCurrentThread) rescheduleRequired
-          od)
-         (Call scheduleTCB_'proc)"
+  "ccorresG rf_sr \<Gamma> dc xfdc
+     (tcb_at' thread and st_tcb_at' (not runnable') thread and valid_queues' and sch_act_simple)
+     \<lbrace>\<acute>tptr = tcb_ptr_to_ctcb_ptr thread\<rbrace> []
+     (do (runnable, curThread, action) \<leftarrow> do runnable \<leftarrow> isRunnable thread;
+                                             curThread \<leftarrow> getCurThread;
+                                             action \<leftarrow> getSchedulerAction;
+                                             return (runnable, curThread, action)
+                                          od;
+         when (\<not> runnable \<and> curThread = thread \<and> action = ResumeCurrentThread) rescheduleRequired
+      od)
+     (Call scheduleTCB_'proc)"
   supply empty_fail_cond[simp]
   apply (cinit' lift: tptr_' simp del: word_neq_0_conv)
    apply (rule ccorres_rhs_assoc2)+
@@ -2575,11 +2207,10 @@ lemma scheduleTCB_ccorres_valid_queues'_pre_simple:
            apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
                                  cscheduler_action_relation_def)
           apply wp+
-     apply (simp add: isRunnable_def isStopped_def)
-    apply wp
+   apply (simp add: isRunnable_def isStopped_def)
    apply (simp add: guard_is_UNIV_def)
   apply clarsimp
-  apply (clarsimp simp: st_tcb_at'_def obj_at'_def valid_queues'_def)
+  apply (clarsimp simp: st_tcb_at'_def obj_at'_def)
   done
 
 lemmas scheduleTCB_ccorres_valid_queues'_simple
@@ -2599,48 +2230,35 @@ lemma threadSet_weak_sch_act_wf_runnable':
   apply (clarsimp)
 done
 
-lemma threadSet_valid_queues_and_runnable': "\<lbrace>\<lambda>s. valid_queues s \<and> (\<forall>p. thread \<in> set (ksReadyQueues s p) \<longrightarrow> runnable' st)\<rbrace>
-                 threadSet (tcbState_update (\<lambda>_. st)) thread
-               \<lbrace>\<lambda>rv s. valid_queues s\<rbrace>"
-  apply (wp threadSet_valid_queues)
-  apply (clarsimp simp: inQ_def)
-done
-
 lemma setThreadState_ccorres[corres]:
    "ccorres dc xfdc
-   (\<lambda>s. tcb_at' thread s \<and> valid_queues s \<and> valid_objs' s \<and> valid_tcb_state' st s \<and>
-                 (ksSchedulerAction s = SwitchToThread thread \<longrightarrow> runnable' st) \<and>
-                 (\<forall>p. thread \<in> set (ksReadyQueues s p) \<longrightarrow> runnable' st) \<and>
-                 sch_act_wf (ksSchedulerAction s) s)
-     ({s'. (\<forall>cl fl. cthread_state_relation_lifted st (cl\<lparr>tsType_CL := ts_' s' && mask 4\<rparr>, fl))}
-    \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr thread}) hs
+      (\<lambda>s. tcb_at' thread s \<and> valid_objs' s \<and> valid_tcb_state' st s \<and>
+           pspace_aligned' s \<and> pspace_distinct' s \<and>
+           (ksSchedulerAction s = SwitchToThread thread \<longrightarrow> runnable' st) \<and>
+           sch_act_wf (ksSchedulerAction s) s)
+      ({s'. (\<forall>cl fl. cthread_state_relation_lifted st (cl\<lparr>tsType_CL := ts_' s' && mask 4\<rparr>, fl))}
+       \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr thread}) hs
          (setThreadState st thread) (Call setThreadState_'proc)"
-   apply (cinit lift: tptr_' cong add: call_ignore_cong)
+  apply (cinit lift: tptr_' cong add: call_ignore_cong)
    apply (ctac (no_vcg) add: threadSet_tcbState_simple_corres)
     apply (ctac add: scheduleTCB_ccorres)
-  apply (wp threadSet_weak_sch_act_wf_runnable' threadSet_valid_queues_and_runnable'
-            threadSet_valid_objs')
+   apply (wp threadSet_weak_sch_act_wf_runnable' threadSet_valid_objs')
   by (clarsimp simp: weak_sch_act_wf_def valid_queues_def valid_tcb'_tcbState_update)
 
-lemma threadSet_valid_queues'_and_not_runnable': "\<lbrace>tcb_at' thread and valid_queues' and (\<lambda>s. (\<not> runnable' st))\<rbrace>
-                  threadSet (tcbState_update (\<lambda>_. st)) thread
-               \<lbrace>\<lambda>rv. tcb_at' thread and st_tcb_at' (not runnable') thread and valid_queues' \<rbrace>"
-
-  apply (wp threadSet_valid_queues' threadSet_tcbState_st_tcb_at')
-  apply (clarsimp simp: pred_neg_def valid_queues'_def inQ_def)+
-done
-
 lemma setThreadState_ccorres_valid_queues':
-   "ccorres dc xfdc
-   (\<lambda>s. tcb_at' thread s \<and> valid_queues' s \<and> \<not> runnable' st \<and> weak_sch_act_wf (ksSchedulerAction s) s \<and> Invariants_H.valid_queues s \<and> (\<forall>p. thread \<notin> set (ksReadyQueues s p)) \<and> sch_act_not thread s \<and> valid_objs' s \<and> valid_tcb_state' st s)
+  "ccorres dc xfdc
+     (\<lambda>s. tcb_at' thread s \<and> \<not> runnable' st \<and> weak_sch_act_wf (ksSchedulerAction s) s
+          \<and> sch_act_not thread s \<and> valid_objs' s \<and> valid_tcb_state' st s
+          \<and> pspace_aligned' s \<and> pspace_distinct' s)
      ({s'. (\<forall>cl fl. cthread_state_relation_lifted st (cl\<lparr>tsType_CL := ts_' s' && mask 4\<rparr>, fl))}
-    \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr thread}) []
-         (setThreadState st thread) (Call setThreadState_'proc)"
-   apply (cinit lift: tptr_' cong add: call_ignore_cong)
+      \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr thread}) []
+     (setThreadState st thread) (Call setThreadState_'proc)"
+  apply (cinit lift: tptr_' cong add: call_ignore_cong)
    apply (ctac (no_vcg) add: threadSet_tcbState_simple_corres)
     apply (ctac add: scheduleTCB_ccorres_valid_queues')
-   apply (wp threadSet_valid_queues'_and_not_runnable' threadSet_weak_sch_act_wf_runnable' threadSet_valid_queues_and_runnable' threadSet_valid_objs')
-  by (clarsimp simp: valid_tcb'_def tcb_cte_cases_def)
+   apply (wp threadSet_weak_sch_act_wf_runnable' threadSet_valid_objs'
+             threadSet_tcbState_st_tcb_at')
+  by (clarsimp simp: valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)
 
 lemma simp_list_case_return:
   "(case x of [] \<Rightarrow> return e | y # ys \<Rightarrow> return f) = return (if x = [] then e else f)"
@@ -2661,22 +2279,20 @@ lemma cancelSignal_ccorres [corres]:
    apply (rule ccorres_rhs_assoc2)
    apply (ctac (no_vcg) add: cancelSignal_ccorres_helper)
      apply (ctac add: setThreadState_ccorres_valid_queues')
-    apply ((wp setNotification_nosch setNotification_ksQ hoare_vcg_all_lift set_ntfn_valid_objs' | simp add: valid_tcb_state'_def split del: if_split)+)[1]
+    apply ((wp setNotification_nosch hoare_vcg_all_lift set_ntfn_valid_objs' | simp add: valid_tcb_state'_def split del: if_split)+)[1]
    apply (simp add: ThreadState_defs)
   apply (rule conjI, clarsimp, rule conjI, clarsimp)
     apply (frule (1) ko_at_valid_ntfn'[OF _ invs_valid_objs'])
    subgoal by ((auto simp: obj_at'_def projectKOs st_tcb_at'_def invs'_def valid_state'_def
                      isTS_defs cte_wp_at_ctes_of
                      cthread_state_relation_def sch_act_wf_weak valid_ntfn'_def
-             dest!: valid_queues_not_runnable'_not_ksQ[where t=thread] |
-           clarsimp simp: eq_commute)+)
+               | clarsimp simp: eq_commute)+)
    apply (clarsimp)
    apply (frule (1) ko_at_valid_ntfn'[OF _ invs_valid_objs'])
    apply (frule (2) ntfn_blocked_in_queueD)
    by (auto simp: obj_at'_def projectKOs st_tcb_at'_def invs'_def valid_state'_def
                      isTS_defs cte_wp_at_ctes_of valid_ntfn'_def
                      cthread_state_relation_def sch_act_wf_weak isWaitingNtfn_def
-             dest!: valid_queues_not_runnable'_not_ksQ[where t=thread]
              split: ntfn.splits option.splits
          |  clarsimp simp: eq_commute
          | drule_tac x=thread in bspec)+
@@ -2981,28 +2597,25 @@ lemma cancelIPC_ccorres_helper:
                         cpspace_relation_def update_ep_map_tos typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-       \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            subgoal by (clarsimp simp: comp_def)
-        \<comment> \<open>ep relation\<close>
-           apply (rule cpspace_relation_ep_update_ep, assumption+)
-            subgoal by (simp add: cendpoint_relation_def Let_def EPState_Idle_def)
-           subgoal by simp
-           \<comment> \<open>ntfn relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-          apply simp
-          apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
-           subgoal by simp
-          apply (erule (1) map_to_ko_atI')
-         apply (simp add: heap_to_user_data_def Let_def)
-        \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         subgoal by (clarsimp simp: comp_def)
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           subgoal by (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (rule cpspace_relation_ep_update_ep, assumption+)
+           subgoal by (simp add: cendpoint_relation_def Let_def EPState_Idle_def)
+          subgoal by simp
+         \<comment> \<open>ntfn relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+          subgoal by simp
+         apply (erule (1) map_to_ko_atI')
+        apply (simp add: heap_to_user_data_def Let_def)
         subgoal by (clarsimp simp: carch_state_relation_def carch_globals_def
                                    fpu_null_state_heap_update_tag_disj_simps
                                    global_ioport_bitmap_heap_update_tag_disj_simps
                                    packed_heap_update_collapse_hrs
-                            elim!: fpu_null_state_typ_heap_preservation)
+                             elim!: fpu_null_state_typ_heap_preservation)
        subgoal by (simp add: cmachine_state_relation_def)
       subgoal by (simp add: h_t_valid_clift_Some_iff)
      subgoal by (simp add: objBits_simps')
@@ -3021,53 +2634,56 @@ lemma cancelIPC_ccorres_helper:
                        cpspace_relation_def update_ep_map_tos typ_heap_simps')
       apply (elim conjE)
       apply (intro conjI)
-      \<comment> \<open>tcb relation\<close>
-           apply (erule ctcb_relation_null_queue_ptrs)
-           subgoal by (clarsimp simp: comp_def)
-       \<comment> \<open>ep relation\<close>
-          apply (rule cpspace_relation_ep_update_ep, assumption+)
-           apply (simp add: cendpoint_relation_def Let_def isSendEP_def isRecvEP_def split: endpoint.splits split del: if_split)
+          \<comment> \<open>tcb relation\<close>
+          apply (erule ctcb_relation_null_ep_ptrs)
+          subgoal by (clarsimp simp: comp_def)
+         \<comment> \<open>ep relation\<close>
+         apply (rule cpspace_relation_ep_update_ep, assumption+)
+          apply (simp add: cendpoint_relation_def Let_def isSendEP_def isRecvEP_def
+                      split: endpoint.splits split del: if_split)
            \<comment> \<open>recv case\<close>
-            apply (subgoal_tac "pspace_canonical' \<sigma>")
-             prefer 2
-             apply fastforce
-            apply (clarsimp simp add:  h_t_valid_clift_Some_iff ctcb_offset_defs
-              tcb_queue_relation'_next_mask tcb_queue_relation'_prev_mask
-              tcb_queue_relation'_next_sign tcb_queue_relation'_prev_sign
-              cong: tcb_queue_relation'_cong)
-            subgoal by (intro impI conjI; simp)
-           \<comment> \<open>send case\<close>
-            apply (subgoal_tac "pspace_canonical' \<sigma>")
-             prefer 2
-             apply fastforce
-           apply (clarsimp simp add: h_t_valid_clift_Some_iff ctcb_offset_defs
-             tcb_queue_relation'_next_mask tcb_queue_relation'_prev_mask
-             tcb_queue_relation'_next_sign tcb_queue_relation'_prev_sign
-             cong: tcb_queue_relation'_cong)
+           apply (subgoal_tac "pspace_canonical' \<sigma>")
+            prefer 2
+            apply fastforce
+           apply (clarsimp simp: h_t_valid_clift_Some_iff ctcb_offset_defs
+                                 tcb_queue_relation'_next_mask tcb_queue_relation'_prev_mask
+                                 tcb_queue_relation'_next_sign tcb_queue_relation'_prev_sign
+                           cong: tcb_queue_relation'_cong)
            subgoal by (intro impI conjI; simp)
-          subgoal by simp
-                \<comment> \<open>ntfn relation\<close>
-         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-         apply simp
-         apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
-         apply simp
-         apply (erule (1) map_to_ko_atI')
-         \<comment> \<open>queue relation\<close>
-        apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-        subgoal by (clarsimp simp: comp_def)
+          \<comment> \<open>send case\<close>
+          apply (subgoal_tac "pspace_canonical' \<sigma>")
+           prefer 2
+           apply fastforce
+          apply (clarsimp simp: h_t_valid_clift_Some_iff ctcb_offset_defs
+                                tcb_queue_relation'_next_mask tcb_queue_relation'_prev_mask
+                                tcb_queue_relation'_next_sign tcb_queue_relation'_prev_sign
+                         cong: tcb_queue_relation'_cong)
+          subgoal by (intro impI conjI; simp)
+         \<comment> \<open>send case\<close>
+         apply (subgoal_tac "pspace_canonical' \<sigma>")
+          prefer 2
+          apply fastforce
+         apply (clarsimp simp: h_t_valid_clift_Some_iff ctcb_offset_defs
+                               tcb_queue_relation'_next_mask tcb_queue_relation'_prev_mask
+                               tcb_queue_relation'_next_sign tcb_queue_relation'_prev_sign
+                         cong: tcb_queue_relation'_cong)
+        \<comment> \<open>ntfn relation\<close>
+        apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+        apply simp
+        apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+        apply simp
+        apply (erule (1) map_to_ko_atI')
        subgoal by (clarsimp simp: carch_state_relation_def carch_globals_def
                                   fpu_null_state_heap_update_tag_disj_simps
                                   global_ioport_bitmap_heap_update_tag_disj_simps
                                   packed_heap_update_collapse_hrs
-                           elim!: fpu_null_state_typ_heap_preservation)
+                            elim!: fpu_null_state_typ_heap_preservation)
       subgoal by (simp add: cmachine_state_relation_def)
      subgoal by (simp add: h_t_valid_clift_Some_iff)
     subgoal by (simp add: objBits_simps')
    subgoal by (simp add: objBits_simps)
   by assumption
 
-declare empty_fail_get[iff]
-
 lemma getThreadState_ccorres_foo:
   "(\<And>rv. ccorres r xf (P rv) (P' rv) hs (f rv) c) \<Longrightarrow>
     ccorres r xf (\<lambda>s. \<forall>ts. st_tcb_at' ((=) ts) t s \<longrightarrow> P ts s)
@@ -3271,37 +2887,35 @@ lemma cancelIPC_ccorres1:
      subgoal by (auto simp: obj_at'_def projectKOs pred_tcb_at'_def invs'_def valid_state'_def
                      isTS_defs cte_wp_at_ctes_of
                      cthread_state_relation_def sch_act_wf_weak valid_ep'_def
-             dest!: valid_queues_not_runnable'_not_ksQ[where t=thread] split: thread_state.splits)
+                     split: thread_state.splits)
     apply clarsimp
     apply (frule (2) ep_blocked_in_queueD_recv)
     apply (frule (1) ko_at_valid_ep'[OF _ invs_valid_objs'])
     subgoal by (auto simp: obj_at'_def projectKOs pred_tcb_at'_def invs'_def valid_state'_def
                          isTS_defs cte_wp_at_ctes_of isRecvEP_def
                          cthread_state_relation_def sch_act_wf_weak valid_ep'_def
-                 dest!: valid_queues_not_runnable'_not_ksQ[where t=thread] split: thread_state.splits endpoint.splits)
+                    split: thread_state.splits endpoint.splits)
    apply (rule conjI)
     apply (clarsimp simp: inQ_def)
-   apply (rule conjI)
-    apply clarsimp
    apply clarsimp
    apply (rule conjI)
     subgoal by (auto simp: obj_at'_def projectKOs pred_tcb_at'_def invs'_def valid_state'_def
                          isTS_defs cte_wp_at_ctes_of
                          cthread_state_relation_def sch_act_wf_weak valid_ep'_def
-                 dest!: valid_queues_not_runnable'_not_ksQ[where t=thread] split: thread_state.splits)
+                    split: thread_state.splits)
    apply clarsimp
    apply (rule conjI)
     subgoal by (auto simp: obj_at'_def projectKOs pred_tcb_at'_def invs'_def valid_state'_def
                          isTS_defs cte_wp_at_ctes_of
                          cthread_state_relation_def sch_act_wf_weak valid_ep'_def
-                 dest!: valid_queues_not_runnable'_not_ksQ[where t=thread] split: thread_state.splits)
+                    split: thread_state.splits)
    apply clarsimp
    apply (frule (2) ep_blocked_in_queueD_send)
    apply (frule (1) ko_at_valid_ep'[OF _ invs_valid_objs'])
    subgoal by (auto simp: obj_at'_def projectKOs pred_tcb_at'_def invs'_def valid_state'_def
                         isTS_defs cte_wp_at_ctes_of isSendEP_def
                         cthread_state_relation_def sch_act_wf_weak valid_ep'_def
-                dest!: valid_queues_not_runnable'_not_ksQ[where t=thread] split: thread_state.splits endpoint.splits)[1]
+                   split: thread_state.splits endpoint.splits)[1]
   apply (auto simp: isTS_defs cthread_state_relation_def typ_heap_simps weak_sch_act_wf_def)
   apply (case_tac ts,
            auto simp: isTS_defs cthread_state_relation_def typ_heap_simps)
diff --git a/proof/crefine/X64/Ipc_C.thy b/proof/crefine/X64/Ipc_C.thy
index 95f28b0a2e..5f385378cc 100644
--- a/proof/crefine/X64/Ipc_C.thy
+++ b/proof/crefine/X64/Ipc_C.thy
@@ -27,10 +27,6 @@ lemma replyFromKernel_success_empty:
   unfolding replyFromKernel_def replyFromKernel_success_empty_def
   by (simp add: setMRs_Nil submonad_asUser.fn_stateAssert)
 
-crunch valid_queues[wp]: handleFaultReply valid_queues
-
-crunch valid_queues'[wp]: handleFaultReply valid_queues'
-
 crunch sch_act_wf: handleFaultReply "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
 
 crunch valid_ipc_buffer_ptr' [wp]: copyMRs "valid_ipc_buffer_ptr' p"
@@ -1366,18 +1362,14 @@ lemma getRestartPC_ccorres [corres]:
   done
 
 lemma asUser_tcbFault_obj_at:
-  "\<lbrace>obj_at' (\<lambda>tcb. P (tcbFault tcb)) t\<rbrace> asUser t' m
-   \<lbrace>\<lambda>rv. obj_at' (\<lambda>tcb. P (tcbFault tcb)) t\<rbrace>"
+  "asUser t' m \<lbrace>obj_at' (\<lambda>tcb. P (tcbFault tcb)) t\<rbrace>"
   apply (simp add: asUser_def split_def)
   apply (wp threadGet_wp)
   apply (simp cong: if_cong)
   done
 
 lemma asUser_atcbContext_obj_at:
-  "t \<noteq> t' \<Longrightarrow>
-    \<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>
-      asUser t' m
-    \<lbrace>\<lambda>rv. obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
+  "t \<noteq> t' \<Longrightarrow> asUser t' m \<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
   apply (simp add: asUser_def split_def atcbContextGet_def atcbContextSet_def)
   apply (wp threadGet_wp)
   apply simp
@@ -4185,10 +4177,6 @@ lemma doReplyTransfer_ccorres [corres]:
           \<inter> \<lbrace>\<acute>grant = from_bool grant\<rbrace>)  hs
     (doReplyTransfer sender receiver slot grant)
     (Call doReplyTransfer_'proc)"
-proof -
-  have invs_valid_queues_strg: "\<And>s. invs' s \<longrightarrow> valid_queues s"
-    by clarsimp
-  show ?thesis
   apply (cinit lift: sender_' receiver_' slot_' grant_')
    apply (rule getThreadState_ccorres_foo)
    apply (rule ccorres_assert2)
@@ -4220,7 +4208,7 @@ proof -
         apply (ctac(no_vcg) add: cteDeleteOne_ccorres[where w="scast cap_reply_cap"])
          apply (ctac(no_vcg) add: setThreadState_ccorres)
           apply (ctac(no_vcg) add: possibleSwitchTo_ccorres)
-         apply (wpsimp wp: sts_running_valid_queues setThreadState_st_tcb)+
+         apply (wpsimp wp: sts_valid_objs' setThreadState_st_tcb)+
         apply (wp cteDeleteOne_sch_act_wf)
        apply vcg
       apply (rule conseqPre, vcg)
@@ -4229,8 +4217,7 @@ proof -
      apply wp
      apply (simp add: cap_get_tag_isCap)
      apply (strengthen invs_weak_sch_act_wf_strg
-                       cte_wp_at_imp_consequent'[where P="\<lambda>ct. Ex (ccap_relation (cteCap ct))" for ct]
-                       invs_valid_queues_strg)
+                       cte_wp_at_imp_consequent'[where P="\<lambda>ct. Ex (ccap_relation (cteCap ct))" for ct])
      apply (simp add: cap_reply_cap_def)
      apply (wp doIPCTransfer_reply_or_replyslot)
     apply (clarsimp simp: seL4_Fault_NullFault_def ccorres_cond_iffs
@@ -4265,19 +4252,20 @@ proof -
               apply (ctac (no_vcg))
                apply (simp only: K_bind_def)
                apply (ctac add: possibleSwitchTo_ccorres)
-              apply (wp sts_running_valid_queues setThreadState_st_tcb | simp)+
-             apply (ctac add: setThreadState_ccorres_valid_queues'_simple)
+              apply (wp sts_valid_objs' setThreadState_st_tcb | simp)+
+             apply (ctac add: setThreadState_ccorres_simple)
              apply wp
-            apply ((wp threadSet_valid_queues threadSet_sch_act threadSet_valid_queues' hoare_weak_lift_imp
+            apply ((wp threadSet_sch_act hoare_weak_lift_imp
                        threadSet_valid_objs' threadSet_weak_sch_act_wf
                          | simp add: valid_tcb_state'_def)+)[1]
            apply (clarsimp simp: guard_is_UNIV_def ThreadState_defs mask_def option_to_ctcb_ptr_def)
 
-          apply (rule_tac Q="\<lambda>rv. valid_queues and tcb_at' receiver and valid_queues' and
+          apply (rule_tac Q="\<lambda>rv. tcb_at' receiver and
                                 valid_objs' and sch_act_simple and (\<lambda>s. ksCurDomain s \<le> maxDomain) and
-                                (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)" in hoare_post_imp)
+                                (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and
+                                pspace_aligned' and pspace_distinct'" in hoare_post_imp)
            apply (clarsimp simp: inQ_def weak_sch_act_wf_def)
-          apply (wp threadSet_valid_queues threadSet_sch_act handleFaultReply_sch_act_wf)
+          apply (wp threadSet_sch_act handleFaultReply_sch_act_wf)
          apply (clarsimp simp: guard_is_UNIV_def)
         apply assumption
        apply clarsimp
@@ -4286,7 +4274,7 @@ proof -
        apply (erule(1) cmap_relation_ko_atE [OF cmap_relation_tcb])
        apply (clarsimp simp: ctcb_relation_def typ_heap_simps)
       apply wp
-      apply (strengthen vp_invs_strg' invs_valid_queues')
+      apply (strengthen vp_invs_strg')
       apply (wp cteDeleteOne_tcbFault cteDeleteOne_sch_act_wf)
      apply vcg
     apply (rule conseqPre, vcg)
@@ -4302,7 +4290,6 @@ proof -
                         cap_get_tag_isCap)
   apply fastforce
   done
-qed
 
 lemma ccorres_getCTE_cte_at:
   "ccorresG rf_sr \<Gamma> r xf P P' hs (getCTE p >>= f) c
@@ -4322,7 +4309,7 @@ lemma ccorres_getCTE_cte_at:
   done
 
 lemma setupCallerCap_ccorres [corres]:
-  "ccorres dc xfdc (valid_queues and valid_pspace' and (\<lambda>s. \<forall>d p. sender \<notin> set (ksReadyQueues s (d, p)))
+  "ccorres dc xfdc (valid_pspace'
                     and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and sch_act_not sender
                     and tcb_at' sender and tcb_at' receiver
                     and tcb_at' sender and tcb_at' receiver)
@@ -4454,23 +4441,20 @@ lemma sendIPC_dequeue_ccorres_helper:
                          typ_heap_simps')
         apply (elim conjE)
         apply (intro conjI)
-             \<comment> \<open>tcb relation\<close>
-             apply (erule ctcb_relation_null_queue_ptrs)
-             apply (clarsimp simp: comp_def)
-            \<comment> \<open>ep relation\<close>
-            apply (rule cpspace_relation_ep_update_ep, assumption+)
-             apply (simp add: cendpoint_relation_def Let_def EPState_Idle_def
-                              tcb_queue_relation'_def)
-            apply simp
-           \<comment> \<open>ntfn relation\<close>
-           apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+            \<comment> \<open>tcb relation\<close>
+            apply (erule ctcb_relation_null_ep_ptrs)
+            apply (clarsimp simp: comp_def)
+           \<comment> \<open>ep relation\<close>
+           apply (rule cpspace_relation_ep_update_ep, assumption+)
+            apply (simp add: cendpoint_relation_def Let_def EPState_Idle_def
+                             tcb_queue_relation'_def)
            apply simp
-           apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
-            apply simp
-           apply (erule (1) map_to_ko_atI')
-          \<comment> \<open>queue relation\<close>
-          apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-          apply (clarsimp simp: comp_def)
+          \<comment> \<open>ntfn relation\<close>
+          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+          apply simp
+          apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+           apply simp
+          apply (erule (1) map_to_ko_atI')
          apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs
                                fpu_null_state_heap_update_tag_disj_simps
                                global_ioport_bitmap_heap_update_tag_disj_simps
@@ -4497,30 +4481,27 @@ lemma sendIPC_dequeue_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-             \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (rule cpspace_relation_ep_update_ep, assumption+)
-            apply (clarsimp simp: cendpoint_relation_def Let_def
-                                  isRecvEP_def isSendEP_def
-                                  tcb_queue_relation'_def valid_ep'_def
-                           split: endpoint.splits list.splits
-                       split del: if_split)
-            apply (subgoal_tac "tcb_at' (if x22 = [] then x21 else last x22) \<sigma>")
-             apply (erule (1) tcb_and_not_mask_canonical[OF invs_pspace_canonical'])
-             apply (simp add: objBits_simps')
-            apply (clarsimp split: if_split)
-           apply simp
-          \<comment> \<open>ntfn relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+            \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (rule cpspace_relation_ep_update_ep, assumption+)
+           apply (clarsimp simp: cendpoint_relation_def Let_def
+                                 isRecvEP_def isSendEP_def
+                                 tcb_queue_relation'_def valid_ep'_def
+                          split: endpoint.splits list.splits
+                      split del: if_split)
+           apply (subgoal_tac "tcb_at' (if x22 = [] then x21 else last x22) \<sigma>")
+            apply (erule (1) tcb_and_not_mask_canonical[OF invs_pspace_canonical'])
+            apply (simp add: objBits_simps')
+           apply (clarsimp split: if_split)
           apply simp
-          apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
-           apply simp
-          apply (erule (1) map_to_ko_atI')
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         apply (clarsimp simp: comp_def)
+         \<comment> \<open>ntfn relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+          apply simp
+         apply (erule (1) map_to_ko_atI')
         apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs
                               fpu_null_state_heap_update_tag_disj_simps
                               global_ioport_bitmap_heap_update_tag_disj_simps
@@ -4533,25 +4514,11 @@ lemma sendIPC_dequeue_ccorres_helper:
   apply (clarsimp simp: cendpoint_relation_def Let_def tcb_queue_relation'_def)
   done
 
-(* FIXME RAF: this is the old formulation, the above one does not work as expected *)
-lemma rf_sr_tcb_update_twice:
-  "h_t_valid (hrs_htd (hrs2 (globals s') (t_hrs_' (gs2 (globals s'))))) c_guard
-      (ptr (t_hrs_' (gs2 (globals s'))) (globals s'))
-    \<Longrightarrow> ((s, globals_update (\<lambda>gs. t_hrs_'_update (\<lambda>ths.
-        hrs_mem_update (heap_update (ptr ths gs :: tcb_C ptr) (v ths gs))
-            (hrs_mem_update (heap_update (ptr ths gs) (v' ths gs)) (hrs2 gs ths))) (gs2 gs)) s') \<in> rf_sr)
-    = ((s, globals_update (\<lambda>gs. t_hrs_'_update (\<lambda>ths.
-        hrs_mem_update (heap_update (ptr ths gs) (v ths gs)) (hrs2 gs ths)) (gs2 gs)) s') \<in> rf_sr)"
-  by (simp add: rf_sr_def cstate_relation_def Let_def
-                cpspace_relation_def typ_heap_simps'
-                carch_state_relation_def cmachine_state_relation_def
-                packed_heap_update_collapse_hrs)
-
 lemma sendIPC_block_ccorres_helper:
-  "ccorres dc xfdc (tcb_at' thread and valid_queues and valid_objs' and pspace_canonical' and
+  "ccorres dc xfdc (tcb_at' thread and valid_objs' and pspace_canonical' and
+                    pspace_aligned' and pspace_distinct' and
                     sch_act_not thread and ep_at' epptr and
-                    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s \<and>
-                         (\<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))) and
+                    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and
                     K (bos = ThreadState_BlockedOnSend
                       \<and> epptr' = epptr \<and> badge' = badge
                       \<and> cg = from_bool canGrant \<and> cgr = from_bool canGrantReply
@@ -4610,7 +4577,7 @@ lemma sendIPC_block_ccorres_helper:
        apply ceqv
       apply clarsimp
       apply ctac
-     apply (wp threadSet_weak_sch_act_wf_runnable' threadSet_valid_queues
+     apply (wp threadSet_weak_sch_act_wf_runnable'
                threadSet_valid_objs')
     apply (clarsimp simp: guard_is_UNIV_def)
    apply (clarsimp simp: sch_act_wf_weak valid_tcb'_def valid_tcb_state'_def
@@ -4715,6 +4682,19 @@ lemma tcb_queue_relation_qend_valid':
   apply (simp add: h_t_valid_clift_Some_iff)
   done
 
+lemma tcb_queue'_head_end_NULL:
+  assumes qr: "tcb_queue_relation' getNext getPrev mp queue qhead qend"
+  and   tat: "\<forall>t\<in>set queue. tcb_at' t s"
+  shows "(qend = NULL) = (qhead = NULL)"
+  using qr tat
+  apply -
+  apply (erule tcb_queue_relationE')
+  apply (simp add: tcb_queue_head_empty_iff split: if_splits)
+  apply (rule tcb_at_not_NULL)
+  apply (erule bspec)
+  apply simp
+  done
+
 lemma tcbEPAppend_spec:
   "\<forall>s queue. \<Gamma> \<turnstile> \<lbrace>s. \<exists>t. (t, s) \<in> rf_sr
                       \<and> (\<forall>tcb\<in>set queue. tcb_at' tcb t) \<and> distinct queue
@@ -4840,34 +4820,31 @@ lemma sendIPC_enqueue_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-            \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (rule cpspace_relation_ep_update_ep', assumption+)
-            apply (clarsimp simp: cendpoint_relation_def Let_def
-                                  mask_def [where n=3] EPState_Send_def)
-            apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask)
-            apply (rule conjI, simp add: mask_def)
-            subgoal
-              by (fastforce simp: valid_pspace'_def objBits_simps'
-                          intro!: tcb_and_not_mask_canonical
-                           dest!: st_tcb_strg'[rule_format])
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (rule cpspace_relation_ep_update_ep', assumption+)
+           apply (clarsimp simp: cendpoint_relation_def Let_def
+                                 mask_def [where n=3] EPState_Send_def)
+           apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask)
+           apply (rule conjI, simp add: mask_def)
+           subgoal
+             by (fastforce simp: valid_pspace'_def objBits_simps'
+                         intro!: tcb_and_not_mask_canonical
+                          dest!: st_tcb_strg'[rule_format])
+          apply (simp add: isSendEP_def isRecvEP_def)
+         \<comment> \<open>ntfn relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cnotification_relation_ep_queue, assumption+)
            apply (simp add: isSendEP_def isRecvEP_def)
-          \<comment> \<open>ntfn relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
           apply simp
-          apply (rule cnotification_relation_ep_queue, assumption+)
-            apply (simp add: isSendEP_def isRecvEP_def)
-           apply simp
-          apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
-          apply (erule(2) map_to_ko_at_updI')
-           apply (simp only:projectKOs injectKO_ep objBits_simps)
-           apply clarsimp
-          apply (clarsimp simp: obj_at'_def projectKOs)
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         apply (clarsimp simp: comp_def)
+         apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
+         apply (erule(2) map_to_ko_at_updI')
+          apply (simp only:projectKOs injectKO_ep objBits_simps)
+          apply clarsimp
+         apply (clarsimp simp: obj_at'_def projectKOs)
         apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs
                               global_ioport_bitmap_heap_update_tag_disj_simps
                               fpu_null_state_heap_update_tag_disj_simps
@@ -4887,41 +4864,38 @@ lemma sendIPC_enqueue_ccorres_helper:
                        typ_heap_simps')
       apply (elim conjE)
       apply (intro conjI)
-           \<comment> \<open>tcb relation\<close>
-           apply (erule ctcb_relation_null_queue_ptrs)
-           apply (clarsimp simp: comp_def)
-          \<comment> \<open>ep relation\<close>
-          apply (rule cpspace_relation_ep_update_ep', assumption+)
-           apply (clarsimp simp: cendpoint_relation_def Let_def
-                                 mask_def [where n=3] EPState_Send_def
-                          split: if_split)
-           subgoal
-             apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask
-                                 valid_ep'_def
-                           dest: tcb_queue_relation_next_not_NULL)
-              apply (rule conjI, clarsimp)
-               apply (rule conjI, fastforce simp: mask_def)
-               apply (fastforce simp: valid_pspace'_def objBits_simps'
-                              intro!: tcb_and_not_mask_canonical
-                               dest!: st_tcb_strg'[rule_format])
-              apply (clarsimp, rule conjI, fastforce simp: mask_def)
-              by (fastforce simp: valid_pspace'_def objBits_simps'
-                          intro!: tcb_and_not_mask_canonical
-                           dest!: st_tcb_strg'[rule_format])
+          \<comment> \<open>tcb relation\<close>
+          apply (erule ctcb_relation_null_ep_ptrs)
+          apply (clarsimp simp: comp_def)
+         \<comment> \<open>ep relation\<close>
+         apply (rule cpspace_relation_ep_update_ep', assumption+)
+          apply (clarsimp simp: cendpoint_relation_def Let_def
+                                mask_def [where n=3] EPState_Send_def
+                         split: if_split)
+          subgoal
+            apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask
+                                  valid_ep'_def
+                          dest: tcb_queue_relation_next_not_NULL)
+             apply (rule conjI, clarsimp)
+              apply (rule conjI, fastforce simp: mask_def)
+              apply (fastforce simp: valid_pspace'_def objBits_simps'
+                             intro!: tcb_and_not_mask_canonical
+                              dest!: st_tcb_strg'[rule_format])
+             apply (clarsimp, rule conjI, fastforce simp: mask_def)
+             by (fastforce simp: valid_pspace'_def objBits_simps'
+                         intro!: tcb_and_not_mask_canonical
+                          dest!: st_tcb_strg'[rule_format])
+         apply (simp add: isSendEP_def isRecvEP_def)
+        \<comment> \<open>ntfn relation\<close>
+        apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+        apply simp
+        apply (rule cnotification_relation_ep_queue, assumption+)
           apply (simp add: isSendEP_def isRecvEP_def)
-         \<comment> \<open>ntfn relation\<close>
-         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
          apply simp
-         apply (rule cnotification_relation_ep_queue, assumption+)
-           apply (simp add: isSendEP_def isRecvEP_def)
-          apply simp
-         apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
-         apply (erule(2) map_to_ko_at_updI')
-          apply (clarsimp simp: objBitsKO_def)
-         apply (clarsimp simp: obj_at'_def projectKOs)
-        \<comment> \<open>queue relation\<close>
-        apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-        apply (clarsimp simp: comp_def)
+        apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
+        apply (erule(2) map_to_ko_at_updI')
+         apply (clarsimp simp: objBitsKO_def)
+        apply (clarsimp simp: obj_at'_def projectKOs)
        apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs
                              global_ioport_bitmap_heap_update_tag_disj_simps
                              fpu_null_state_heap_update_tag_disj_simps
@@ -4944,8 +4918,7 @@ lemma ctcb_relation_blockingIPCCanGrantD:
 
 lemma sendIPC_ccorres [corres]:
   "ccorres dc xfdc (invs' and st_tcb_at' simple' thread
-                          and sch_act_not thread and ep_at' epptr and
-                          (\<lambda>s. \<forall>d p. thread \<notin> set (ksReadyQueues s (d, p))))
+                          and sch_act_not thread and ep_at' epptr)
      (UNIV \<inter> \<lbrace>\<acute>blocking = from_bool blocking\<rbrace>
            \<inter> \<lbrace>\<acute>do_call = from_bool do_call\<rbrace>
            \<inter> \<lbrace>\<acute>badge = badge\<rbrace>
@@ -4976,8 +4949,7 @@ lemma sendIPC_ccorres [corres]:
      apply ceqv
     apply (rule_tac A="invs' and st_tcb_at' simple' thread
                           and sch_act_not thread and ko_at' ep epptr
-                          and ep_at' epptr
-                          and (\<lambda>s. \<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))"
+                          and ep_at' epptr"
                  in ccorres_guard_imp2 [where A'=UNIV])
      apply wpc
        \<comment> \<open>RecvEP case\<close>
@@ -5025,12 +4997,11 @@ lemma sendIPC_ccorres [corres]:
               apply (ctac add: setThreadState_ccorres)
              apply (rule ccorres_return_Skip)
             apply (wpsimp wp: hoare_drop_imps hoare_vcg_all_lift possibleSwitchTo_sch_act_not
-                              possibleSwitchTo_sch_act_not sts_st_tcb'
-                              possibleSwitchTo_ksQ' sts_valid_queues sts_ksQ'
+                              possibleSwitchTo_sch_act_not sts_st_tcb' sts_valid_objs'
                           simp: valid_tcb_state'_def)+
           apply vcg
-         apply (wpsimp wp: doIPCTransfer_sch_act setEndpoint_ksQ hoare_vcg_all_lift
-                          set_ep_valid_objs' setEndpoint_valid_mdb'
+         apply (wpsimp wp: doIPCTransfer_sch_act hoare_vcg_all_lift
+                           set_ep_valid_objs' setEndpoint_valid_mdb'
                 | wp (once) hoare_drop_imp
                 | strengthen sch_act_wf_weak)+
        apply (fastforce simp: guard_is_UNIV_def ThreadState_defs Collect_const_mem mask_def
@@ -5151,10 +5122,10 @@ lemma ctcb_relation_blockingIPCCanGrantReplyD:
   done
 
 lemma receiveIPC_block_ccorres_helper:
-  "ccorres dc xfdc (tcb_at' thread and valid_queues and valid_objs' and pspace_canonical' and
+  "ccorres dc xfdc (tcb_at' thread and valid_objs' and pspace_canonical' and
+                    pspace_aligned' and pspace_distinct' and
                     sch_act_not thread and ep_at' epptr and
-                    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s \<and>
-                     (\<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))) and
+                    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and
                     K (epptr = epptr && ~~ mask 4) and
                     K (isEndpointCap cap \<and> ccap_relation cap cap'))
                    UNIV hs
@@ -5194,7 +5165,7 @@ lemma receiveIPC_block_ccorres_helper:
        apply ceqv
       apply clarsimp
       apply ctac
-     apply (wp threadSet_valid_queues hoare_vcg_all_lift threadSet_valid_objs'
+     apply (wp hoare_vcg_all_lift threadSet_valid_objs'
                threadSet_weak_sch_act_wf_runnable')
     apply (clarsimp simp: guard_is_UNIV_def)
    apply (clarsimp simp: sch_act_wf_weak valid_tcb'_def valid_tcb_state'_def
@@ -5260,41 +5231,38 @@ lemma receiveIPC_enqueue_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-             \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (rule cpspace_relation_ep_update_ep', assumption+)
-            apply (clarsimp simp: cendpoint_relation_def Let_def
-                                  mask_def [where n=3] EPState_Recv_def
-                           split: if_split)
-            subgoal
-              apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask
-                                  valid_ep'_def
-                            dest: tcb_queue_relation_next_not_NULL)
-              apply (rule conjI, clarsimp)
-               apply (rule conjI, fastforce simp: mask_def)
-               apply (fastforce simp: valid_pspace'_def objBits_simps'
-                              intro!: tcb_and_not_mask_canonical
-                               dest!: st_tcb_strg'[rule_format])
-              apply (clarsimp, rule conjI, fastforce simp: mask_def)
-              by (fastforce simp: valid_pspace'_def objBits_simps'
-                          intro!: tcb_and_not_mask_canonical
-                           dest!: st_tcb_strg'[rule_format])
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (rule cpspace_relation_ep_update_ep', assumption+)
+           apply (clarsimp simp: cendpoint_relation_def Let_def
+                                 mask_def [where n=3] EPState_Recv_def
+                          split: if_split)
+           subgoal
+             apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask
+                                   valid_ep'_def
+                             dest: tcb_queue_relation_next_not_NULL)
+             apply (rule conjI, clarsimp)
+              apply (rule conjI, fastforce simp: mask_def)
+              apply (fastforce simp: valid_pspace'_def objBits_simps'
+                             intro!: tcb_and_not_mask_canonical
+                              dest!: st_tcb_strg'[rule_format])
+             apply (clarsimp, rule conjI, fastforce simp: mask_def)
+             by (fastforce simp: valid_pspace'_def objBits_simps'
+                         intro!: tcb_and_not_mask_canonical
+                          dest!: st_tcb_strg'[rule_format])
+          apply (simp add: isSendEP_def isRecvEP_def)
+         \<comment> \<open>ntfn relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cnotification_relation_ep_queue, assumption+)
            apply (simp add: isSendEP_def isRecvEP_def)
-          \<comment> \<open>ntfn relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
           apply simp
-          apply (rule cnotification_relation_ep_queue, assumption+)
-            apply (simp add: isSendEP_def isRecvEP_def)
-           apply simp
-          apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
-          apply (erule(2) map_to_ko_at_updI')
-           apply (clarsimp simp: objBitsKO_def)
-          apply (clarsimp simp: obj_at'_def projectKOs)
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         apply (clarsimp simp: comp_def)
+         apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
+         apply (erule(2) map_to_ko_at_updI')
+          apply (clarsimp simp: objBitsKO_def)
+         apply (clarsimp simp: obj_at'_def projectKOs)
         apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs
                               global_ioport_bitmap_heap_update_tag_disj_simps
                               fpu_null_state_heap_update_tag_disj_simps
@@ -5314,33 +5282,30 @@ lemma receiveIPC_enqueue_ccorres_helper:
                        typ_heap_simps')
       apply (elim conjE)
       apply (intro conjI)
-           \<comment> \<open>tcb relation\<close>
-           apply (erule ctcb_relation_null_queue_ptrs)
-           apply (clarsimp simp: comp_def)
-          \<comment> \<open>ep relation\<close>
-          apply (rule cpspace_relation_ep_update_ep', assumption+)
-           apply (clarsimp simp: cendpoint_relation_def Let_def
-                                 mask_def [where n=3] EPState_Recv_def)
-           apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask)
-           subgoal
-             apply (rule conjI, fastforce simp: mask_def)
-             by (fastforce simp: valid_pspace'_def objBits_simps'
-                              intro!: tcb_and_not_mask_canonical
-                               dest!: st_tcb_strg'[rule_format])
+          \<comment> \<open>tcb relation\<close>
+          apply (erule ctcb_relation_null_ep_ptrs)
+          apply (clarsimp simp: comp_def)
+         \<comment> \<open>ep relation\<close>
+         apply (rule cpspace_relation_ep_update_ep', assumption+)
+          apply (clarsimp simp: cendpoint_relation_def Let_def
+                                mask_def [where n=3] EPState_Recv_def)
+          apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask)
+          subgoal
+            apply (rule conjI, fastforce simp: mask_def)
+            by (fastforce simp: valid_pspace'_def objBits_simps'
+                             intro!: tcb_and_not_mask_canonical
+                              dest!: st_tcb_strg'[rule_format])
+         apply (simp add: isSendEP_def isRecvEP_def)
+        \<comment> \<open>ntfn relation\<close>
+        apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+        apply simp
+        apply (rule cnotification_relation_ep_queue, assumption+)
           apply (simp add: isSendEP_def isRecvEP_def)
-         \<comment> \<open>ntfn relation\<close>
-         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
          apply simp
-         apply (rule cnotification_relation_ep_queue, assumption+)
-           apply (simp add: isSendEP_def isRecvEP_def)
-          apply simp
-         apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
-         apply (erule(2) map_to_ko_at_updI')
-          apply (clarsimp simp: objBitsKO_def)
-         apply (clarsimp simp: obj_at'_def projectKOs)
-        \<comment> \<open>queue relation\<close>
-        apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-        apply (clarsimp simp: comp_def)
+        apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
+        apply (erule(2) map_to_ko_at_updI')
+         apply (clarsimp simp: objBitsKO_def)
+        apply (clarsimp simp: obj_at'_def projectKOs)
        apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs
                              global_ioport_bitmap_heap_update_tag_disj_simps
                              fpu_null_state_heap_update_tag_disj_simps
@@ -5412,24 +5377,21 @@ lemma receiveIPC_dequeue_ccorres_helper:
                          typ_heap_simps')
         apply (elim conjE)
         apply (intro conjI)
-             \<comment> \<open>tcb relation\<close>
-             apply (erule ctcb_relation_null_queue_ptrs)
-             apply (clarsimp simp: comp_def)
-            \<comment> \<open>ep relation\<close>
-            apply (rule cpspace_relation_ep_update_ep, assumption+)
-             apply (simp add: cendpoint_relation_def Let_def EPState_Idle_def
-                              tcb_queue_relation'_def)
-            apply simp
-           \<comment> \<open>ntfn relation\<close>
-           apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-           apply simp
-           apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+            \<comment> \<open>tcb relation\<close>
+            apply (erule ctcb_relation_null_ep_ptrs)
+            apply (clarsimp simp: comp_def)
+           \<comment> \<open>ep relation\<close>
+           apply (rule cpspace_relation_ep_update_ep, assumption+)
+            apply (simp add: cendpoint_relation_def Let_def EPState_Idle_def
+                             tcb_queue_relation'_def)
            apply simp
-          apply (erule (1) map_to_ko_atI')
-          \<comment> \<open>queue relation\<close>
-          apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-          apply (clarsimp simp: comp_def)
-         apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs
+          \<comment> \<open>ntfn relation\<close>
+          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+          apply simp
+          apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+          apply simp
+         apply (erule (1) map_to_ko_atI')
+        apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs
                                global_ioport_bitmap_heap_update_tag_disj_simps
                                fpu_null_state_heap_update_tag_disj_simps
                         elim!: fpu_null_state_typ_heap_preservation)
@@ -5455,30 +5417,27 @@ lemma receiveIPC_dequeue_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-            \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (rule cpspace_relation_ep_update_ep, assumption+)
-            apply (clarsimp simp: cendpoint_relation_def Let_def
-                                  isRecvEP_def isSendEP_def
-                                  tcb_queue_relation'_def valid_ep'_def
-                           split: endpoint.splits list.splits
-                       split del: if_split)
-            apply (subgoal_tac "tcb_at' (if x22 = [] then x21 else last x22) \<sigma>")
-             apply (erule (1) tcb_and_not_mask_canonical[OF invs_pspace_canonical'])
-             apply (clarsimp simp: objBits_simps')
-            apply (clarsimp split: if_split)
-           apply simp
-          \<comment> \<open>ntfn relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (rule cpspace_relation_ep_update_ep, assumption+)
+           apply (clarsimp simp: cendpoint_relation_def Let_def
+                                 isRecvEP_def isSendEP_def
+                                 tcb_queue_relation'_def valid_ep'_def
+                          split: endpoint.splits list.splits
+                      split del: if_split)
+           apply (subgoal_tac "tcb_at' (if x22 = [] then x21 else last x22) \<sigma>")
+            apply (erule (1) tcb_and_not_mask_canonical[OF invs_pspace_canonical'])
+            apply (clarsimp simp: objBits_simps')
+           apply (clarsimp split: if_split)
           apply simp
-          apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
-           apply simp
-          apply (erule (1) map_to_ko_atI')
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         apply (clarsimp simp: comp_def)
+         \<comment> \<open>ntfn relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cnotification_relation_ep_queue [OF invs_sym'], assumption+)
+          apply simp
+         apply (erule (1) map_to_ko_atI')
         apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs
                               global_ioport_bitmap_heap_update_tag_disj_simps
                               fpu_null_state_heap_update_tag_disj_simps
@@ -5600,7 +5559,6 @@ lemma receiveIPC_ccorres [corres]:
   notes option.case_cong_weak [cong]
   shows
   "ccorres dc xfdc (invs' and st_tcb_at' simple' thread and sch_act_not thread
-                          and (\<lambda>s. \<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))
                           and valid_cap' cap and K (isEndpointCap cap))
      (UNIV \<inter> \<lbrace>\<acute>thread = tcb_ptr_to_ctcb_ptr thread\<rbrace>
            \<inter> \<lbrace>ccap_relation cap \<acute>cap\<rbrace>
@@ -5676,7 +5634,6 @@ lemma receiveIPC_ccorres [corres]:
           apply ceqv
          apply (rule_tac A="invs' and st_tcb_at' simple' thread
                                   and sch_act_not thread
-                              and (\<lambda>s. \<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))
                                   and ko_at' ep (capEPPtr cap)"
                      in ccorres_guard_imp2 [where A'=UNIV])
            apply wpc
@@ -5816,27 +5773,25 @@ lemma receiveIPC_ccorres [corres]:
                  apply ccorres_rewrite
                  apply ctac
                    apply (ctac add: possibleSwitchTo_ccorres)
-                  apply (wpsimp wp: sts_st_tcb' sts_valid_queues)
+                  apply (wpsimp wp: sts_st_tcb' sts_valid_objs')
                  apply (vcg exspec=setThreadState_modifies)
                 apply (fastforce simp: guard_is_UNIV_def ThreadState_defs mask_def
                                        cap_get_tag_isCap ccap_relation_ep_helpers)
                apply (clarsimp simp: valid_tcb_state'_def)
-               apply (rule_tac Q="\<lambda>_. valid_pspace' and valid_queues
+               apply (rule_tac Q="\<lambda>_. valid_pspace'
                                        and st_tcb_at' ((=) sendState) sender and tcb_at' thread
                                        and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)
-                                       and (\<lambda>s. (\<forall>a b. sender \<notin> set (ksReadyQueues s (a, b))))
                                        and sch_act_not sender and K (thread \<noteq> sender)
                                        and (\<lambda>s. ksCurDomain s \<le> maxDomain)" in hoare_post_imp)
-                apply (clarsimp simp: valid_pspace_valid_objs' pred_tcb_at'_def sch_act_wf_weak
-                                      obj_at'_def)
+                apply (fastforce simp: valid_pspace_valid_objs' pred_tcb_at'_def sch_act_wf_weak
+                                       obj_at'_def)
                apply (wpsimp simp: guard_is_UNIV_def option_to_ptr_def option_to_0_def conj_ac)+
-           apply (rule_tac Q="\<lambda>rv. valid_queues and valid_pspace'
+           apply (rule_tac Q="\<lambda>rv. valid_pspace'
                                and cur_tcb' and tcb_at' sender and tcb_at' thread
                                and sch_act_not sender and K (thread \<noteq> sender)
                                and ep_at' (capEPPtr cap)
                                and (\<lambda>s. ksCurDomain s \<le> maxDomain)
-                               and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s \<and>
-                                        (\<forall>d p. sender \<notin> set (ksReadyQueues s (d, p))))"
+                               and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)"
                             in hoare_post_imp)
             subgoal by (auto, auto simp: st_tcb_at'_def obj_at'_def)
            apply (wp hoare_vcg_all_lift set_ep_valid_objs')
@@ -5872,14 +5827,11 @@ lemma receiveIPC_ccorres [corres]:
                                  split: if_split_asm bool.splits) (*very long *)
            apply (clarsimp simp: obj_at'_def state_refs_of'_def projectKOs)
           apply (frule(1) sym_refs_ko_atD' [OF _ invs_sym'])
-          apply (frule invs_queues)
           apply clarsimp
           apply (rename_tac list x xa)
           apply (rule_tac P="x\<in>set list" in case_split)
            apply (clarsimp simp:st_tcb_at_refs_of_rev')
            apply (erule_tac x=x and P="\<lambda>x. st_tcb_at' P x s" for P in ballE)
-            apply (drule_tac t=x in valid_queues_not_runnable'_not_ksQ)
-             apply (clarsimp simp: st_tcb_at'_def obj_at'_def)
             apply (subgoal_tac "sch_act_not x s")
              prefer 2
              apply (frule invs_sch_act_wf')
@@ -5957,23 +5909,20 @@ lemma sendSignal_dequeue_ccorres_helper:
                          typ_heap_simps')
         apply (elim conjE)
         apply (intro conjI)
-             \<comment> \<open>tcb relation\<close>
-             apply (erule ctcb_relation_null_queue_ptrs)
-             apply (clarsimp simp: comp_def)
-            \<comment> \<open>ep relation\<close>
-            apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-            apply simp
-            apply (rule cendpoint_relation_ntfn_queue [OF invs_sym'], assumption+)
-             apply simp+
-            apply (erule (1) map_to_ko_atI')
-           \<comment> \<open>ntfn relation\<close>
-           apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
-            apply (simp add: cnotification_relation_def Let_def NtfnState_Idle_def
-                             tcb_queue_relation'_def)
+            \<comment> \<open>tcb relation\<close>
+            apply (erule ctcb_relation_null_ep_ptrs)
+            apply (clarsimp simp: comp_def)
+           \<comment> \<open>ep relation\<close>
+           apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
            apply simp
-          \<comment> \<open>queue relation\<close>
-          apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-          apply (clarsimp simp: comp_def)
+           apply (rule cendpoint_relation_ntfn_queue [OF invs_sym'], assumption+)
+            apply simp+
+           apply (erule (1) map_to_ko_atI')
+          \<comment> \<open>ntfn relation\<close>
+          apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
+           apply (simp add: cnotification_relation_def Let_def NtfnState_Idle_def
+                            tcb_queue_relation'_def)
+          apply simp
          apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs
                                global_ioport_bitmap_heap_update_tag_disj_simps
                                fpu_null_state_heap_update_tag_disj_simps
@@ -6002,33 +5951,30 @@ lemma sendSignal_dequeue_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-            \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
-           apply simp
-           apply (rule cendpoint_relation_ntfn_queue [OF invs_sym'], assumption+)
-            apply simp+
-           apply (erule (1) map_to_ko_atI')
-          \<comment> \<open>ntfn relation\<close>
-          apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
-           apply (clarsimp simp: cnotification_relation_def Let_def
-                                 isWaitingNtfn_def
-                                 tcb_queue_relation'_def valid_ntfn'_def
-                          split: Structures_H.notification.splits list.splits
-                      split del: if_split)
-           apply (subgoal_tac "tcb_at' (if x22 = [] then x21 else last x22) \<sigma>")
-            apply (rule conjI)
-             subgoal by (erule (1) tcb_ptr_sign_extend_canonical[OF invs_pspace_canonical'])
-            apply (rule context_conjI)
-             subgoal by (erule (1) tcb_ptr_sign_extend_canonical[OF invs_pspace_canonical'])
-            apply clarsimp
-           apply (clarsimp split: if_split)
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
           apply simp
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         apply (clarsimp simp: comp_def)
+          apply (rule cendpoint_relation_ntfn_queue [OF invs_sym'], assumption+)
+           apply simp+
+          apply (erule (1) map_to_ko_atI')
+         \<comment> \<open>ntfn relation\<close>
+         apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
+          apply (clarsimp simp: cnotification_relation_def Let_def
+                                isWaitingNtfn_def
+                                tcb_queue_relation'_def valid_ntfn'_def
+                         split: Structures_H.notification.splits list.splits
+                     split del: if_split)
+          apply (subgoal_tac "tcb_at' (if x22 = [] then x21 else last x22) \<sigma>")
+           apply (rule conjI)
+            subgoal by (erule (1) tcb_ptr_sign_extend_canonical[OF invs_pspace_canonical'])
+           apply (rule context_conjI)
+            subgoal by (erule (1) tcb_ptr_sign_extend_canonical[OF invs_pspace_canonical'])
+           apply clarsimp
+          apply (clarsimp split: if_split)
+         apply simp
         apply (clarsimp simp: carch_state_relation_def
                               global_ioport_bitmap_heap_update_tag_disj_simps
                               fpu_null_state_heap_update_tag_disj_simps
@@ -6139,7 +6085,7 @@ lemma sendSignal_ccorres [corres]:
          apply (ctac(no_vcg) add: setThreadState_ccorres)
           apply (ctac(no_vcg) add: setRegister_ccorres)
            apply (ctac add: possibleSwitchTo_ccorres)
-          apply (wp sts_running_valid_queues sts_st_tcb_at'_cases
+          apply (wp sts_valid_objs' sts_st_tcb_at'_cases
                  | simp add: option_to_ctcb_ptr_def split del: if_split)+
         apply (rule_tac Q="\<lambda>_. tcb_at' (the (ntfnBoundTCB ntfn)) and invs'"
                  in hoare_post_imp)
@@ -6207,10 +6153,8 @@ lemma sendSignal_ccorres [corres]:
        apply (ctac (no_vcg))
         apply (ctac add: possibleSwitchTo_ccorres)
        apply (simp)
-       apply (wp weak_sch_act_wf_lift_linear
-         setThreadState_oa_queued
-         sts_valid_queues tcb_in_cur_domain'_lift)[1]
-      apply (wp sts_valid_queues sts_runnable)
+       apply (wp weak_sch_act_wf_lift_linear tcb_in_cur_domain'_lift)[1]
+      apply (wp sts_valid_objs' sts_runnable)
      apply (wp setThreadState_st_tcb set_ntfn_valid_objs' | clarsimp)+
     apply (clarsimp simp: guard_is_UNIV_def ThreadState_defs mask_def
                           badgeRegister_def Kernel_C.badgeRegister_def
@@ -6235,10 +6179,10 @@ lemma sendSignal_ccorres [corres]:
   done
 
 lemma receiveSignal_block_ccorres_helper:
-  "ccorres dc xfdc (tcb_at' thread and valid_queues and sch_act_not thread and
+  "ccorres dc xfdc (tcb_at' thread and sch_act_not thread and
                     valid_objs' and ntfn_at' ntfnptr and pspace_canonical' and
-                    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s \<and>
-                        (\<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))) and
+                    pspace_aligned' and pspace_distinct' and
+                    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and
                     K (ntfnptr = ntfnptr && ~~ mask 4))
                    UNIV hs
            (setThreadState (Structures_H.thread_state.BlockedOnNotification
@@ -6273,7 +6217,7 @@ lemma receiveSignal_block_ccorres_helper:
        apply ceqv
       apply clarsimp
       apply ctac
-     apply (wp threadSet_valid_queues hoare_vcg_all_lift threadSet_valid_objs'
+     apply (wp hoare_vcg_all_lift threadSet_valid_objs'
                threadSet_weak_sch_act_wf_runnable')
     apply (clarsimp simp: guard_is_UNIV_def)
    apply (auto simp: weak_sch_act_wf_def valid_tcb'_def tcb_cte_cases_def
@@ -6392,37 +6336,34 @@ lemma receiveSignal_enqueue_ccorres_helper:
                         typ_heap_simps')
        apply (elim conjE)
        apply (intro conjI)
-            \<comment> \<open>tcb relation\<close>
-            apply (erule ctcb_relation_null_queue_ptrs)
-            apply (clarsimp simp: comp_def)
-           \<comment> \<open>ep relation\<close>
-           apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+           \<comment> \<open>tcb relation\<close>
+           apply (erule ctcb_relation_null_ep_ptrs)
+           apply (clarsimp simp: comp_def)
+          \<comment> \<open>ep relation\<close>
+          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+          apply simp
+          apply (rule cendpoint_relation_ntfn_queue, assumption+)
+            apply (simp add: isWaitingNtfn_def)
            apply simp
-           apply (rule cendpoint_relation_ntfn_queue, assumption+)
-             apply (simp add: isWaitingNtfn_def)
-            apply simp
-           apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
-           apply (erule(2) map_to_ko_at_updI')
-            apply (clarsimp simp: objBitsKO_def)
-           apply (clarsimp simp: obj_at'_def projectKOs)
-          \<comment> \<open>ntfn relation\<close>
-          apply (rule cpspace_relation_ntfn_update_ntfn', assumption+)
-            apply (case_tac "ntfn", simp_all)[1]
-           apply (clarsimp simp: cnotification_relation_def Let_def
-                                 mask_def [where n=3] NtfnState_Waiting_def)
-           subgoal
-             apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask                                valid_ntfn'_def
-                                   dest: tcb_queue_relation_next_not_NULL)
-             apply (rule conjI, fastforce simp: mask_def)
-             apply (rule context_conjI)
-              subgoal by (fastforce simp: valid_pspace'_def objBits_simps'
-                              intro!: tcb_ptr_sign_extend_canonical
-                               dest!: st_tcb_strg'[rule_format])
-             by clarsimp
-          apply (simp add: isWaitingNtfn_def)
-         \<comment> \<open>queue relation\<close>
-         apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-         subgoal by (clarsimp simp: comp_def)
+          apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
+          apply (erule(2) map_to_ko_at_updI')
+           apply (clarsimp simp: objBitsKO_def)
+          apply (clarsimp simp: obj_at'_def projectKOs)
+         \<comment> \<open>ntfn relation\<close>
+         apply (rule cpspace_relation_ntfn_update_ntfn', assumption+)
+           apply (case_tac "ntfn", simp_all)[1]
+          apply (clarsimp simp: cnotification_relation_def Let_def
+                                mask_def [where n=3] NtfnState_Waiting_def)
+          subgoal
+            apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask                                valid_ntfn'_def
+                                  dest: tcb_queue_relation_next_not_NULL)
+            apply (rule conjI, fastforce simp: mask_def)
+            apply (rule context_conjI)
+             subgoal by (fastforce simp: valid_pspace'_def objBits_simps'
+                             intro!: tcb_ptr_sign_extend_canonical
+                              dest!: st_tcb_strg'[rule_format])
+            by clarsimp
+         apply (simp add: isWaitingNtfn_def)
         apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs
                               global_ioport_bitmap_heap_update_tag_disj_simps
                               fpu_null_state_heap_update_tag_disj_simps
@@ -6442,48 +6383,45 @@ lemma receiveSignal_enqueue_ccorres_helper:
                        typ_heap_simps')
       apply (elim conjE)
       apply (intro conjI)
-           \<comment> \<open>tcb relation\<close>
-           apply (erule ctcb_relation_null_queue_ptrs)
-           apply (clarsimp simp: comp_def)
-          \<comment> \<open>ep relation\<close>
-          apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+          \<comment> \<open>tcb relation\<close>
+          apply (erule ctcb_relation_null_ep_ptrs)
+          apply (clarsimp simp: comp_def)
+         \<comment> \<open>ep relation\<close>
+         apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
+         apply simp
+         apply (rule cendpoint_relation_ntfn_queue, assumption+)
+           apply (simp add: isWaitingNtfn_def)
           apply simp
-          apply (rule cendpoint_relation_ntfn_queue, assumption+)
-            apply (simp add: isWaitingNtfn_def)
-           apply simp
-          apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
-          apply (erule(2) map_to_ko_at_updI')
-           apply (clarsimp simp: objBitsKO_def)
-          apply (clarsimp simp: obj_at'_def projectKOs)
-         \<comment> \<open>ntfn relation\<close>
-         apply (rule cpspace_relation_ntfn_update_ntfn', assumption+)
-           apply (case_tac "ntfn", simp_all)[1]
-          apply (clarsimp simp: cnotification_relation_def Let_def
-                                mask_def [where n=3] NtfnState_Waiting_def
-                         split: if_split)
-          subgoal for _ _ ko'
-            apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask
-                            dest: tcb_queue_relation_next_not_NULL)
-            apply (rule conjI, clarsimp)
-             apply (rule conjI, fastforce simp: mask_def)
-             apply (rule context_conjI)
-              subgoal by (fastforce intro!: tcb_ptr_sign_extend_canonical
-                                     dest!: st_tcb_strg'[rule_format])
-             apply clarsimp
-            apply clarsimp
+         apply (frule_tac x=p in map_to_ko_atI, clarsimp, clarsimp)
+         apply (erule(2) map_to_ko_at_updI')
+          apply (clarsimp simp: objBitsKO_def)
+         apply (clarsimp simp: obj_at'_def projectKOs)
+        \<comment> \<open>ntfn relation\<close>
+        apply (rule cpspace_relation_ntfn_update_ntfn', assumption+)
+          apply (case_tac "ntfn", simp_all)[1]
+         apply (clarsimp simp: cnotification_relation_def Let_def
+                               mask_def [where n=3] NtfnState_Waiting_def
+                        split: if_split)
+         subgoal for _ _ ko'
+           apply (clarsimp simp: tcb_queue_relation'_def is_aligned_neg_mask
+                           dest: tcb_queue_relation_next_not_NULL)
+           apply (rule conjI, clarsimp)
             apply (rule conjI, fastforce simp: mask_def)
-            apply (rule conjI)
+            apply (rule context_conjI)
              subgoal by (fastforce intro!: tcb_ptr_sign_extend_canonical
                                     dest!: st_tcb_strg'[rule_format])
-            apply (subgoal_tac "canonical_address (ntfnQueue_head_CL (notification_lift ko'))")
-             apply (clarsimp simp: canonical_address_sign_extended sign_extended_iff_sign_extend)
-            apply (clarsimp simp: notification_lift_def canonical_address_sign_extended
-                                  sign_extended_sign_extend)
-            done
-         apply (simp add: isWaitingNtfn_def)
-        \<comment> \<open>queue relation\<close>
-        apply (rule cready_queues_relation_null_queue_ptrs, assumption+)
-        apply (clarsimp simp: comp_def)
+            apply clarsimp
+           apply clarsimp
+           apply (rule conjI, fastforce simp: mask_def)
+           apply (rule conjI)
+            subgoal by (fastforce intro!: tcb_ptr_sign_extend_canonical
+                                   dest!: st_tcb_strg'[rule_format])
+           apply (subgoal_tac "canonical_address (ntfnQueue_head_CL (notification_lift ko'))")
+            apply (clarsimp simp: canonical_address_sign_extended sign_extended_iff_sign_extend)
+           apply (clarsimp simp: notification_lift_def canonical_address_sign_extended
+                                 sign_extended_sign_extend)
+           done
+        apply (simp add: isWaitingNtfn_def)
        apply (clarsimp simp: carch_state_relation_def packed_heap_update_collapse_hrs
                              global_ioport_bitmap_heap_update_tag_disj_simps
                              fpu_null_state_heap_update_tag_disj_simps
@@ -6498,7 +6436,6 @@ lemma receiveSignal_enqueue_ccorres_helper:
 lemma receiveSignal_ccorres [corres]:
   "ccorres dc xfdc (invs' and valid_cap' cap and st_tcb_at' simple' thread
                     and sch_act_not thread
-                    and (\<lambda>s. \<forall>d p. thread \<notin> set (ksReadyQueues s (d, p)))
                     and K (isNotificationCap cap))
      (UNIV \<inter> \<lbrace>\<acute>thread = tcb_ptr_to_ctcb_ptr thread\<rbrace>
            \<inter> \<lbrace>ccap_relation cap \<acute>cap\<rbrace>
diff --git a/proof/crefine/X64/IsolatedThreadAction.thy b/proof/crefine/X64/IsolatedThreadAction.thy
index 737a6b0999..f11e35e610 100644
--- a/proof/crefine/X64/IsolatedThreadAction.thy
+++ b/proof/crefine/X64/IsolatedThreadAction.thy
@@ -67,12 +67,12 @@ lemma put_tcb_state_regs_twice[simp]:
   "put_tcb_state_regs tsr (put_tcb_state_regs tsr' tcb)
     = put_tcb_state_regs tsr tcb"
   apply (simp add: put_tcb_state_regs_def put_tcb_state_regs_tcb_def
-                   atcbContextSet_def
-                   makeObject_tcb newArchTCB_def newContext_def initContext_def
+                   makeObject_tcb newArchTCB_def atcbContextSet_def
             split: tcb_state_regs.split option.split
                    Structures_H.kernel_object.split)
   apply (intro all_tcbI impI allI)
-  apply (case_tac q, simp)
+   using atcbContextSet_def atcbContext_set_set
+   apply fastforce+
   done
 
 lemma partial_overwrite_twice[simp]:
@@ -379,7 +379,7 @@ lemma obj_at_partial_overwrite_id2:
 
 lemma objBits_2n:
   "(1 :: machine_word) < 2 ^ objBits obj"
-  by (simp add: objBits_def objBitsKO_def archObjSize_def pageBits_def objBits_simps'
+  by (simp add: archObjSize_def pageBits_def objBits_simps'
          split: kernel_object.split arch_kernel_object.split)
 
 lemma getObject_get_assert:
@@ -923,9 +923,11 @@ lemma oblivious_switchToThread_schact:
                    threadSet_def tcbSchedEnqueue_def unless_when asUser_def
                    getQueue_def setQueue_def storeWordUser_def setRegister_def
                    pointerInUserData_def isRunnable_def isStopped_def
-                   getThreadState_def tcbSchedDequeue_def bitmap_fun_defs)
+                   getThreadState_def tcbSchedDequeue_def tcbQueueRemove_def bitmap_fun_defs
+                   ksReadyQueues_asrt_def)
   by (safe intro!: oblivious_bind
-              | simp_all add: oblivious_setVMRoot_schact)+
+              | simp_all add: ready_qs_runnable_def idleThreadNotQueued_def
+                              oblivious_setVMRoot_schact)+
 
 (* FIXME move *)
 lemma empty_fail_getCurThread[intro!, wp, simp]:
@@ -945,29 +947,9 @@ lemma activateThread_simple_rewrite:
 
 end
 
-lemma setCTE_obj_at_prio[wp]:
-  "\<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t\<rbrace> setCTE p v \<lbrace>\<lambda>rv. obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t\<rbrace>"
-  unfolding setCTE_def
-  by (rule setObject_cte_obj_at_tcb', simp+)
-
-crunch obj_at_prio[wp]: cteInsert "obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t"
-  (wp: crunch_wps)
-
-crunch ctes_of[wp]: asUser "\<lambda>s. P (ctes_of s)"
-  (wp: crunch_wps)
-
-lemma tcbSchedEnqueue_tcbPriority[wp]:
-  "\<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t\<rbrace>
-     tcbSchedEnqueue t'
-   \<lbrace>\<lambda>rv. obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply (wp | simp cong: if_cong)+
-  done
-
-crunch obj_at_prio[wp]: cteDeleteOne "obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t"
-  (wp: crunch_wps setEndpoint_obj_at_tcb'
-       setThreadState_obj_at_unchanged setNotification_tcb setBoundNotification_obj_at_unchanged
-        simp: crunch_simps unless_def)
+crunches setBoundNotification, cteDeleteOne
+  for obj_at_prio[wp]: "obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t"
+  (wp: crunch_wps simp: crunch_simps)
 
 lemma setThreadState_no_sch_change:
   "\<lbrace>\<lambda>s. P (ksSchedulerAction s) \<and> (runnable' st \<or> t \<noteq> ksCurThread s)\<rbrace>
@@ -1086,8 +1068,6 @@ lemma setCTE_assert_modify:
        apply (rule word_and_le2)
       apply (simp add: objBits_simps mask_def field_simps)
      apply (simp add: simpler_modify_def cong: option.case_cong if_cong)
-     apply (rule kernel_state.fold_congs[OF refl refl])
-     apply (clarsimp simp: projectKO_opt_tcb cong: if_cong)
     apply (clarsimp simp: lookupAround2_char1 word_and_le2)
     apply (rule ccontr, clarsimp)
     apply (erule(2) ps_clearD)
@@ -1104,7 +1084,7 @@ lemma setCTE_assert_modify:
    apply (erule disjE)
     apply clarsimp
     apply (frule(1) tcb_cte_cases_aligned_helpers)
-    apply (clarsimp simp: domI[where m = cte_cte_cases] field_simps)
+    apply (clarsimp simp: domI field_simps)
     apply (clarsimp simp: lookupAround2_char1 obj_at'_def projectKOs
                           objBits_simps)
    apply (clarsimp simp: obj_at'_def lookupAround2_char1
@@ -1232,11 +1212,14 @@ lemma thread_actions_isolatableD:
 lemma tcbSchedDequeue_rewrite:
   "monadic_rewrite True True (obj_at' (Not \<circ> tcbQueued) t) (tcbSchedDequeue t) (return ())"
   apply (simp add: tcbSchedDequeue_def)
-   apply (wp_pre, monadic_rewrite_symb_exec_l_known False, simp)
-    apply (rule monadic_rewrite_refl)
-   apply (wpsimp wp: threadGet_const)+
+  apply wp_pre
+  apply monadic_rewrite_symb_exec_l
+    apply (monadic_rewrite_symb_exec_l_known False, simp)
+     apply (rule monadic_rewrite_refl)
+    apply (wpsimp wp: threadGet_const)+
   done
 
+(* FIXME: improve automation here *)
 lemma switchToThread_rewrite:
   "monadic_rewrite True True
        (ct_in_state' (Not \<circ> runnable') and cur_tcb' and obj_at' (Not \<circ> tcbQueued) t)
@@ -1244,7 +1227,9 @@ lemma switchToThread_rewrite:
        (do Arch.switchToThread t; setCurThread t od)"
   apply (simp add: switchToThread_def Thread_H.switchToThread_def)
   apply (monadic_rewrite_l tcbSchedDequeue_rewrite, simp)
-   apply (rule monadic_rewrite_refl)
+   (* strip LHS of getters and asserts until LHS and RHS are the same *)
+   apply (repeat_unless \<open>rule monadic_rewrite_refl\<close> monadic_rewrite_symb_exec_l)
+      apply wpsimp+
   apply (clarsimp simp: comp_def)
   done
 
@@ -1282,9 +1267,33 @@ lemma threadGet_isolatable:
                thread_actions_isolatable_fail)
   done
 
+lemma tcbQueued_put_tcb_state_regs_tcb:
+  "tcbQueued (put_tcb_state_regs_tcb tsr tcb) = tcbQueued tcb"
+  apply (clarsimp simp: put_tcb_state_regs_tcb_def)
+  by (cases tsr; clarsimp)
+
+lemma idleThreadNotQueued_isolatable:
+  "thread_actions_isolatable idx (stateAssert idleThreadNotQueued [])"
+  apply (simp add: stateAssert_def2 stateAssert_def)
+  apply (intro thread_actions_isolatable_bind[OF _ _ hoare_pre(1)]
+               gets_isolatable
+               thread_actions_isolatable_if
+               thread_actions_isolatable_returns
+               thread_actions_isolatable_fail)
+    unfolding idleThreadNotQueued_def
+    apply (clarsimp simp: obj_at_partial_overwrite_If)
+    apply (clarsimp simp: obj_at'_def tcbQueued_put_tcb_state_regs_tcb)
+   apply wpsimp+
+  done
+
 lemma setCurThread_isolatable:
   "thread_actions_isolatable idx (setCurThread t)"
-  by (simp add: setCurThread_def modify_isolatable)
+  unfolding setCurThread_def
+  apply (rule thread_actions_isolatable_bind)
+    apply (rule idleThreadNotQueued_isolatable)
+   apply (fastforce intro: modify_isolatable)
+  apply wpsimp
+  done
 
 lemma isolate_thread_actions_tcbs_at:
   assumes f: "\<And>x. \<lbrace>tcb_at' (idx x)\<rbrace> f \<lbrace>\<lambda>rv. tcb_at' (idx x)\<rbrace>" shows
diff --git a/proof/crefine/X64/Recycle_C.thy b/proof/crefine/X64/Recycle_C.thy
index 7abc411aca..4363ee8e8d 100644
--- a/proof/crefine/X64/Recycle_C.thy
+++ b/proof/crefine/X64/Recycle_C.thy
@@ -870,16 +870,6 @@ lemma cnotification_relation_q_cong:
   apply (auto intro: iffD1[OF tcb_queue_relation'_cong[OF refl refl refl]])
   done
 
-lemma tcbSchedEnqueue_ep_at:
-  "\<lbrace>obj_at' (P :: endpoint \<Rightarrow> bool) ep\<rbrace>
-      tcbSchedEnqueue t
-   \<lbrace>\<lambda>rv. obj_at' P ep\<rbrace>"
-  including no_pre
-  apply (simp add: tcbSchedEnqueue_def unless_def null_def)
-  apply (wp threadGet_wp, clarsimp, wp+)
-  apply (clarsimp split: if_split, wp)
-  done
-
 lemma ccorres_duplicate_guard:
   "ccorres r xf (P and P) Q hs f f' \<Longrightarrow> ccorres r xf P Q hs f f'"
   by (erule ccorres_guard_imp, auto)
@@ -899,10 +889,11 @@ lemma cancelBadgedSends_ccorres:
               (UNIV \<inter> {s. epptr_' s = Ptr ptr} \<inter> {s. badge_' s = bdg}) []
        (cancelBadgedSends ptr bdg) (Call cancelBadgedSends_'proc)"
   apply (cinit lift: epptr_' badge_' simp: whileAnno_def)
+   apply (rule ccorres_stateAssert)
    apply (simp add: list_case_return
               cong: list.case_cong Structures_H.endpoint.case_cong call_ignore_cong
                del: Collect_const)
-   apply (rule ccorres_pre_getEndpoint)
+   apply (rule ccorres_pre_getEndpoint, rename_tac ep)
    apply (rule_tac R="ko_at' ep ptr" and xf'="ret__unsigned_longlong_'"
                and val="case ep of RecvEP q \<Rightarrow> scast EPState_Recv | IdleEP \<Rightarrow> scast EPState_Idle
                                 | SendEP q \<Rightarrow> scast EPState_Send"
@@ -952,8 +943,9 @@ lemma cancelBadgedSends_ccorres:
                    st_tcb_at' (\<lambda>st. isBlockedOnSend st \<and> blockingObject st = ptr) x s)
                               \<and> distinct (xs @ list) \<and> ko_at' IdleEP ptr s
                               \<and> (\<forall>p. \<forall>x \<in> set (xs @ list). \<forall>rf. (x, rf) \<notin> {r \<in> state_refs_of' s p. snd r \<noteq> NTFNBound})
-                              \<and> valid_queues s \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_canonical' s
-                              \<and> sch_act_wf (ksSchedulerAction s) s \<and> valid_objs' s"
+                              \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_canonical' s
+                              \<and> sch_act_wf (ksSchedulerAction s) s \<and> valid_objs' s
+                              \<and> ksReadyQueues_head_end s \<and> ksReadyQueues_head_end_tcb_at' s"
                      and P'="\<lambda>xs. {s. ep_queue_relation' (cslift s) (xs @ list)
                                          (head_C (queue_' s)) (end_C (queue_' s))}
                                 \<inter> {s. thread_' s = (case list of [] \<Rightarrow> tcb_Ptr 0
@@ -1055,8 +1047,9 @@ lemma cancelBadgedSends_ccorres:
                    apply (rule_tac rrel=dc and xf=xfdc
                                and P="\<lambda>s. (\<forall>t \<in> set (x @ a # lista). tcb_at' t s)
                                           \<and> (\<forall>p. \<forall>t \<in> set (x @ a # lista). \<forall>rf. (t, rf) \<notin> {r \<in> state_refs_of' s p. snd r \<noteq> NTFNBound})
-                                          \<and> valid_queues s \<and> distinct (x @ a # lista)
-                                          \<and> pspace_aligned' s \<and> pspace_distinct' s"
+                                          \<and> distinct (x @ a # lista)
+                                          \<and> pspace_aligned' s \<and> pspace_distinct' s
+                                          \<and> ksReadyQueues_head_end s \<and> ksReadyQueues_head_end_tcb_at' s"
                               and P'="{s. ep_queue_relation' (cslift s) (x @ a # lista)
                                            (head_C (queue_' s)) (end_C (queue_' s))}"
                                in ccorres_from_vcg)
@@ -1072,8 +1065,7 @@ lemma cancelBadgedSends_ccorres:
                    apply (clarsimp simp: return_def rf_sr_def cstate_relation_def Let_def)
                    apply (rule conjI)
                     apply (clarsimp simp: cpspace_relation_def)
-                    apply (rule conjI, erule ctcb_relation_null_queue_ptrs)
-                     apply (rule null_ep_queue)
+                    apply (rule conjI, erule ctcb_relation_null_ep_ptrs)
                      subgoal by (simp add: o_def)
                     apply (rule conjI)
                      apply (erule iffD1 [OF cmap_relation_cong, OF refl refl, rotated -1])
@@ -1096,9 +1088,6 @@ lemma cancelBadgedSends_ccorres:
                     apply (clarsimp simp: image_iff)
                     apply (drule_tac x=p in spec)
                     subgoal by fastforce
-                   apply (rule conjI)
-                    apply (erule cready_queues_relation_not_queue_ptrs,
-                           auto dest: null_ep_schedD[unfolded o_def] simp: o_def)[1]
                    apply (clarsimp simp: carch_state_relation_def cmachine_state_relation_def
                                   elim!: fpu_null_state_typ_heap_preservation)
                   apply (rule ccorres_symb_exec_r2)
@@ -1108,12 +1097,11 @@ lemma cancelBadgedSends_ccorres:
                  apply wp
                 apply simp
                 apply vcg
-               apply (wp hoare_vcg_const_Ball_lift tcbSchedEnqueue_ep_at
-                         sch_act_wf_lift)
+               apply (wp hoare_vcg_const_Ball_lift sch_act_wf_lift)
               apply simp
               apply (vcg exspec=tcbSchedEnqueue_cslift_spec)
              apply (wp hoare_vcg_const_Ball_lift sts_st_tcb_at'_cases
-                       sts_sch_act sts_valid_queues setThreadState_oa_queued)
+                       sts_sch_act sts_valid_objs')
             apply (vcg exspec=setThreadState_cslift_spec)
            apply (simp add: ccorres_cond_iffs)
            apply (rule ccorres_symb_exec_r2)
@@ -1137,14 +1125,11 @@ lemma cancelBadgedSends_ccorres:
            apply (clarsimp simp: cscheduler_action_relation_def st_tcb_at'_def
                           split: scheduler_action.split_asm)
            apply (rename_tac word)
-           apply (frule_tac x=word in tcbSchedEnqueue_cslift_precond_discharge)
-              apply simp
-             subgoal by clarsimp
-            subgoal by clarsimp
+           apply (frule_tac x=word in tcbSchedEnqueue_cslift_precond_discharge; simp?)
            subgoal by clarsimp
           apply clarsimp
           apply (rule conjI)
-           apply (frule(3) tcbSchedEnqueue_cslift_precond_discharge)
+           apply (frule tcbSchedEnqueue_cslift_precond_discharge; simp?)
            subgoal by clarsimp
           apply clarsimp
           apply (rule context_conjI)
@@ -1184,9 +1169,19 @@ lemma cancelBadgedSends_ccorres:
    apply (clarsimp split: if_split)
    apply (drule sym_refsD, clarsimp)
    apply (drule(1) bspec)+
-   by (auto simp: obj_at'_def projectKOs state_refs_of'_def pred_tcb_at'_def tcb_bound_refs'_def
-              dest!: symreftype_inverse')
-
+   apply (frule ksReadyQueues_asrt_ksReadyQueues_head_end)
+   apply (frule invs_pspace_aligned')
+   apply (frule invs_pspace_distinct')
+   apply (frule (2) ksReadyQueues_asrt_ksReadyQueues_head_end_tcb_at')
+   apply (fastforce simp: obj_at'_def projectKOs state_refs_of'_def pred_tcb_at'_def
+                          tcb_bound_refs'_def
+                   dest!: symreftype_inverse')
+  apply (frule ksReadyQueues_asrt_ksReadyQueues_head_end)
+  apply (frule invs_pspace_aligned')
+  apply (frule invs_pspace_distinct')
+  apply (frule (2) ksReadyQueues_asrt_ksReadyQueues_head_end_tcb_at')
+  apply fastforce
+  done
 
 lemma tcb_ptr_to_ctcb_ptr_force_fold:
   "x + 2 ^ ctcb_size_bits = ptr_val (tcb_ptr_to_ctcb_ptr x)"
diff --git a/proof/crefine/X64/Refine_C.thy b/proof/crefine/X64/Refine_C.thy
index 36701dd201..ccbfbea8c8 100644
--- a/proof/crefine/X64/Refine_C.thy
+++ b/proof/crefine/X64/Refine_C.thy
@@ -64,7 +64,7 @@ proof -
          apply (rule allI, rule conseqPre, vcg)
          apply (clarsimp simp: return_def)
         apply (wp schedule_sch_act_wf schedule_invs'
-             | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+             | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
       apply vcg
      apply vcg
     apply (clarsimp simp: irqInvalid_def ucast_8_32_neq)
@@ -77,7 +77,7 @@ proof -
        apply (rule allI, rule conseqPre, vcg)
        apply (clarsimp simp: return_def)
       apply (wp schedule_sch_act_wf schedule_invs'
-             | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+             | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
    apply (rule_tac Q="\<lambda>rv s. invs' s \<and> (\<forall>x. rv = Some x \<longrightarrow> x \<le> X64.maxIRQ) \<and> rv \<noteq> Some 0x3FF" in hoare_post_imp)
     apply (clarsimp simp: non_kernel_IRQs_def)
    apply (wp getActiveIRQ_le_maxIRQ getActiveIRQ_neq_Some0xFF | simp)+
@@ -106,14 +106,12 @@ lemma handleUnknownSyscall_ccorres:
          apply (rule allI, rule conseqPre, vcg)
         apply (clarsimp simp: return_def)
        apply (wp schedule_sch_act_wf schedule_invs'
-              | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+              | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
     apply (clarsimp, vcg)
    apply (clarsimp, rule conseqPre, vcg, clarsimp)
   apply clarsimp
   apply (intro impI conjI allI)
-      apply fastforce
-     apply (clarsimp simp: ct_not_ksQ)
-    apply (clarsimp simp add: sch_act_simple_def split: scheduler_action.split)
+    apply fastforce
    apply (rule active_ex_cap')
     apply (erule active_from_running')
    apply (erule invs_iflive')
@@ -163,13 +161,13 @@ lemma handleVMFaultEvent_ccorres:
        apply (rule allI, rule conseqPre, vcg)
        apply (clarsimp simp: return_def)
       apply (wp schedule_sch_act_wf schedule_invs'
-             | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+             | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
      apply (case_tac x, clarsimp, wp)
      apply (clarsimp, wp, simp)
     apply wp
    apply (simp add: guard_is_UNIV_def)
   apply (clarsimp simp: simple_sane_strg[unfolded sch_act_sane_not])
-  by (auto simp: ct_in_state'_def cfault_rel_def is_cap_fault_def ct_not_ksQ
+  by (auto simp: ct_in_state'_def cfault_rel_def is_cap_fault_def
               elim: pred_tcb'_weakenE st_tcb_ex_cap''
               dest: st_tcb_at_idle_thread' rf_sr_ksCurThread)
 
@@ -195,16 +193,14 @@ lemma handleUserLevelFault_ccorres:
         apply (rule allI, rule conseqPre, vcg)
         apply (clarsimp simp: return_def)
        apply (wp schedule_sch_act_wf schedule_invs'
-              | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+              | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
     apply (clarsimp, vcg)
    apply (clarsimp, rule conseqPre, vcg, clarsimp)
   apply clarsimp
   apply (intro impI conjI allI)
-      apply (simp add: ct_in_state'_def)
-      apply (erule pred_tcb'_weakenE)
-      apply simp
-     apply (clarsimp simp: ct_not_ksQ)
-    apply (clarsimp simp add: sch_act_simple_def split: scheduler_action.split)
+    apply (simp add: ct_in_state'_def)
+    apply (erule pred_tcb'_weakenE)
+    apply simp
    apply (rule active_ex_cap')
     apply (erule active_from_running')
    apply (erule invs_iflive')
@@ -378,11 +374,10 @@ lemma handleSyscall_ccorres:
           apply wp[1]
          apply clarsimp
          apply wp
-         apply (rule_tac Q="\<lambda>rv s. ct_in_state' simple' s \<and> sch_act_sane s \<and>
-                            (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))"
+         apply (rule_tac Q="\<lambda>rv s. ct_in_state' simple' s \<and> sch_act_sane s"
                               in hoare_post_imp)
           apply (simp add: ct_in_state'_def)
-         apply (wp handleReply_sane handleReply_ct_not_ksQ)
+         apply (wp handleReply_sane)
         \<comment> \<open>SysYield\<close>
         apply (clarsimp simp: syscall_from_H_def syscall_defs)
         apply (rule ccorres_cond_empty |rule ccorres_cond_univ)+
@@ -408,11 +403,11 @@ lemma handleSyscall_ccorres:
        apply (rule_tac P=\<top> and P'=UNIV in ccorres_from_vcg_throws)
        apply (rule allI, rule conseqPre, vcg)
        apply (clarsimp simp: return_def)
-      apply (wp schedule_invs' schedule_sch_act_wf | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+      apply (wp schedule_invs' schedule_sch_act_wf
+             | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
      apply (simp
           | wpc
           | wp hoare_drop_imp handleReply_sane handleReply_nonz_cap_to_ct schedule_invs'
-               handleReply_ct_not_ksQ[simplified]
           | strengthen ct_active_not_idle'_strengthen invs_valid_objs_strengthen)+
       apply (rule_tac  Q="\<lambda>rv. invs' and ct_active'" in hoare_post_imp, simp)
       apply (wp hy_invs')
@@ -430,7 +425,7 @@ lemma handleSyscall_ccorres:
   apply (frule active_ex_cap')
    apply (clarsimp simp: invs'_def valid_state'_def)
   apply (clarsimp simp: simple_sane_strg ct_in_state'_def st_tcb_at'_def obj_at'_def
-                        isReply_def ct_not_ksQ)
+                        isReply_def)
   apply (rule conjI, fastforce)
   apply (auto simp: syscall_from_H_def Kernel_C.SysSend_def
               split: option.split_asm)
@@ -518,7 +513,7 @@ lemma handleHypervisorEvent_ccorres:
          apply simp
         apply assumption
        apply (wp schedule_sch_act_wf schedule_invs'
-              | strengthen invs_queues_imp invs_valid_objs_strengthen)+
+              | strengthen invs_valid_objs_strengthen invs_pspace_aligned' invs_pspace_distinct')+
     apply clarsimp+
   done
 
@@ -651,12 +646,12 @@ lemma threadSet_all_invs_triv':
     apply (wp thread_set_invs_trivial thread_set_ct_running thread_set_not_state_valid_sched
               threadSet_invs_trivial threadSet_ct_running' hoare_weak_lift_imp
               thread_set_ct_in_state
-           | simp add: tcb_cap_cases_def tcb_arch_ref_def
+           | simp add: tcb_cap_cases_def tcb_arch_ref_def exst_same_def
            | rule threadSet_ct_in_state'
            | wp (once) hoare_vcg_disj_lift)+
   apply clarsimp
   apply (rule exI, rule conjI, assumption)
-  apply (clarsimp simp: invs_def invs'_def cur_tcb_def cur_tcb'_def)
+  apply (clarsimp simp: invs_def invs'_def cur_tcb_def cur_tcb'_def invs_psp_aligned invs_distinct)
   apply (simp add: state_relation_def)
   done
 
@@ -869,17 +864,22 @@ lemma dmo_domain_user_mem'[wp]:
   done
 
 lemma do_user_op_corres_C:
-  "corres_underlying rf_sr False False (=) (invs' and ex_abs einvs) \<top>
-                     (doUserOp f tc) (doUserOp_C f tc)"
+  "corres_underlying rf_sr False False (=)
+     (invs' and ksReadyQueues_asrt and ex_abs einvs) \<top>
+     (doUserOp f tc) (doUserOp_C f tc)"
   apply (simp only: doUserOp_C_def doUserOp_def split_def)
   apply (rule corres_guard_imp)
     apply (rule_tac P=\<top> and P'=\<top> and r'="(=)" in corres_split)
        apply (clarsimp simp: simpler_gets_def getCurThread_def
                 corres_underlying_def rf_sr_def cstate_relation_def Let_def)
-      apply (rule_tac P=valid_state' and P'=\<top> and r'="(=)" in corres_split)
+      apply (rule_tac P="valid_state' and ksReadyQueues_asrt"
+                  and P'=\<top> and r'="(=)"
+                   in corres_split)
          apply (clarsimp simp: cstate_to_A_def absKState_def
                                rf_sr_def cstate_to_H_correct ptable_lift_def)
-        apply (rule_tac P=valid_state' and P'=\<top> and r'="(=)" in corres_split)
+        apply (rule_tac P="valid_state' and ksReadyQueues_asrt"
+                    and P'=\<top> and r'="(=)"
+                     in corres_split)
            apply (clarsimp simp: cstate_to_A_def absKState_def
                                  rf_sr_def cstate_to_H_correct ptable_rights_def)
           apply (rule_tac P=pspace_distinct' and P'=\<top> and r'="(=)"
@@ -977,6 +977,9 @@ lemma refinement2_both:
     apply (subst cstate_to_H_correct)
      apply (fastforce simp: full_invs'_def invs'_def)
     apply (clarsimp simp: rf_sr_def)
+    apply (clarsimp simp: lift_state_relation_def full_invs_def)
+    apply (rule ksReadyQueues_asrt_cross)
+    apply (erule state_relation_ready_queues_relation)
    apply (simp add:absKState_def observable_memory_def absExst_def)
    apply (rule MachineTypes.machine_state.equality,simp_all)[1]
    apply (rule ext)
@@ -1003,13 +1006,35 @@ lemma refinement2_both:
    apply (clarsimp simp add: do_user_op_C_def do_user_op_H_def monad_to_transition_def)
    apply (rule rev_mp, rule_tac f="uop" and tc=af in do_user_op_corres_C)
    apply (clarsimp simp: corres_underlying_def invs_def ex_abs_def)
-   apply (fastforce simp: full_invs'_def ex_abs_def)
+   apply (drule bspec)
+    apply fastforce
+   apply clarsimp
+   apply (elim impE)
+    apply (clarsimp simp: full_invs'_def ex_abs_def)
+    apply (intro conjI)
+     apply (rule ksReadyQueues_asrt_cross)
+     apply (erule state_relation_ready_queues_relation)
+    apply (clarsimp simp: lift_state_relation_def full_invs_def)
+    apply (frule state_relation_ready_queues_relation)
+    apply (fastforce simp: ready_queues_relation_def Let_def tcbQueueEmpty_def)
+   apply fastforce
 
   apply (erule_tac P="a \<and> b \<and> c \<and> (\<exists>x. e x)" for a b c d e in disjE)
    apply (clarsimp simp add: do_user_op_C_def do_user_op_H_def monad_to_transition_def)
    apply (rule rev_mp, rule_tac f="uop" and tc=af in do_user_op_corres_C)
    apply (clarsimp simp: corres_underlying_def invs_def ex_abs_def)
-   apply (fastforce simp: full_invs'_def ex_abs_def)
+   apply (drule bspec)
+    apply fastforce
+   apply clarsimp
+   apply (elim impE)
+    apply (clarsimp simp: full_invs'_def ex_abs_def)
+    apply (intro conjI)
+     apply (rule ksReadyQueues_asrt_cross)
+     apply (erule state_relation_ready_queues_relation)
+    apply (clarsimp simp: lift_state_relation_def full_invs_def)
+    apply (frule state_relation_ready_queues_relation)
+    apply (fastforce simp: ready_queues_relation_def Let_def tcbQueueEmpty_def)
+   apply fastforce
 
   apply (clarsimp simp: check_active_irq_C_def check_active_irq_H_def)
   apply (rule rev_mp, rule check_active_irq_corres_C)
diff --git a/proof/crefine/X64/Retype_C.thy b/proof/crefine/X64/Retype_C.thy
index 66f30e5948..f51d8c09b2 100644
--- a/proof/crefine/X64/Retype_C.thy
+++ b/proof/crefine/X64/Retype_C.thy
@@ -3533,7 +3533,6 @@ lemma cnc_tcb_helper:
   assumes rfsr: "(\<sigma>\<lparr>ksPSpace := ks\<rparr>, x) \<in> rf_sr"
   assumes al: "is_aligned (ctcb_ptr_to_tcb_ptr p) (objBitsKO kotcb)"
   assumes ptr0: "ctcb_ptr_to_tcb_ptr p \<noteq> 0"
-  assumes vq: "valid_queues \<sigma>"
   assumes pal: "pspace_aligned' (\<sigma>\<lparr>ksPSpace := ks\<rparr>)"
   assumes pno: "pspace_no_overlap' (ctcb_ptr_to_tcb_ptr p) (objBitsKO kotcb) (\<sigma>\<lparr>ksPSpace := ks\<rparr>)"
   assumes pds: "pspace_distinct' (\<sigma>\<lparr>ksPSpace := ks\<rparr>)"
@@ -3903,20 +3902,20 @@ proof -
     unfolding ctcb_relation_def makeObject_tcb heap_updates_defs initContext_registers_def
     apply (simp add: fbtcb minBound_word)
     apply (intro conjI)
-        apply (simp add: cthread_state_relation_def thread_state_lift_def
-                         eval_nat_numeral ThreadState_defs)
-       apply (clarsimp simp: ccontext_relation_def newContext_def2 carch_tcb_relation_def
-                             newArchTCB_def cregs_relation_def atcbContextGet_def fpu_relation_def)
-       apply (case_tac r; simp add: C_register_defs index_foldr_update
-                                    atcbContext_def newArchTCB_def newContext_def
-                                    initContext_def selCS3_eq selDS3_eq)
-       apply (clarsimp simp: fpu_relation_def)
-      apply (simp add: thread_state_lift_def index_foldr_update atcbContextGet_def)
-     apply (simp add: Kernel_Config.timeSlice_def)
-    apply (simp add: cfault_rel_def seL4_Fault_lift_def seL4_Fault_get_tag_def Let_def
-                     lookup_fault_lift_def lookup_fault_get_tag_def lookup_fault_invalid_root_def
-                     index_foldr_update seL4_Fault_NullFault_def option_to_ptr_def option_to_0_def
-              split: if_split)+
+         apply (simp add: cthread_state_relation_def thread_state_lift_def
+                          eval_nat_numeral ThreadState_defs)
+        apply (clarsimp simp: ccontext_relation_def newContext_def2 carch_tcb_relation_def
+                              newArchTCB_def cregs_relation_def atcbContextGet_def fpu_relation_def)
+        apply (case_tac r; simp add: C_register_defs index_foldr_update
+                                     atcbContext_def newArchTCB_def newContext_def
+                                     initContext_def)
+       apply (simp add: thread_state_lift_def index_foldr_update atcbContextGet_def)
+      apply (simp add: Kernel_Config.timeSlice_def)
+     apply (simp add: cfault_rel_def seL4_Fault_lift_def seL4_Fault_get_tag_def Let_def
+                      lookup_fault_lift_def lookup_fault_get_tag_def lookup_fault_invalid_root_def
+                      index_foldr_update seL4_Fault_NullFault_def option_to_ptr_def option_to_0_def
+               split: if_split)+
+    apply (simp add: option_to_ctcb_ptr_def)
     done
 
   have pks: "ks (ctcb_ptr_to_tcb_ptr p) = None"
@@ -3967,15 +3966,6 @@ proof -
     apply (fastforce simp: dom_def)
     done
 
-  hence kstcb: "\<And>qdom prio. ctcb_ptr_to_tcb_ptr p \<notin> set (ksReadyQueues \<sigma> (qdom, prio))" using vq
-    apply (clarsimp simp add: valid_queues_def valid_queues_no_bitmap_def)
-    apply (drule_tac x = qdom in spec)
-    apply (drule_tac x = prio in spec)
-    apply clarsimp
-    apply (drule (1) bspec)
-    apply (simp add: obj_at'_def)
-    done
-
   have ball_subsetE:
     "\<And>P S R. \<lbrakk> \<forall>x \<in> S. P x; R \<subseteq> S \<rbrakk> \<Longrightarrow> \<forall>x \<in> R. P x"
     by blast
@@ -4099,7 +4089,7 @@ proof -
     apply (simp add: cl_cte [simplified] cl_tcb [simplified] cl_rest [simplified] tag_disj_via_td_name)
     apply (clarsimp simp: cready_queues_relation_def Let_def
                           htd_safe[simplified] kernel_data_refs_domain_eq_rotate)
-    apply (simp add: heap_updates_def kstcb tcb_queue_update_other' hrs_htd_update
+    apply (simp add: heap_updates_def tcb_queue_update_other' hrs_htd_update
                      ptr_retyp_to_array[simplified] irq[simplified])
     apply (match premises in H: \<open>fpu_null_state_relation _\<close> \<Rightarrow>
              \<open>match premises in _[thin]: _ (multi) \<Rightarrow> \<open>insert H\<close>\<close>)
@@ -5188,7 +5178,8 @@ lemma rf_sr_fpu_null_relation:
 
 lemma ccorres_placeNewObject_tcb:
   "ccorresG rf_sr \<Gamma> dc xfdc
-   (pspace_aligned' and pspace_distinct' and pspace_no_overlap' regionBase tcbBlockSizeBits and valid_queues and (\<lambda>s. sym_refs (state_refs_of' s))
+   (pspace_aligned' and pspace_distinct' and pspace_no_overlap' regionBase tcbBlockSizeBits
+      and (\<lambda>s. sym_refs (state_refs_of' s))
       and (\<lambda>s. 2 ^ tcbBlockSizeBits \<le> gsMaxObjectSize s)
       and ret_zero regionBase (2 ^ tcbBlockSizeBits)
       and K (regionBase \<noteq> 0 \<and> range_cover regionBase tcbBlockSizeBits tcbBlockSizeBits 1
@@ -5597,7 +5588,7 @@ qed
 lemma placeNewObject_user_data:
   "ccorresG rf_sr \<Gamma> dc xfdc
   (pspace_aligned' and pspace_distinct' and pspace_no_overlap' regionBase (pageBits+us)
-  and valid_queues and valid_machine_state'
+  and valid_machine_state'
   and ret_zero regionBase (2 ^ (pageBits+us))
   and (\<lambda>s. sym_refs (state_refs_of' s))
   and (\<lambda>s. 2^(pageBits +  us) \<le> gsMaxObjectSize s)
@@ -5736,7 +5727,7 @@ lemma placeNewObject_user_data_device:
   "ccorresG rf_sr \<Gamma> dc xfdc
   (pspace_aligned' and pspace_distinct'
     and ret_zero regionBase (2 ^ (pageBits + us))
-    and pspace_no_overlap' regionBase (pageBits+us) and valid_queues
+    and pspace_no_overlap' regionBase (pageBits+us)
     and (\<lambda>s. sym_refs (state_refs_of' s))
     and (\<lambda>s. 2^(pageBits +  us) \<le> gsMaxObjectSize s)
     and K (regionBase \<noteq> 0 \<and> range_cover regionBase (pageBits + us) (pageBits+us) (Suc 0)
@@ -5965,7 +5956,7 @@ proof -
        apply clarify
        apply (intro conjI)
         apply (clarsimp simp: invs_pspace_aligned' invs_pspace_distinct' invs_valid_global'
-                              APIType_capBits_def invs_queues invs_valid_objs'
+                              APIType_capBits_def invs_valid_objs'
                               invs_urz pageBits_def)
        apply clarsimp
        apply (clarsimp simp: pageBits_def ccap_relation_def APIType_capBits_def
@@ -5994,7 +5985,7 @@ proof -
       apply clarify
       apply (intro conjI)
        apply (clarsimp simp: invs_pspace_aligned' invs_pspace_distinct' invs_valid_global'
-                             APIType_capBits_def invs_queues invs_valid_objs'
+                             APIType_capBits_def invs_valid_objs'
                              invs_urz bit_simps)
       apply clarsimp
       apply (clarsimp simp: ccap_relation_def APIType_capBits_def
@@ -6023,7 +6014,7 @@ proof -
      apply clarify
      apply (intro conjI)
       apply (clarsimp simp: invs_pspace_aligned' invs_pspace_distinct' invs_valid_global'
-                            APIType_capBits_def invs_queues invs_valid_objs' invs_urz bit_simps)
+                            APIType_capBits_def invs_valid_objs' invs_urz bit_simps)
      apply clarsimp
      apply (clarsimp simp: ccap_relation_def APIType_capBits_def
                            framesize_to_H_def cap_to_H_simps cap_pdpt_cap_lift
@@ -6054,7 +6045,7 @@ proof -
     apply clarify
     apply (intro conjI)
      apply (clarsimp simp: invs_pspace_aligned' invs_pspace_distinct' invs_valid_global'
-                           APIType_capBits_def invs_queues invs_valid_objs' invs_urz bit_simps)
+                           APIType_capBits_def invs_valid_objs' invs_urz bit_simps)
     apply clarsimp
     apply (clarsimp simp: ccap_relation_def APIType_capBits_def
                           framesize_to_H_def cap_to_H_simps cap_pml4_cap_lift
@@ -6159,15 +6150,11 @@ lemma threadSet_domain_ccorres [corres]:
   apply (simp add: map_to_ctes_upd_tcb_no_ctes map_to_tcbs_upd tcb_cte_cases_def)
   apply (simp add: cep_relations_drop_fun_upd
                    cvariable_relation_upd_const ko_at_projectKO_opt)
-  apply (rule conjI)
-   apply (drule ko_at_projectKO_opt)
-   apply (erule (2) cmap_relation_upd_relI)
-     subgoal by (simp add: ctcb_relation_def)
-    apply assumption
-   apply simp
-  apply (erule cready_queues_relation_not_queue_ptrs)
-   apply (rule ext, simp split: if_split)
-  apply (rule ext, simp split: if_split)
+  apply (drule ko_at_projectKO_opt)
+  apply (erule (2) cmap_relation_upd_relI)
+    subgoal by (simp add: ctcb_relation_def)
+   apply assumption
+  apply simp
   done
 
 lemma createObject_ccorres:
@@ -6294,7 +6281,6 @@ proof -
                                createObject_c_preconds_def)
          apply (frule invs_pspace_aligned')
          apply (frule invs_pspace_distinct')
-         apply (frule invs_queues)
          apply (frule invs_sym')
          apply (simp add: getObjectSize_def objBits_simps word_bits_conv
                           apiGetObjectSize_def
@@ -6339,7 +6325,6 @@ proof -
         apply (clarsimp simp: createObject_hs_preconds_def isFrameType_def)
         apply (frule invs_pspace_aligned')
         apply (frule invs_pspace_distinct')
-        apply (frule invs_queues)
         apply (frule invs_sym')
         apply (auto simp: getObjectSize_def objBits_simps apiGetObjectSize_def
                           epSizeBits_def word_bits_conv
@@ -6377,7 +6362,6 @@ proof -
        apply (clarsimp simp: createObject_hs_preconds_def isFrameType_def)
        apply (frule invs_pspace_aligned')
        apply (frule invs_pspace_distinct')
-       apply (frule invs_queues)
        apply (frule invs_sym')
        apply (auto simp: getObjectSize_def objBits_simps
                          apiGetObjectSize_def
@@ -6419,7 +6403,6 @@ proof -
        apply (clarsimp simp: createObject_hs_preconds_def isFrameType_def)
        apply (frule invs_pspace_aligned')
        apply (frule invs_pspace_distinct')
-       apply (frule invs_queues)
        apply (frule invs_sym')
        apply (frule(1) ghost_assertion_size_logic_no_unat)
        apply (clarsimp simp: getObjectSize_def objBits_simps
@@ -7285,14 +7268,6 @@ lemma insertNewCap_sch_act_simple[wp]:
  "\<lbrace>sch_act_simple\<rbrace>insertNewCap a b c\<lbrace>\<lambda>_. sch_act_simple\<rbrace>"
   by (simp add:sch_act_simple_def,wp)
 
-lemma insertNewCap_ct_active'[wp]:
- "\<lbrace>ct_active'\<rbrace>insertNewCap a b c\<lbrace>\<lambda>_. ct_active'\<rbrace>"
-  apply (simp add:ct_in_state'_def)
-  apply (rule hoare_pre)
-  apply wps
-  apply (wp insertNewCap_ksCurThread | simp)+
-  done
-
 lemma updateMDB_ctes_of_cap:
   "\<lbrace>\<lambda>s. (\<forall>x\<in>ran(ctes_of s). P (cteCap x)) \<and> no_0 (ctes_of s)\<rbrace>
     updateMDB srcSlot t
diff --git a/proof/crefine/X64/SR_lemmas_C.thy b/proof/crefine/X64/SR_lemmas_C.thy
index d3041b0640..e5103dbdf9 100644
--- a/proof/crefine/X64/SR_lemmas_C.thy
+++ b/proof/crefine/X64/SR_lemmas_C.thy
@@ -292,11 +292,15 @@ lemma cmdbnode_relation_mdb_node_to_H [simp]:
   unfolding cmdbnode_relation_def mdb_node_to_H_def mdb_node_lift_def cte_lift_def
   by (fastforce split: option.splits)
 
-definition
-  tcb_no_ctes_proj :: "tcb \<Rightarrow> Structures_H.thread_state \<times> machine_word \<times> machine_word \<times> arch_tcb \<times> bool \<times> word8 \<times> word8 \<times> word8 \<times> nat \<times> fault option \<times> machine_word option"
+definition tcb_no_ctes_proj ::
+  "tcb \<Rightarrow> Structures_H.thread_state \<times> machine_word \<times> machine_word \<times> arch_tcb \<times> bool \<times> word8
+          \<times> word8 \<times> word8 \<times> nat \<times> fault option \<times> machine_word option
+          \<times> machine_word option \<times> machine_word option"
   where
-  "tcb_no_ctes_proj t \<equiv> (tcbState t, tcbFaultHandler t, tcbIPCBuffer t, tcbArch t, tcbQueued t,
-                            tcbMCP t, tcbPriority t, tcbDomain t, tcbTimeSlice t, tcbFault t, tcbBoundNotification t)"
+  "tcb_no_ctes_proj t \<equiv>
+     (tcbState t, tcbFaultHandler t, tcbIPCBuffer t, tcbArch t, tcbQueued t,
+      tcbMCP t, tcbPriority t, tcbDomain t, tcbTimeSlice t, tcbFault t, tcbBoundNotification t,
+      tcbSchedNext t, tcbSchedPrev t)"
 
 lemma tcb_cte_cases_proj_eq [simp]:
   "tcb_cte_cases p = Some (getF, setF) \<Longrightarrow>
@@ -1468,9 +1472,9 @@ lemma cmap_relation_cong:
    apply (erule imageI)
    done
 
-lemma ctcb_relation_null_queue_ptrs:
+lemma ctcb_relation_null_ep_ptrs:
   assumes rel: "cmap_relation mp mp' tcb_ptr_to_ctcb_ptr ctcb_relation"
-  and same: "map_option tcb_null_queue_ptrs \<circ> mp'' = map_option tcb_null_queue_ptrs \<circ> mp'"
+  and same: "map_option tcb_null_ep_ptrs \<circ> mp'' = map_option tcb_null_ep_ptrs \<circ> mp'"
   shows "cmap_relation mp mp'' tcb_ptr_to_ctcb_ptr ctcb_relation"
   using rel
   apply (rule iffD1 [OF cmap_relation_cong, OF _ map_option_eq_dom_eq, rotated -1])
@@ -1478,7 +1482,7 @@ lemma ctcb_relation_null_queue_ptrs:
    apply (rule same [symmetric])
   apply (drule compD [OF same])
   apply (case_tac b, case_tac b')
-  apply (simp add: ctcb_relation_def tcb_null_queue_ptrs_def)
+  apply (simp add: ctcb_relation_def tcb_null_ep_ptrs_def)
   done
 
 (* FIXME x64: do we still need these?
@@ -2363,6 +2367,14 @@ lemma capTCBPtr_eq:
   apply clarsimp
   done
 
+lemma rf_sr_ctcb_queue_relation:
+  "\<lbrakk> (s, s') \<in> rf_sr; d \<le> maxDomain; p \<le> maxPriority \<rbrakk>
+  \<Longrightarrow> ctcb_queue_relation (ksReadyQueues s (d, p))
+                          (index (ksReadyQueues_' (globals s')) (cready_queues_index_to_C d p))"
+  unfolding rf_sr_def cstate_relation_def cready_queues_relation_def
+  apply (clarsimp simp: Let_def seL4_MinPrio_def minDom_def maxDom_to_H maxPrio_to_H)
+  done
+
 lemma rf_sr_sched_action_relation:
   "(s, s') \<in> rf_sr
    \<Longrightarrow> cscheduler_action_relation (ksSchedulerAction s) (ksSchedulerAction_' (globals s'))"
@@ -2480,6 +2492,12 @@ lemma fpu_null_state_heap_update_tag_disj':
   by (clarsimp simp: fpu_null_state_relation_def hrs_mem_update_def hrs_htd_def
               split: prod.splits)
 
+lemma rf_sr_obj_update_helper:
+  "(s, s'\<lparr> globals := globals s' \<lparr> t_hrs_' := t_hrs_' (globals (undefined
+              \<lparr> globals := (undefined \<lparr> t_hrs_' := f (globals s') (t_hrs_' (globals s')) \<rparr>)\<rparr>))\<rparr>\<rparr>) \<in> rf_sr
+          \<Longrightarrow> (s, globals_update (\<lambda>v. t_hrs_'_update (f v) v) s') \<in> rf_sr"
+  by (simp cong: StateSpace.state.fold_congs globals.fold_congs)
+
 lemmas h_t_valid_nested_fields =
   h_t_valid_field[OF h_t_valid_field[OF h_t_valid_field]]
   h_t_valid_field[OF h_t_valid_field]
diff --git a/proof/crefine/X64/Schedule_C.thy b/proof/crefine/X64/Schedule_C.thy
index 41ddffb772..e0b618e692 100644
--- a/proof/crefine/X64/Schedule_C.thy
+++ b/proof/crefine/X64/Schedule_C.thy
@@ -6,7 +6,7 @@
  *)
 
 theory Schedule_C
-imports Tcb_C
+imports Tcb_C Detype_C
 begin
 
 (*FIXME: arch_split: move up?*)
@@ -33,19 +33,41 @@ lemma Arch_switchToIdleThread_ccorres:
   apply (clarsimp simp: invs_no_cicd'_def valid_pspace'_def valid_idle'_tcb_at'_ksIdleThread)
   done
 
+lemma invs_no_cicd'_pspace_aligned':
+  "all_invs_but_ct_idle_or_in_cur_domain' s \<Longrightarrow> pspace_aligned' s"
+  by (simp add: all_invs_but_ct_idle_or_in_cur_domain'_def valid_pspace'_def)
+
+lemma invs_no_cicd'_pspace_distinct':
+  "all_invs_but_ct_idle_or_in_cur_domain' s \<Longrightarrow> pspace_distinct' s"
+  by (simp add: all_invs_but_ct_idle_or_in_cur_domain'_def valid_pspace'_def)
+
+lemma threadGet_exs_valid[wp]:
+  "tcb_at' t s \<Longrightarrow> \<lbrace>(=) s\<rbrace> threadGet f t \<exists>\<lbrace>\<lambda>r. (=) s\<rbrace>"
+  unfolding threadGet_def liftM_def
+  apply (wpsimp wp: exs_getObject)
+    apply (fastforce simp: obj_at'_def objBits_simps')+
+  done
+
+lemma isRunnable_exs_valid[wp]:
+  "tcb_at' t s \<Longrightarrow> \<lbrace>(=) s\<rbrace> isRunnable t \<exists>\<lbrace>\<lambda>r. (=) s\<rbrace>"
+  unfolding isRunnable_def getThreadState_def
+  by (wpsimp wp: exs_getObject)
+
 lemma switchToIdleThread_ccorres:
   "ccorres dc xfdc invs_no_cicd' UNIV hs
            switchToIdleThread (Call switchToIdleThread_'proc)"
   apply (cinit)
+   apply (rule ccorres_stateAssert)
    apply (rule ccorres_symb_exec_l)
       apply (ctac (no_vcg) add: Arch_switchToIdleThread_ccorres)
        apply (simp add: setCurThread_def)
+       apply (rule ccorres_stateAssert)
        apply (rule_tac P="\<lambda>s. thread = ksIdleThread s" and P'=UNIV in ccorres_from_vcg)
        apply (rule allI, rule conseqPre, vcg)
        apply (clarsimp simp: simpler_modify_def)
        apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
                              carch_state_relation_def cmachine_state_relation_def)
-      apply (wpsimp simp: X64_H.switchToIdleThread_def)+
+      apply (wpsimp simp: X64_H.switchToIdleThread_def wp: hoare_drop_imps)+
   done
 
 lemma Arch_switchToThread_ccorres:
@@ -69,23 +91,28 @@ lemma switchToThread_ccorres:
            hs
            (switchToThread t)
            (Call switchToThread_'proc)"
-  apply (cinit lift: thread_')
+  apply (clarsimp simp: switchToThread_def)
+  apply (rule ccorres_symb_exec_l'[OF _ _ isRunnable_sp]; (solves wpsimp)?)
+  apply (rule ccorres_symb_exec_l'[OF _ _ assert_sp]; (solves wpsimp)?)
+  apply (rule ccorres_stateAssert_fwd)+
+  apply (cinit' lift: thread_')
    apply (ctac (no_vcg) add: Arch_switchToThread_ccorres)
     apply (ctac (no_vcg) add: tcbSchedDequeue_ccorres)
+     apply (simp add: setCurThread_def)
+     apply (rule ccorres_stateAssert)
      apply (rule_tac P=\<top> and P'=UNIV in ccorres_from_vcg)
      apply clarsimp
      apply (rule conseqPre, vcg)
-     apply (clarsimp simp: setCurThread_def simpler_modify_def)
-     apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
-                           carch_state_relation_def cmachine_state_relation_def)
-    apply wp+
-  apply (clarsimp simp: all_invs_but_ct_idle_or_in_cur_domain'_def valid_state'_def)
+     apply (clarsimp simp: setCurThread_def simpler_modify_def rf_sr_def cstate_relation_def
+                           Let_def carch_state_relation_def cmachine_state_relation_def)
+    apply (wpsimp wp: Arch_switchToThread_invs_no_cicd' hoare_drop_imps
+           | strengthen invs_no_cicd'_pspace_aligned' invs_no_cicd'_pspace_distinct')+
   done
 
 lemma activateThread_ccorres:
   "ccorres dc xfdc
            (ct_in_state' activatable' and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)
-                   and valid_queues and valid_objs')
+            and valid_objs' and pspace_aligned' and pspace_distinct')
            UNIV []
            activateThread
            (Call activateThread_'proc)"
@@ -177,13 +204,42 @@ lemma switchToThread_ccorres':
 
 lemmas word_log2_max_word_word_size = word_log2_max[where 'a=machine_word_len, simplified word_size, simplified]
 
+lemma ccorres_pre_getQueue:
+  assumes cc: "\<And>queue. ccorres r xf (P queue) (P' queue) hs (f queue) c"
+  shows   "ccorres r xf (\<lambda>s. P (ksReadyQueues s (d, p)) s \<and> d \<le> maxDomain \<and> p \<le> maxPriority)
+                        {s'. \<forall>queue. (let cqueue = index (ksReadyQueues_' (globals s'))
+                                                         (cready_queues_index_to_C d p) in
+                                      ctcb_queue_relation queue cqueue) \<longrightarrow> s' \<in> P' queue}
+           hs (getQueue d p >>= (\<lambda>queue. f queue)) c"
+  apply (rule ccorres_guard_imp2)
+  apply (rule ccorres_symb_exec_l2)
+     defer
+     defer
+     apply (rule gq_sp)
+    defer
+    apply (rule ccorres_guard_imp)
+    apply (rule cc)
+     apply clarsimp
+     apply assumption
+    apply assumption
+   apply (clarsimp simp: getQueue_def gets_exs_valid)
+  apply clarsimp
+  apply (drule spec, erule mp)
+  apply (erule rf_sr_ctcb_queue_relation)
+   apply (simp add: maxDom_to_H maxPrio_to_H)+
+  done
+
 lemma chooseThread_ccorres:
-  "ccorres dc xfdc all_invs_but_ct_idle_or_in_cur_domain' UNIV [] chooseThread (Call chooseThread_'proc)"
+  "ccorres dc xfdc all_invs_but_ct_idle_or_in_cur_domain' UNIV []
+     chooseThread (Call chooseThread_'proc)"
 proof -
 
   note prio_and_dom_limit_helpers [simp]
   note ksReadyQueuesL2Bitmap_nonzeroI [simp]
   note Collect_const_mem [simp]
+
+  note prio_and_dom_limit_helpers[simp] word_sle_def[simp] maxDom_to_H[simp] maxPrio_to_H[simp]
+  note invert_prioToL1Index_c_simp[simp]
   (* when numDomains = 1, array bounds checks would become _ = 0 rather than _ < 1, changing the
      shape of the proof compared to when numDomains > 1 *)
   include no_less_1_simps
@@ -192,9 +248,22 @@ proof -
     "\<And>s. invs_no_cicd' s \<Longrightarrow> ksCurDomain s \<le> maxDomain"
     by (simp add: invs_no_cicd'_def)
 
+  have invs_no_cicd'_valid_bitmaps:
+    "\<And>s. invs_no_cicd' s \<Longrightarrow> valid_bitmaps s"
+    by (simp add: invs_no_cicd'_def)
+
+  have invs_no_cicd'_pspace_aligned':
+    "\<And>s. invs_no_cicd' s \<Longrightarrow> pspace_aligned' s"
+    by (simp add: invs_no_cicd'_def valid_pspace'_def)
+
+  have invs_no_cicd'_pspace_distinct':
+    "\<And>s. invs_no_cicd' s \<Longrightarrow> pspace_distinct' s"
+    by (simp add: invs_no_cicd'_def valid_pspace'_def)
+
   show ?thesis
     supply if_split[split del]
     apply (cinit)
+     apply (rule ccorres_stateAssert)+
      apply (simp add: numDomains_sge_1_simp)
      apply (rule_tac xf'=dom_' and r'="\<lambda>rv rv'. rv' = ucast rv" in ccorres_split_nothrow_novcg)
          apply (rule ccorres_from_vcg[where P=\<top> and P'=UNIV])
@@ -227,7 +296,7 @@ proof -
          apply (rule_tac P="curdom \<le> maxDomain" in ccorres_cross_over_guard_no_st)
          apply (rule_tac P="prio \<le> maxPriority" in ccorres_cross_over_guard_no_st)
          apply (rule ccorres_pre_getQueue)
-         apply (rule_tac P="queue \<noteq> []" in ccorres_cross_over_guard_no_st)
+         apply (rule_tac P="\<not> tcbQueueEmpty queue" in ccorres_cross_over_guard_no_st)
          apply (rule ccorres_symb_exec_l)
             apply (rule ccorres_assert)
             apply (rule ccorres_symb_exec_r)
@@ -242,37 +311,40 @@ proof -
              apply (rule conseqPre, vcg)
              apply (rule Collect_mono)
              apply clarsimp
-             apply (strengthen queue_in_range)
              apply assumption
             apply clarsimp
             apply (rule conseqPre, vcg)
             apply clarsimp
            apply (wp isRunnable_wp)+
        apply (clarsimp simp: Let_def guard_is_UNIV_def)
-       apply (drule invs_no_cicd'_queues)
-       apply (case_tac queue, simp)
-       apply (clarsimp simp: tcb_queue_relation'_def cready_queues_index_to_C_def numPriorities_def)
-       apply (clarsimp simp add: maxDom_to_H maxPrio_to_H
-                                 queue_in_range[where qdom=0, simplified, simplified maxPrio_to_H])
-       apply (clarsimp simp: le_maxDomain_eq_less_numDomains unat_trans_ucast_helper )
+       apply (rule conjI)
+        apply (clarsimp simp: le_maxDomain_eq_less_numDomains unat_trans_ucast_helper)
+       apply (intro conjI impI)
+        apply (clarsimp simp: cready_queues_index_to_C_def numPriorities_def ctcb_queue_relation_def
+                              tcbQueueEmpty_def option_to_ctcb_ptr_def)
+       apply (frule_tac qdom=curdom and prio=rv in cready_queues_index_to_C_in_range')
+        apply fastforce
+       apply (clarsimp simp: num_tcb_queues_val word_less_nat_alt cready_queues_index_to_C_def2)
       apply wpsimp
      apply (clarsimp simp: guard_is_UNIV_def le_maxDomain_eq_less_numDomains word_less_nat_alt
                            numDomains_less_numeric_explicit)
-    apply (frule invs_no_cicd'_queues)
+    apply clarsimp
     apply (frule invs_no_cicd'_max_CurDomain)
-    apply (frule invs_no_cicd'_queues)
-    apply (clarsimp simp: valid_queues_def lookupBitmapPriority_le_maxPriority)
+    apply (frule invs_no_cicd'_pspace_aligned')
+    apply (frule invs_no_cicd'_pspace_distinct')
+    apply (frule invs_no_cicd'_valid_bitmaps)
+    apply (frule valid_bitmaps_bitmapQ_no_L1_orphans)
+    apply (frule valid_bitmaps_valid_bitmapQ)
+    apply (clarsimp simp: ready_queue_relation_def ksReadyQueues_asrt_def cong: conj_cong)
     apply (intro conjI impI)
-       apply (fastforce dest: bitmapQ_from_bitmap_lookup simp: valid_bitmapQ_bitmapQ_simp)
-      apply (fastforce dest: lookupBitmapPriority_obj_at'
-                       simp: pred_conj_def obj_at'_def st_tcb_at'_def)
-     apply (fastforce dest: bitmapQ_from_bitmap_lookup simp: valid_bitmapQ_bitmapQ_simp)
-    apply (clarsimp simp: pred_conj_def obj_at'_def st_tcb_at'_def)
-    apply (clarsimp simp: not_less le_maxDomain_eq_less_numDomains)
-    apply (prop_tac "ksCurDomain s = 0")
-     using unsigned_eq_0_iff apply force
-    apply (cut_tac s=s in lookupBitmapPriority_obj_at'; simp?)
-    apply (clarsimp simp: pred_conj_def obj_at'_def st_tcb_at'_def)
+         apply (fastforce intro: lookupBitmapPriority_le_maxPriority)
+        apply (fastforce dest!: bitmapQ_from_bitmap_lookup valid_bitmapQ_bitmapQ_simp)
+       apply (fastforce dest!: lookupBitmapPriority_obj_at'
+                         simp: ready_queue_relation_def ksReadyQueues_asrt_def st_tcb_at'_def obj_at'_def)
+      apply (fastforce dest: lookupBitmapPriority_le_maxPriority)
+     apply (fastforce dest!: bitmapQ_from_bitmap_lookup valid_bitmapQ_bitmapQ_simp)
+    apply (fastforce dest!: lookupBitmapPriority_obj_at'
+                      simp: ready_queue_relation_def ksReadyQueues_asrt_def st_tcb_at'_def obj_at'_def)
     done
 qed
 
@@ -596,7 +668,7 @@ lemma schedule_ccorres:
           apply (wp (once) hoare_drop_imps)
            apply wp
           apply (strengthen strenghten_False_imp[where P="a = ResumeCurrentThread" for a])
-          apply (clarsimp simp: conj_ac invs_queues invs_valid_objs' cong: conj_cong)
+          apply (clarsimp simp: conj_ac invs_valid_objs' cong: conj_cong)
           apply wp
          apply (clarsimp, vcg exspec=tcbSchedEnqueue_modifies)
         apply (clarsimp, vcg exspec=tcbSchedEnqueue_modifies)
@@ -616,9 +688,11 @@ lemma schedule_ccorres:
     apply wp
    apply vcg
 
-  apply (clarsimp simp: tcb_at_invs' rf_sr_ksCurThread if_apply_def2 invs_queues invs_valid_objs')
+  apply (clarsimp simp: tcb_at_invs' rf_sr_ksCurThread if_apply_def2 invs_valid_objs')
   apply (frule invs_sch_act_wf')
   apply (frule tcb_at_invs')
+  apply (frule invs_pspace_aligned')
+  apply (frule invs_pspace_distinct')
   apply (rule conjI)
    apply (clarsimp dest!: rf_sr_cscheduler_relation simp: cscheduler_action_relation_def)
   apply (rule conjI; clarsimp)
@@ -668,11 +742,7 @@ lemma threadSet_timeSlice_ccorres [corres]:
                    map_to_tcbs_upd)
   apply (simp add: cep_relations_drop_fun_upd cvariable_relation_upd_const
                    ko_at_projectKO_opt)
-  apply (rule conjI)
    defer
-   apply (erule cready_queues_relation_not_queue_ptrs)
-    apply (rule ext, simp split: if_split)
-   apply (rule ext, simp split: if_split)
   apply (drule ko_at_projectKO_opt)
   apply (erule (2) cmap_relation_upd_relI)
     apply (simp add: ctcb_relation_def)
@@ -716,7 +786,7 @@ lemma timerTick_ccorres:
                apply simp
                apply (ctac (no_vcg) add: tcbSchedAppend_ccorres)
                 apply (ctac add: rescheduleRequired_ccorres)
-               apply (wp weak_sch_act_wf_lift_linear threadSet_valid_queues
+               apply (wp weak_sch_act_wf_lift_linear
                          threadSet_pred_tcb_at_state tcbSchedAppend_valid_objs' threadSet_valid_objs' threadSet_tcbDomain_triv
                     | clarsimp simp: st_tcb_at'_def o_def split: if_splits)+
              apply (vcg exspec=tcbSchedDequeue_modifies)
diff --git a/proof/crefine/X64/StateRelation_C.thy b/proof/crefine/X64/StateRelation_C.thy
index 7f1b6b9949..0701acd80b 100644
--- a/proof/crefine/X64/StateRelation_C.thy
+++ b/proof/crefine/X64/StateRelation_C.thy
@@ -16,8 +16,7 @@ definition
 definition
   "array_relation r n a c \<equiv> \<forall>i \<le> n. r (a i) (index c (unat i))"
 
-(* used for bound ntfn/tcb *)
-definition
+definition option_to_ctcb_ptr :: "machine_word option \<Rightarrow> tcb_C ptr" where
   "option_to_ctcb_ptr x \<equiv> case x of None \<Rightarrow> NULL | Some t \<Rightarrow> tcb_ptr_to_ctcb_ptr t"
 
 
@@ -439,7 +438,9 @@ where
      \<and> tcbTimeSlice atcb    = unat (tcbTimeSlice_C ctcb)
      \<and> cfault_rel (tcbFault atcb) (seL4_Fault_lift (tcbFault_C ctcb))
                   (lookup_fault_lift (tcbLookupFailure_C ctcb))
-     \<and> option_to_ptr (tcbBoundNotification atcb) = tcbBoundNotification_C ctcb"
+     \<and> option_to_ptr (tcbBoundNotification atcb) = tcbBoundNotification_C ctcb
+     \<and> option_to_ctcb_ptr (tcbSchedPrev atcb) = tcbSchedPrev_C ctcb
+     \<and> option_to_ctcb_ptr (tcbSchedNext atcb) = tcbSchedNext_C ctcb"
 
 abbreviation
   "ep_queue_relation' \<equiv> tcb_queue_relation' tcbEPNext_C tcbEPPrev_C"
@@ -776,17 +777,17 @@ definition
 where
   "cready_queues_index_to_C qdom prio \<equiv> (unat qdom) * numPriorities + (unat prio)"
 
-definition cready_queues_relation ::
-  "tcb_C typ_heap \<Rightarrow> (tcb_queue_C[num_tcb_queues]) \<Rightarrow> (domain \<times> priority \<Rightarrow> ready_queue) \<Rightarrow> bool"
-where
-  "cready_queues_relation h_tcb queues aqueues \<equiv>
-     \<forall>qdom prio. ((qdom \<ge> ucast minDom \<and> qdom \<le> ucast maxDom \<and>
-                  prio \<ge> ucast minPrio \<and> prio \<le> ucast maxPrio) \<longrightarrow>
-       (let cqueue = index queues (cready_queues_index_to_C qdom prio) in
-            sched_queue_relation' h_tcb (aqueues (qdom, prio)) (head_C cqueue) (end_C cqueue)))
-        \<and> (\<not> (qdom \<ge> ucast minDom \<and> qdom \<le> ucast maxDom \<and>
-                  prio \<ge> ucast minPrio \<and> prio \<le> ucast maxPrio) \<longrightarrow> aqueues (qdom, prio) = [])"
+definition ctcb_queue_relation :: "tcb_queue \<Rightarrow> tcb_queue_C \<Rightarrow> bool" where
+   "ctcb_queue_relation aqueue cqueue \<equiv>
+      head_C cqueue = option_to_ctcb_ptr (tcbQueueHead aqueue)
+      \<and> end_C cqueue = option_to_ctcb_ptr (tcbQueueEnd aqueue)"
 
+definition cready_queues_relation ::
+  "(domain \<times> priority \<Rightarrow> ready_queue) \<Rightarrow> (tcb_queue_C[num_tcb_queues]) \<Rightarrow>  bool"
+  where
+  "cready_queues_relation aqueues cqueues \<equiv>
+     \<forall>d p. d \<le> maxDomain \<and> p \<le> maxPriority
+           \<longrightarrow> ctcb_queue_relation (aqueues (d, p)) (index cqueues (cready_queues_index_to_C d p))"
 
 abbreviation
   "cte_array_relation astate cstate
@@ -926,9 +927,7 @@ where
   "cstate_relation astate cstate \<equiv>
      let cheap = t_hrs_' cstate in
        cpspace_relation (ksPSpace astate) (underlying_memory (ksMachineState astate)) cheap \<and>
-       cready_queues_relation (clift cheap)
-                             (ksReadyQueues_' cstate)
-                             (ksReadyQueues astate) \<and>
+       cready_queues_relation (ksReadyQueues astate) (ksReadyQueues_' cstate) \<and>
        zero_ranges_are_zero (gsUntypedZeroRanges astate) cheap \<and>
        cbitmap_L1_relation (ksReadyQueuesL1Bitmap_' cstate) (ksReadyQueuesL1Bitmap astate) \<and>
        cbitmap_L2_relation (ksReadyQueuesL2Bitmap_' cstate) (ksReadyQueuesL2Bitmap astate) \<and>
diff --git a/proof/crefine/X64/SyscallArgs_C.thy b/proof/crefine/X64/SyscallArgs_C.thy
index 64903e2d1f..3ea9b0d9e3 100644
--- a/proof/crefine/X64/SyscallArgs_C.thy
+++ b/proof/crefine/X64/SyscallArgs_C.thy
@@ -48,9 +48,7 @@ lemma replyOnRestart_invs'[wp]:
   including no_pre
   apply (simp add: replyOnRestart_def)
   apply (wp setThreadState_nonqueued_state_update rfk_invs' hoare_weak_lift_imp)
-  apply (rule hoare_vcg_all_lift)
-  apply (wp setThreadState_nonqueued_state_update rfk_invs' hoare_vcg_all_lift rfk_ksQ)
-   apply (rule hoare_strengthen_post, rule gts_sp')
+  apply (rule hoare_strengthen_post, rule gts_sp')
   apply (clarsimp simp: pred_tcb_at')
   apply (auto elim!: pred_tcb'_weakenE st_tcb_ex_cap''
                dest: st_tcb_at_idle_thread')
diff --git a/proof/crefine/X64/Syscall_C.thy b/proof/crefine/X64/Syscall_C.thy
index c476fbd8b5..183bfac05e 100644
--- a/proof/crefine/X64/Syscall_C.thy
+++ b/proof/crefine/X64/Syscall_C.thy
@@ -49,8 +49,7 @@ lemma cap_cases_one_on_true_sum:
 lemma performInvocation_Endpoint_ccorres:
   "ccorres (K (K \<bottom>) \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
        (invs' and st_tcb_at' simple' thread and ep_at' epptr
-              and sch_act_sane and (\<lambda>s. thread = ksCurThread s
-              \<and> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))))
+              and sch_act_sane and (\<lambda>s. thread = ksCurThread s))
        (UNIV \<inter> {s. block_' s = from_bool blocking}
              \<inter> {s. call_' s = from_bool do_call}
              \<inter> {s. badge_' s = badge}
@@ -122,7 +121,6 @@ lemma decodeInvocation_ccorres:
               and (\<lambda>s. \<forall>v \<in> set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s)
               and (\<lambda>s. \<forall>v \<in> set extraCaps. s \<turnstile>' fst v \<and> cte_at' (snd v) s)
               and (\<lambda>s. \<forall>v \<in> set extraCaps. \<forall>y \<in> zobj_refs' (fst v). ex_nonz_cap_to' y s)
-              and (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))
               and sysargs_rel args buffer)
        (UNIV \<inter> {s. call_' s = from_bool isCall}
              \<inter> {s. block_' s = from_bool isBlocking}
@@ -198,7 +196,7 @@ lemma decodeInvocation_ccorres:
       apply simp
       apply (rule hoare_use_eq[where f=ksCurThread])
        apply (wp sts_invs_minor' sts_st_tcb_at'_cases
-                 setThreadState_ct' hoare_vcg_all_lift sts_ksQ')+
+                 setThreadState_ct' hoare_vcg_all_lift)+
      apply simp
      apply (vcg exspec=setThreadState_modifies)
     apply vcg
@@ -506,7 +504,7 @@ lemma wordFromMessageInfo_spec:
 
 lemma handleDoubleFault_ccorres:
   "ccorres dc xfdc (invs' and  tcb_at' tptr and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and
-        sch_act_not tptr and (\<lambda>s. \<forall>p. tptr \<notin> set (ksReadyQueues s p)))
+        sch_act_not tptr)
       (UNIV \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr tptr})
       [] (handleDoubleFault tptr ex1 ex2)
          (Call handleDoubleFault_'proc)"
@@ -571,8 +569,7 @@ lemma hrs_mem_update_use_hrs_mem:
 
 lemma sendFaultIPC_ccorres:
   "ccorres  (cfault_rel2 \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
-      (invs' and st_tcb_at' simple' tptr and sch_act_not tptr and
-       (\<lambda>s. \<forall>p. tptr \<notin> set (ksReadyQueues s p)))
+      (invs' and st_tcb_at' simple' tptr and sch_act_not tptr)
       (UNIV \<inter> {s. (cfault_rel (Some fault) (seL4_Fault_lift(current_fault_' (globals s)))
                        (lookup_fault_lift(current_lookup_fault_' (globals s))))}
             \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr tptr})
@@ -649,8 +646,8 @@ lemma sendFaultIPC_ccorres:
               apply (ctac (no_vcg) add: sendIPC_ccorres)
                apply (ctac (no_vcg) add: ccorres_return_CE [unfolded returnOk_def comp_def])
               apply wp
-             apply (wp threadSet_pred_tcb_no_state threadSet_invs_trivial threadSet_typ_at_lifts
-                    | simp)+
+             apply (wpsimp wp: threadSet_invs_trivial)
+             apply (wpsimp wp: threadSet_pred_tcb_no_state threadSet_typ_at_lifts)
 
             apply (clarsimp simp: guard_is_UNIV_def)
             apply (subgoal_tac "capEPBadge epcap && mask 64 = capEPBadge epcap")
@@ -683,8 +680,7 @@ lemma sendFaultIPC_ccorres:
          apply vcg
         apply (clarsimp simp: inQ_def)
         apply (rule_tac Q="\<lambda>a b. invs' b \<and> st_tcb_at' simple' tptr b
-                                 \<and> sch_act_not tptr b \<and> valid_cap' a b
-                                 \<and> (\<forall>p. tptr \<notin> set (ksReadyQueues b p))"
+                                 \<and> sch_act_not tptr b \<and> valid_cap' a b"
                  and E="\<lambda> _. \<top>"
                  in hoare_post_impErr)
           apply (wp)
@@ -699,8 +695,7 @@ lemma sendFaultIPC_ccorres:
   done
 
 lemma handleFault_ccorres:
-  "ccorres dc xfdc (invs' and st_tcb_at' simple' t and
-        sch_act_not t and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p)))
+  "ccorres dc xfdc (invs' and st_tcb_at' simple' t and sch_act_not t)
       (UNIV \<inter> {s. (cfault_rel (Some flt) (seL4_Fault_lift(current_fault_' (globals s)))
                        (lookup_fault_lift(current_lookup_fault_' (globals s))) )}
             \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr t})
@@ -764,9 +759,7 @@ lemma getMRs_length:
 
 lemma handleInvocation_ccorres:
   "ccorres (K dc \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
-       (invs' and
-        ct_active' and sch_act_simple and
-        (\<lambda>s. \<forall>x. ksCurThread s \<notin> set (ksReadyQueues s x)))
+       (invs' and ct_active' and sch_act_simple)
        (UNIV \<inter> {s. isCall_' s = from_bool isCall}
              \<inter> {s. isBlocking_' s = from_bool isBlocking}) []
        (handleInvocation isCall isBlocking) (Call handleInvocation_'proc)"
@@ -894,7 +887,7 @@ lemma handleInvocation_ccorres:
                      apply (wp hoare_split_bind_case_sumE hoare_drop_imps
                                setThreadState_nonqueued_state_update
                                ct_in_state'_set setThreadState_st_tcb
-                               hoare_vcg_all_lift sts_ksQ'
+                               hoare_vcg_all_lift
                                  | wpc | wps)+
                     apply auto[1]
                    apply clarsimp
@@ -1154,9 +1147,6 @@ lemma ccorres_trim_redundant_throw_break:
 lemma invs_valid_objs_strengthen:
   "invs' s \<longrightarrow> valid_objs' s" by fastforce
 
-lemma ct_not_ksQ_strengthen:
-  "thread = ksCurThread s \<and> ksCurThread s \<notin> set (ksReadyQueues s p) \<longrightarrow> thread \<notin> set (ksReadyQueues s p)" by fastforce
-
 lemma option_to_ctcb_ptr_valid_ntfn:
   "valid_ntfn' ntfn s ==> (option_to_ctcb_ptr (ntfnBoundTCB ntfn) = NULL) = (ntfnBoundTCB ntfn = None)"
   apply (cases "ntfnBoundTCB ntfn", simp_all add: option_to_ctcb_ptr_def)
@@ -1190,8 +1180,7 @@ lemma handleRecv_ccorres:
   notes rf_sr_upd_safe[simp del]
   shows
   "ccorres dc xfdc
-       (\<lambda>s. invs' s \<and> st_tcb_at' simple' (ksCurThread s) s
-               \<and> sch_act_sane s \<and> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)))
+       (\<lambda>s. invs' s \<and> st_tcb_at' simple' (ksCurThread s) s \<and> sch_act_sane s)
        {s. isBlocking_' s = from_bool isBlocking}
        []
        (handleRecv isBlocking)
@@ -1255,7 +1244,7 @@ lemma handleRecv_ccorres:
             apply (rule_tac P="\<lambda>s. ksCurThread s = thread" in ccorres_cross_over_guard)
             apply (ctac add: receiveIPC_ccorres)
 
-           apply (wp deleteCallerCap_ksQ_ct' hoare_vcg_all_lift)
+           apply (wp hoare_vcg_all_lift)
           apply (rule conseqPost[where Q'=UNIV and A'="{}"], vcg exspec=deleteCallerCap_modifies)
            apply (clarsimp dest!: rf_sr_ksCurThread)
           apply simp
@@ -1378,13 +1367,11 @@ lemma handleRecv_ccorres:
       apply clarsimp
       apply (rename_tac thread epCPtr)
         apply (rule_tac Q'="(\<lambda>rv s. invs' s \<and> st_tcb_at' simple' thread s
-               \<and> sch_act_sane s \<and> (\<forall>p. thread \<notin> set (ksReadyQueues s p)) \<and> thread = ksCurThread s
+               \<and> sch_act_sane s \<and> thread = ksCurThread s
                \<and> valid_cap' rv s)" in hoare_post_imp_R[rotated])
-         apply (clarsimp simp: sch_act_sane_def)
-         apply (auto dest!: obj_at_valid_objs'[OF _ invs_valid_objs']
-                      simp: projectKOs valid_obj'_def,
-                auto simp: pred_tcb_at'_def obj_at'_def objBits_simps projectKOs ct_in_state'_def)[1]
-         apply wp
+       apply (intro conjI impI allI; clarsimp simp: sch_act_sane_def)
+       apply (fastforce dest: obj_at_valid_objs'[OF _ invs_valid_objs'] ko_at_valid_ntfn')
+      apply wp
      apply clarsimp
      apply (vcg exspec=isStopped_modifies exspec=lookupCap_modifies)
 
@@ -1433,7 +1420,7 @@ lemma handleYield_ccorres:
        apply (ctac add: rescheduleRequired_ccorres)
       apply (wp weak_sch_act_wf_lift_linear tcbSchedAppend_valid_objs')
      apply (vcg exspec= tcbSchedAppend_modifies)
-    apply (wp weak_sch_act_wf_lift_linear tcbSchedDequeue_valid_queues)
+    apply (wp weak_sch_act_wf_lift_linear)
    apply (vcg exspec= tcbSchedDequeue_modifies)
   apply (clarsimp simp: tcb_at_invs' invs_valid_objs'
                         valid_objs'_maxPriority valid_objs'_maxDomain)
@@ -1590,8 +1577,7 @@ lemma ccorres_return_void_C_Seq:
 
 lemma ccorres_handleReservedIRQ:
   "ccorres dc xfdc
-    (invs' and (\<lambda>s. irq \<in> non_kernel_IRQs \<longrightarrow> sch_act_not (ksCurThread s) s \<and>
-                     (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))))
+    (invs' and (\<lambda>s. irq \<in> non_kernel_IRQs \<longrightarrow> sch_act_not (ksCurThread s) s))
     (UNIV \<inter> {s. irq_' s = ucast irq}) hs
     (handleReservedIRQ irq) (Call handleReservedIRQ_'proc)"
   apply (cinit lift: irq_')
@@ -1601,8 +1587,7 @@ lemma ccorres_handleReservedIRQ:
 
 lemma handleInterrupt_ccorres:
   "ccorres dc xfdc
-     (invs' and (\<lambda>s. irq \<in> non_kernel_IRQs \<longrightarrow> sch_act_not (ksCurThread s) s \<and>
-                     (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))))
+     (invs' and (\<lambda>s. irq \<in> non_kernel_IRQs \<longrightarrow> sch_act_not (ksCurThread s) s))
      (UNIV \<inter> \<lbrace>\<acute>irq = ucast irq\<rbrace>)
      hs
      (handleInterrupt irq)
diff --git a/proof/crefine/X64/TcbQueue_C.thy b/proof/crefine/X64/TcbQueue_C.thy
index a35c839555..7a79843bdf 100644
--- a/proof/crefine/X64/TcbQueue_C.thy
+++ b/proof/crefine/X64/TcbQueue_C.thy
@@ -964,49 +964,6 @@ lemma tcb_queue_relation'_prev_sign:
 \<Longrightarrow> sign_extend 47 (ptr_val (getPrev tcb)) = ptr_val (getPrev tcb)"
   by (rule tcb_queue_relation_prev_sign [OF tcb_queue_relation'_queue_rel])
 
-
-lemma cready_queues_relation_null_queue_ptrs:
-  assumes rel: "cready_queues_relation mp cq aq"
-  and same: "option_map tcb_null_ep_ptrs \<circ> mp' = option_map tcb_null_ep_ptrs \<circ> mp"
-  shows "cready_queues_relation mp' cq aq"
-  using rel
-  apply (clarsimp simp: cready_queues_relation_def Let_def all_conj_distrib)
-  apply (drule spec, drule spec, drule mp, (erule conjI)+, assumption)
-  apply (clarsimp simp: tcb_queue_relation'_def)
-  apply (erule iffD2 [OF tcb_queue_relation_only_next_prev, rotated -1])
-   apply (rule ext)
-   apply (case_tac "mp' x")
-    apply (frule compD [OF same])
-    apply simp
-   apply (frule compD [OF same])
-   apply (clarsimp simp: tcb_null_ep_ptrs_def)
-   apply (case_tac z, case_tac a)
-   apply simp
-  \<comment> \<open>clag\<close>
-  apply (rule ext)
-  apply (case_tac "mp' x")
-   apply (frule compD [OF same])
-   apply simp
-  apply (frule compD [OF same])
-  apply (clarsimp simp: tcb_null_ep_ptrs_def)
-  apply (case_tac z, case_tac a)
-  apply simp
-  done
-
-lemma cready_queues_relation_not_queue_ptrs:
-  assumes rel: "cready_queues_relation mp cq aq"
-  and same: "option_map tcbSchedNext_C \<circ> mp' = option_map tcbSchedNext_C \<circ> mp"
-  "option_map tcbSchedPrev_C \<circ> mp' = option_map tcbSchedPrev_C \<circ> mp"
-  shows "cready_queues_relation mp' cq aq"
-  using rel
-  apply (clarsimp simp: cready_queues_relation_def tcb_queue_relation'_def Let_def all_conj_distrib)
-  apply (drule spec, drule spec, drule mp, (erule conjI)+, assumption)
-  apply clarsimp
-  apply (erule iffD2 [OF tcb_queue_relation_only_next_prev, rotated -1])
-   apply (rule same)
-  apply (rule same)
-  done
-
 lemma ntfn_ep_disjoint:
   assumes  srs: "sym_refs (state_refs_of' s)"
   and     epat: "ko_at' ep epptr s"
@@ -1455,8 +1412,6 @@ lemma rf_sr_tcb_update_no_queue:
                                           (t_hrs_' (globals s'));
      tcbEPNext_C ctcb = tcbEPNext_C (the (cslift s' (tcb_ptr_to_ctcb_ptr thread)));
      tcbEPPrev_C ctcb = tcbEPPrev_C (the (cslift s' (tcb_ptr_to_ctcb_ptr thread)));
-     tcbSchedNext_C ctcb = tcbSchedNext_C (the (cslift s' (tcb_ptr_to_ctcb_ptr thread)));
-     tcbSchedPrev_C ctcb = tcbSchedPrev_C (the (cslift s' (tcb_ptr_to_ctcb_ptr thread)));
      fpuState_C (tcbContext_C (tcbArch_C ctcb))
        = fpuState_C (tcbContext_C (tcbArch_C (the (cslift s' (tcb_ptr_to_ctcb_ptr thread)))));
      (\<forall>x\<in>ran tcb_cte_cases. (\<lambda>(getF, setF). getF tcb' = getF tcb) x);
@@ -1484,20 +1439,11 @@ lemma rf_sr_tcb_update_no_queue:
      apply (rule cnotification_relation_upd_tcb_no_queues, assumption+)
       subgoal by (clarsimp intro!: ext)
      subgoal by (clarsimp intro!: ext)
-    apply (erule cready_queues_relation_not_queue_ptrs)
-     subgoal by (clarsimp intro!: ext)
-    subgoal by (clarsimp intro!: ext)
    subgoal by (clarsimp simp: carch_state_relation_def fpu_null_state_preservation typ_heap_simps')
   by (simp add: cmachine_state_relation_def)
 
-lemma rf_sr_tcb_update_no_queue_helper:
-  "(s, s'\<lparr> globals := globals s' \<lparr> t_hrs_' := t_hrs_' (globals (undefined
-              \<lparr> globals := (undefined \<lparr> t_hrs_' := f (globals s') (t_hrs_' (globals s')) \<rparr>)\<rparr>))\<rparr>\<rparr>) \<in> rf_sr
-          \<Longrightarrow> (s, globals_update (\<lambda>v. t_hrs_'_update (f v) v) s') \<in> rf_sr"
-  by (simp cong: StateSpace.state.fold_congs globals.fold_congs)
-
-lemmas rf_sr_tcb_update_no_queue2
-    = rf_sr_tcb_update_no_queue_helper [OF rf_sr_tcb_update_no_queue, simplified]
+lemmas rf_sr_tcb_update_no_queue2 =
+  rf_sr_obj_update_helper[OF rf_sr_tcb_update_no_queue, simplified]
 
 lemma tcb_queue_relation_not_in_q:
   "ctcb_ptr_to_tcb_ptr x \<notin> set xs \<Longrightarrow>
@@ -1545,13 +1491,7 @@ lemma rf_sr_tcb_update_not_in_queue:
      apply (drule(1) map_to_ko_atI')
      apply (drule sym_refs_ko_atD', clarsimp+)
      subgoal by blast
-    apply (simp add: cready_queues_relation_def, erule allEI)
     apply (clarsimp simp: Let_def)
-    apply (subst tcb_queue_relation_not_in_q)
-     apply clarsimp
-     apply (drule valid_queues_obj_at'D, clarsimp)
-     apply (clarsimp simp: obj_at'_def projectKOs inQ_def)
-    subgoal by simp
    apply (simp add: carch_state_relation_def)
    subgoal by (clarsimp simp: fpu_null_state_heap_update_span_disjoint[OF tcb_at'_non_kernel_data_ref']
                               global_ioport_bitmap_heap_update_tag_disj_simps obj_at'_def projectKOs)
diff --git a/proof/crefine/X64/Tcb_C.thy b/proof/crefine/X64/Tcb_C.thy
index 08558cbc95..44b64ceebf 100644
--- a/proof/crefine/X64/Tcb_C.thy
+++ b/proof/crefine/X64/Tcb_C.thy
@@ -59,8 +59,6 @@ lemma doMachineOp_sched:
   done
 
 context begin interpretation Arch . (*FIXME: arch_split*)
-crunch queues[wp]: setupReplyMaster "valid_queues"
-  (simp: crunch_simps wp: crunch_wps)
 
 crunch curThread [wp]: restart "\<lambda>s. P (ksCurThread s)"
   (wp: crunch_wps simp: crunch_simps)
@@ -391,9 +389,10 @@ lemma hrs_mem_update_cong:
 
 lemma setPriority_ccorres:
   "ccorres dc xfdc
-      (\<lambda>s. tcb_at' t s \<and> Invariants_H.valid_queues s \<and>  ksCurDomain s \<le> maxDomain \<and>
-           valid_queues' s \<and> valid_objs' s \<and> weak_sch_act_wf (ksSchedulerAction s) s \<and> (priority \<le> maxPriority))
-      (UNIV \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr t} \<inter> {s. prio_' s = ucast priority})
+      (\<lambda>s. tcb_at' t s \<and> ksCurDomain s \<le> maxDomain \<and>
+           valid_objs' s \<and> weak_sch_act_wf (ksSchedulerAction s) s \<and> (priority \<le> maxPriority) \<and>
+           pspace_aligned' s \<and> pspace_distinct' s)
+      ({s. tptr_' s = tcb_ptr_to_ctcb_ptr t} \<inter> {s. prio_' s = ucast priority})
       [] (setPriority t priority) (Call setPriority_'proc)"
   apply (cinit lift: tptr_' prio_')
    apply (ctac(no_vcg) add: tcbSchedDequeue_ccorres)
@@ -416,7 +415,7 @@ lemma setPriority_ccorres:
         apply (ctac add: possibleSwitchTo_ccorres)
        apply (rule ccorres_return_Skip')
       apply (wp isRunnable_wp)
-     apply (wpsimp wp: hoare_drop_imps threadSet_valid_queues threadSet_valid_objs'
+     apply (wpsimp wp: hoare_drop_imps threadSet_valid_objs'
                        weak_sch_act_wf_lift_linear threadSet_pred_tcb_at_state
                        threadSet_tcbDomain_triv
                  simp: st_tcb_at'_def o_def split: if_splits)
@@ -425,18 +424,13 @@ lemma setPriority_ccorres:
                  where Q="\<lambda>rv s.
                           obj_at' (\<lambda>_. True) t s \<and>
                           priority \<le> maxPriority \<and>
-                          Invariants_H.valid_queues s \<and>
                           ksCurDomain s \<le> maxDomain \<and>
                           valid_objs' s \<and>
-                          valid_queues' s \<and>
                           weak_sch_act_wf (ksSchedulerAction s) s \<and>
-                          (\<forall>d p. \<not> t \<in> set (ksReadyQueues s (d, p)))"])
-    apply (wp weak_sch_act_wf_lift_linear tcbSchedDequeue_valid_queues tcbSchedDequeue_nonq)
+                          pspace_aligned' s \<and> pspace_distinct' s"])
+    apply (wp weak_sch_act_wf_lift_linear valid_tcb'_def)
    apply (clarsimp simp: valid_tcb'_tcbPriority_update)
   apply clarsimp
-  apply (frule (1) valid_objs'_maxDomain[where t=t])
-  apply (frule (1) valid_objs'_maxPriority[where t=t])
-  apply simp
   done
 
 lemma setMCPriority_ccorres:
@@ -681,12 +675,12 @@ lemma invokeTCB_ThreadControl_ccorres:
                         apply (clarsimp simp : guard_is_UNIV_def Collect_const_mem)
                        apply (rule hoare_strengthen_post[
                                     where Q= "\<lambda>rv s.
-                                              Invariants_H.valid_queues s \<and>
                                               valid_objs' s \<and>
                                               weak_sch_act_wf (ksSchedulerAction s) s \<and>
                                               ((\<exists>a b. priority = Some (a, b)) \<longrightarrow>
                                                    tcb_at' target s \<and> ksCurDomain s \<le> maxDomain \<and>
-                                                   valid_queues' s \<and>  fst (the priority) \<le> maxPriority)"])
+                                                   fst (the priority) \<le> maxPriority) \<and>
+                                              pspace_aligned' s \<and> pspace_distinct' s"])
                         apply (strengthen sch_act_wf_weak)
                         apply (wp hoare_weak_lift_imp)
                        apply (clarsimp split: if_splits)
@@ -774,12 +768,12 @@ lemma invokeTCB_ThreadControl_ccorres:
                apply (clarsimp simp : guard_is_UNIV_def Collect_const_mem)
               apply (simp cong: conj_cong)
               apply (rule hoare_strengthen_post[
-                            where Q="\<lambda>a b. (Invariants_H.valid_queues b \<and>
-                                       valid_objs' b \<and>
+                            where Q="\<lambda>a b. (valid_objs' b \<and>
                                        sch_act_wf (ksSchedulerAction b) b \<and>
+                                       pspace_aligned' b \<and> pspace_distinct' b \<and>
                                        ((\<exists>a b. priority = Some (a, b)) \<longrightarrow>
                                           tcb_at'  target b \<and>
-                                          ksCurDomain b \<le> maxDomain \<and> valid_queues' b \<and>
+                                          ksCurDomain b \<le> maxDomain \<and>
                                           fst (the priority) \<le> maxPriority)) \<and>
                                        ((case snd (the buf)
                                            of None \<Rightarrow> 0
@@ -801,15 +795,15 @@ lemma invokeTCB_ThreadControl_ccorres:
                prefer 2
                apply fastforce
               apply (strengthen cte_is_derived_capMasterCap_strg
-                                invs_queues invs_weak_sch_act_wf invs_sch_act_wf'
+                                invs_weak_sch_act_wf invs_sch_act_wf'
                                 invs_valid_objs' invs_mdb' invs_pspace_aligned',
                             simp add: o_def)
               apply (rule_tac P="is_aligned (fst (the buf)) msg_align_bits"
                        in hoare_gen_asm)
               apply (wp threadSet_ipcbuffer_trivial hoare_weak_lift_imp
                      | simp
-                     | strengthen invs_sch_act_wf' invs_valid_objs' invs_weak_sch_act_wf invs_queues
-                                  invs_valid_queues' | wp hoare_drop_imps)+
+                     | strengthen invs_sch_act_wf' invs_valid_objs' invs_weak_sch_act_wf
+                     | wp hoare_drop_imps)+
              apply (clarsimp simp: guard_is_UNIV_def Collect_const_mem
                                    option_to_0_def
                             split: option.split_asm)
@@ -818,7 +812,7 @@ lemma invokeTCB_ThreadControl_ccorres:
              apply (rule ccorres_return_C_errorE, simp+)[1]
             apply vcg
            apply (simp add: conj_comms cong: conj_cong)
-           apply (strengthen invs_ksCurDomain_maxDomain')
+           apply (strengthen invs_ksCurDomain_maxDomain' invs_pspace_distinct')
            apply (wp hoare_vcg_const_imp_lift_R cteDelete_invs')
           apply simp
           apply (rule ccorres_split_nothrow_novcg_dc)
@@ -835,8 +829,7 @@ lemma invokeTCB_ThreadControl_ccorres:
          apply (rule conjI)
           apply (clarsimp simp: objBits_simps' word_bits_conv case_option_If2 if_n_0_0 valid_cap'_def
                                 capAligned_def obj_at'_def projectKOs)
-         apply (clarsimp simp: invs_valid_objs' invs_valid_queues'
-                               Invariants_H.invs_queues invs_ksCurDomain_maxDomain')
+         apply (fastforce simp: invs_valid_objs' invs_ksCurDomain_maxDomain')
         apply (rule ccorres_Cond_rhs_Seq)
          apply (rule ccorres_rhs_assoc)+
          apply csymbr
@@ -1066,7 +1059,7 @@ lemma restart_ccorres:
         apply (ctac(no_vcg) add: tcbSchedEnqueue_ccorres)
          apply (ctac add: possibleSwitchTo_ccorres)
         apply (wp weak_sch_act_wf_lift)[1]
-       apply (wp sts_valid_queues setThreadState_st_tcb)[1]
+       apply (wp sts_valid_objs' setThreadState_st_tcb)[1]
       apply (simp add: valid_tcb_state'_def)
       apply wp
       apply (wp (once) sch_act_wf_lift, (wp tcb_in_cur_domain'_lift)+)
@@ -1688,7 +1681,7 @@ lemma invokeTCB_WriteRegisters_ccorres[where S=UNIV]:
   apply (clarsimp simp: frame_gp_registers_convs word_less_nat_alt
                         sysargs_rel_def n_frameRegisters_def n_msgRegisters_def
                   split: if_split_asm)
-  apply (simp add: invs_weak_sch_act_wf invs_valid_objs' invs_queues)
+  apply (simp add: invs_weak_sch_act_wf invs_valid_objs')
   apply (fastforce dest!: global'_no_ex_cap simp: invs'_def valid_state'_def)
   done
 
@@ -3152,7 +3145,8 @@ lemma decodeTCBConfigure_ccorres:
    apply (rule conjI, fastforce)
    apply (drule interpret_excaps_eq)
    apply (clarsimp simp: cte_wp_at_ctes_of valid_tcb_state'_def numeral_eqs le_ucast_ucast_le
-                         tcb_at_invs' invs_valid_objs' invs_queues invs_sch_act_wf'
+                         tcb_at_invs' invs_valid_objs' invs_sch_act_wf'
+                         invs_pspace_aligned' invs_pspace_distinct'
                          ct_in_state'_def pred_tcb_at'_def obj_at'_def tcb_st_refs_of'_def)
    apply (erule disjE; simp add: objBits_defs mask_def)
   apply (clarsimp simp: idButNot_def interpret_excaps_test_null
@@ -4450,9 +4444,9 @@ lemma invokeTCB_SetTLSBase_ccorres:
        apply (rule ccorres_return_CE, simp+)[1]
       apply (wpsimp wp: hoare_drop_imp simp: guard_is_UNIV_def)+
    apply vcg
-  apply (clarsimp simp: tlsBaseRegister_def X64.tlsBaseRegister_def
-                        invs_weak_sch_act_wf invs_queues TLS_BASE_def FS_BASE_def
-                 split: if_split)
+  apply (fastforce simp: tlsBaseRegister_def X64.tlsBaseRegister_def
+                         invs_weak_sch_act_wf TLS_BASE_def FS_BASE_def
+                  split: if_split)
   done
 
 lemma decodeSetTLSBase_ccorres:
diff --git a/proof/crefine/X64/Wellformed_C.thy b/proof/crefine/X64/Wellformed_C.thy
index ed017823e2..aad234acd3 100644
--- a/proof/crefine/X64/Wellformed_C.thy
+++ b/proof/crefine/X64/Wellformed_C.thy
@@ -165,10 +165,6 @@ where
 abbreviation
   "ep_queue_relation \<equiv> tcb_queue_relation tcbEPNext_C tcbEPPrev_C"
 
-abbreviation
-  "sched_queue_relation \<equiv> tcb_queue_relation tcbSchedNext_C tcbSchedPrev_C"
-
-
 definition
 wordSizeCase :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" where
 "wordSizeCase a b \<equiv> (if bitSize (undefined::machine_word) = 32
diff --git a/proof/infoflow/Scheduler_IF.thy b/proof/infoflow/Scheduler_IF.thy
index 38cfe61b94..1ab0401fbe 100644
--- a/proof/infoflow/Scheduler_IF.thy
+++ b/proof/infoflow/Scheduler_IF.thy
@@ -1439,10 +1439,6 @@ lemma cur_thread_cur_domain:
   by (clarsimp simp: pred_tcb_at_def invs_def valid_idle_def
                      valid_state_def obj_at_def guarded_pas_domain_def)
 
-lemma valid_sched_valid_queues[intro]:
-  "valid_sched s \<Longrightarrow> valid_queues s"
-  by (simp add: valid_sched_def)
-
 lemma ethread_get_wp2:
   "\<lbrace>\<lambda>s. \<forall>etcb. etcb_at ((=) etcb) t s \<longrightarrow> Q (f etcb) s\<rbrace>
    ethread_get f t
diff --git a/proof/infoflow/refine/ADT_IF_Refine.thy b/proof/infoflow/refine/ADT_IF_Refine.thy
index f8f1ac5008..e6ac3cdc5c 100644
--- a/proof/infoflow/refine/ADT_IF_Refine.thy
+++ b/proof/infoflow/refine/ADT_IF_Refine.thy
@@ -304,9 +304,12 @@ lemma kernel_entry_if_corres:
       apply (rule corres_split)
          apply simp
          apply (rule threadset_corresT)
-            apply (erule arch_tcb_context_set_tcb_relation)
-           apply (clarsimp simp: tcb_cap_cases_def)
-          apply (rule allI[OF ball_tcb_cte_casesI]; clarsimp)
+               apply (erule arch_tcb_context_set_tcb_relation)
+              apply (clarsimp simp: tcb_cap_cases_def)
+             apply (rule allI[OF ball_tcb_cte_casesI]; clarsimp)
+            apply fastforce
+           apply fastforce
+          apply fastforce
          apply (simp add: exst_same_def)
         apply (rule corres_split[OF handleEvent_corres_arch_extras])
           apply (rule corres_stateAssert_assume_stronger[where Q=\<top> and
@@ -506,7 +509,7 @@ lemma scheduler'_if_ex_abs[wp]:
    apply wp
   apply (clarsimp simp: ex_abs_def)
   apply (rule exI, rule conjI, assumption)
-  apply (frule state_relation_schact)
+  apply (frule state_relation_sched_act_relation)
   apply (auto simp: domain_list_rel_eq domain_time_rel_eq)
   done
 
@@ -1161,7 +1164,7 @@ lemma st_tcb_at_coerce_haskell:
   apply (drule_tac x=t in bspec)
    apply fastforce
   apply clarsimp
-  apply (simp add: other_obj_relation_def)
+  apply (simp add: tcb_relation_cut_def)
   apply clarsimp
   apply (clarsimp simp: obj_at'_def projectKO_eq projectKO_tcb split: kernel_object.splits)
   apply (rule_tac x="tcb_state tcb" in exI)
diff --git a/proof/infoflow/refine/ADT_IF_Refine_C.thy b/proof/infoflow/refine/ADT_IF_Refine_C.thy
index 6f4e5e95f9..2141ade052 100644
--- a/proof/infoflow/refine/ADT_IF_Refine_C.thy
+++ b/proof/infoflow/refine/ADT_IF_Refine_C.thy
@@ -150,7 +150,8 @@ lemma cur_thread_of_absKState[simp]:
    by (clarsimp simp: cstate_relation_def Let_def absKState_def cstate_to_H_def)
 
 lemma absKState_crelation:
-  "\<lbrakk> cstate_relation s (globals s'); invs' s \<rbrakk> \<Longrightarrow>  cstate_to_A s' = absKState s"
+  "\<lbrakk> cstate_relation s (globals s'); invs' s; ksReadyQueues_asrt s\<rbrakk>
+   \<Longrightarrow>  cstate_to_A s' = absKState s"
   apply (clarsimp simp add: cstate_to_H_correct invs'_def cstate_to_A_def)
   apply (clarsimp simp: absKState_def absExst_def observable_memory_def)
   apply (case_tac s)
@@ -224,8 +225,7 @@ locale ADT_IF_Refine_1 = kernel_m +
              (handleEvent Interrupt) (handleInterruptEntry_C_body_if)"
   and handleInvocation_ccorres':
     "ccorres (K dc \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
-       (invs' and arch_extras and ct_active' and sch_act_simple
-              and (\<lambda>s. \<forall>x. ksCurThread s \<notin> set (ksReadyQueues s x)))
+       (invs' and arch_extras and ct_active' and sch_act_simple)
        (UNIV \<inter> {s. isCall_' s = from_bool isCall} \<inter> {s. isBlocking_' s = from_bool isBlocking}) []
        (handleInvocation isCall isBlocking) (Call handleInvocation_'proc)"
   and check_active_irq_corres_C:
@@ -269,11 +269,10 @@ lemma handleEvent_ccorres:
                apply wp[1]
               apply clarsimp
               apply wp
-              apply (rule_tac Q="\<lambda>rv s. ct_in_state' simple' s \<and> sch_act_sane s \<and>
-                                 (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))"
+              apply (rule_tac Q="\<lambda>rv s. ct_in_state' simple' s \<and> sch_act_sane s"
                     in hoare_post_imp)
                apply (simp add: ct_in_state'_def)
-              apply (wp handleReply_sane handleReply_ct_not_ksQ)
+              apply (wp handleReply_sane)
              \<comment> \<open>SysSend\<close>
              apply (simp add: handleSend_def)
              apply (ctac (no_vcg) add: handleInvocation_ccorres)
@@ -356,7 +355,7 @@ lemma handleEvent_ccorres:
       apply (clarsimp simp: return_def)
      apply wp
     apply (simp add: guard_is_UNIV_def)
-   apply (auto simp: ct_in_state'_def ct_not_ksQ isReply_def is_cap_fault_def
+   apply (auto simp: ct_in_state'_def isReply_def is_cap_fault_def
                      cfault_rel_def seL4_Fault_UnknownSyscall_lift seL4_Fault_UserException_lift
                elim: pred_tcb'_weakenE st_tcb_ex_cap''
                dest: st_tcb_at_idle_thread' rf_sr_ksCurThread)
@@ -613,7 +612,6 @@ definition ADT_C_if where
                               (kernel_call_C_if fp) handle_preemption_C_if
                               schedule_C_if kernel_exit_C_if)\<rparr>"
 
-
 lemma c_to_haskell:
   "uop_nonempty uop
    \<Longrightarrow> global_automata_refine checkActiveIRQ_H_if (doUserOp_H_if uop) kernelCall_H_if
@@ -626,12 +624,16 @@ lemma c_to_haskell:
    apply (unfold_locales)
                         apply (simp add: ADT_C_if_def)
                        apply (simp_all add: preserves_trivial preserves'_trivial)
+          apply (clarsimp simp: full_invs_if'_def ex_abs_def)
+          apply (frule ksReadyQueues_asrt_cross[OF state_relation_ready_queues_relation])
           apply (clarsimp simp: lift_snd_rel_def ADT_C_if_def ADT_H_if_def absKState_crelation
                                 rf_sr_def full_invs_if'_def)
           apply (clarsimp simp: rf_sr_def full_invs_if'_def ex_abs_def)
          apply (simp add: ADT_H_if_def ADT_C_if_def lift_fst_rel_def lift_snd_rel_def)
-         apply safe
-         apply (clarsimp simp: absKState_crelation  rf_sr_def full_invs_if'_def)
+         apply (clarsimp simp: full_invs_if'_def)
+         apply (frule ex_abs_ksReadyQueues_asrt)
+         apply (clarsimp simp: absKState_crelation  rf_sr_def)
+         apply (frule invs_valid_stateI')
          apply (rule_tac x="((a,bb),ba)" in bexI)
           apply simp
          apply simp
@@ -642,7 +644,8 @@ lemma c_to_haskell:
                              kernelCall_H_if_def kernel_call_C_if_def
                              handlePreemption_H_if_def handle_preemption_C_if_def
                              schedule'_H_if_def schedule_C_if_def
-                             kernelExit_H_if_def kernel_exit_C_if_def)
+                             kernelExit_H_if_def kernel_exit_C_if_def invs'_def)
+         apply (clarsimp split: sys_mode.splits)
         apply (rule step_corres_lifts,rule corres_guard_imp[OF check_active_irq_corres_C]; fastforce simp: full_invs_if'_def)
        apply (rule step_corres_lifts,rule corres_guard_imp[OF check_active_irq_corres_C]; fastforce simp: full_invs_if'_def)
       apply (rule step_corres_lifts,rule corres_guard_imp[OF do_user_op_if_C_corres]; auto simp: full_invs_if'_def ex_abs_def)
diff --git a/proof/infoflow/refine/ARM/ArchADT_IF_Refine_C.thy b/proof/infoflow/refine/ARM/ArchADT_IF_Refine_C.thy
index 18518c2964..24dae6043c 100644
--- a/proof/infoflow/refine/ARM/ArchADT_IF_Refine_C.thy
+++ b/proof/infoflow/refine/ARM/ArchADT_IF_Refine_C.thy
@@ -49,9 +49,7 @@ qed
 
 lemma handleInvocation_ccorres'[ADT_IF_Refine_assms]:
   "ccorres (K dc \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
-       (invs' and arch_extras and
-        ct_active' and sch_act_simple and
-        (\<lambda>s. \<forall>x. ksCurThread s \<notin> set (ksReadyQueues s x)))
+       (invs' and arch_extras and ct_active' and sch_act_simple)
        (UNIV \<inter> {s. isCall_' s = from_bool isCall}
              \<inter> {s. isBlocking_' s = from_bool isBlocking}) []
        (handleInvocation isCall isBlocking) (Call handleInvocation_'proc)"
@@ -193,20 +191,24 @@ lemma do_user_op_if_C_corres[ADT_IF_Refine_assms]:
   apply (rule corres_gen_asm)
   apply (simp add: doUserOp_if_def doUserOp_C_if_def uop_nonempty_def del: split_paired_All)
   apply (rule corres_gets_same)
-    apply (clarsimp simp: absKState_crelation ptable_rights_s'_def ptable_rights_s''_def
-           rf_sr_def  cstate_relation_def Let_def cstate_to_H_correct)
+    apply (fastforce dest: ex_abs_ksReadyQueues_asrt
+                     simp: absKState_crelation ptable_rights_s'_def ptable_rights_s''_def
+                           rf_sr_def cstate_relation_def Let_def cstate_to_H_correct)
    apply simp
   apply (rule corres_gets_same)
-    apply (clarsimp simp: ptable_xn_s'_def ptable_xn_s''_def ptable_attrs_s_def
-                          absKState_crelation ptable_attrs_s'_def ptable_attrs_s''_def  rf_sr_def)
+    apply (fastforce dest: ex_abs_ksReadyQueues_asrt
+                     simp: ptable_xn_s'_def ptable_xn_s''_def ptable_attrs_s_def
+                           absKState_crelation ptable_attrs_s'_def ptable_attrs_s''_def rf_sr_def)
    apply simp
   apply (rule corres_gets_same)
+    apply clarsimp
+    apply (frule ex_abs_ksReadyQueues_asrt)
     apply (clarsimp simp: absKState_crelation curthread_relation ptable_lift_s'_def ptable_lift_s''_def
                          ptable_lift_s_def rf_sr_def)
    apply simp
   apply (simp add: getCurThread_def)
   apply (rule corres_gets_same)
-    apply (simp add: absKState_crelation rf_sr_def)
+    apply (fastforce dest: ex_abs_ksReadyQueues_asrt simp: absKState_crelation rf_sr_def)
    apply simp
   apply (rule corres_gets_same)
     apply (rule fun_cong[where x=ptrFromPAddr])
diff --git a/proof/infoflow/refine/ARM/Example_Valid_StateH.thy b/proof/infoflow/refine/ARM/Example_Valid_StateH.thy
index e4e1818376..9b93e4fe59 100644
--- a/proof/infoflow/refine/ARM/Example_Valid_StateH.thy
+++ b/proof/infoflow/refine/ARM/Example_Valid_StateH.thy
@@ -231,6 +231,8 @@ where
      \<comment> \<open>tcbFaultHandler    =\<close> 0
      \<comment> \<open>tcbIPCBuffer       =\<close> 0
      \<comment> \<open>tcbBoundNotification        =\<close> None
+     \<comment> \<open>tcbSchedPrev       =\<close> None
+     \<comment> \<open>tcbSchedNext       =\<close> None
      \<comment> \<open>tcbContext         =\<close> (ArchThread undefined)"
 
 
@@ -255,6 +257,8 @@ where
      \<comment> \<open>tcbFaultHandler    =\<close> 0
      \<comment> \<open>tcbIPCBuffer       =\<close> 0
      \<comment> \<open>tcbBoundNotification        =\<close> None
+     \<comment> \<open>tcbSchedPrev       =\<close> None
+     \<comment> \<open>tcbSchedNext       =\<close> None
      \<comment> \<open>tcbContext         =\<close> (ArchThread undefined)"
 
 
@@ -279,6 +283,8 @@ where
      \<comment> \<open>tcbFaultHandler    =\<close> 0
      \<comment> \<open>tcbIPCBuffer       =\<close> 0
      \<comment> \<open>tcbBoundNotification        =\<close> None
+     \<comment> \<open>tcbSchedPrev       =\<close> None
+     \<comment> \<open>tcbSchedNext       =\<close> None
      \<comment> \<open>tcbContext         =\<close> (ArchThread empty_context)"
 
 definition
@@ -1080,7 +1086,7 @@ where
     ksDomSchedule = [(0 ,10), (1, 10)],
     ksCurDomain = 0,
     ksDomainTime = 5,
-    ksReadyQueues = const [],
+    ksReadyQueues = const (TcbQueue None None),
     ksReadyQueuesL1Bitmap = const 0,
     ksReadyQueuesL2Bitmap = const 0,
     ksCurThread = Low_tcb_ptr,
@@ -2805,8 +2811,6 @@ lemma s0H_invs:
    apply (clarsimp simp: sch_act_wf_def s0H_internal_def ct_in_state'_def st_tcb_at'_def obj_at'_def projectKO_eq project_inject objBitsKO_def s0_ptrs_aligned Low_tcbH_def)
    apply (rule pspace_distinctD''[OF _ s0H_pspace_distinct', simplified s0H_internal_def])
    apply (simp add: objBitsKO_def)
-  apply (rule conjI)
-   apply (clarsimp simp: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs s0H_internal_def)
   apply (rule conjI)
    apply (clarsimp simp: sym_refs_def state_refs_of'_def refs_of'_def split: option.splits)
    apply (frule kh0H_SomeD)
@@ -2967,9 +2971,16 @@ lemma s0H_invs:
   apply (rule conjI)
    apply (clarsimp simp: irqs_masked'_def s0H_internal_def maxIRQ_def timer_irq_def)
   apply (rule conjI)
-   apply (clarsimp simp: valid_queues'_def obj_at'_def projectKO_eq project_inject s0H_internal_def inQ_def)
-   apply (frule kh0H_dom_tcb)
-   apply (elim disjE, (clarsimp simp: kh0H_obj_def)+)[1]
+   apply (clarsimp simp: sym_heap_def opt_map_def projectKOs split: option.splits)
+   using kh0H_dom_tcb
+   apply (fastforce simp: kh0H_obj_def)
+  apply (rule conjI)
+   apply (clarsimp simp: valid_sched_pointers_def opt_map_def projectKOs split: option.splits)
+   using kh0H_dom_tcb
+   apply (fastforce simp: kh0H_obj_def)
+  apply (rule conjI)
+   apply (clarsimp simp: valid_bitmaps_def valid_bitmapQ_def bitmapQ_def s0H_internal_def
+                         tcbQueueEmpty_def bitmapQ_no_L1_orphans_def bitmapQ_no_L2_orphans_def)
   apply (rule conjI)
    apply (clarsimp simp: ct_not_inQ_def obj_at'_def projectKO_eq project_inject s0H_internal_def objBitsKO_def s0_ptrs_aligned Low_tcbH_def)
    apply (rule pspace_distinctD''[OF _ s0H_pspace_distinct', simplified s0H_internal_def])
@@ -3197,7 +3208,7 @@ lemma s0_pspace_rel:
                apply (clarsimp simp: kh0H_obj_def split del: if_split)
                apply (cut_tac x=y in pd_offs_in_range(3))
                apply (clarsimp simp: pd_offs_range_def pde_relation_def pde_relation_aligned_def)
-              apply (clarsimp simp: kh0H_all_obj_def kh0_obj_def other_obj_relation_def
+              apply (clarsimp simp: kh0H_all_obj_def kh0_obj_def tcb_relation_cut_def
                                     tcb_relation_def arch_tcb_relation_def fault_rel_optionation_def
                                     word_bits_def the_nat_to_bl_simps)+
            apply (clarsimp simp: kh0H_obj_def High_pt_def High_pt'H_def High_pt'_def split del: if_split)
@@ -3251,7 +3262,14 @@ lemma s0_srel:
                    apply (clarsimp simp: s0_internal_def s0H_internal_def exst0_def kh0H_def option_update_range_def split: if_split_asm option.splits)
                   apply (clarsimp simp: s0_internal_def s0H_internal_def exst0_def etcb_relation_def idle_tcbH_def High_tcbH_def High_etcb_def Low_tcbH_def Low_etcb_def default_etcb_def split: if_split_asm)
                  apply (simp add: s0_internal_def exst0_def s0H_internal_def sched_act_relation_def)
-                apply (simp add: s0_internal_def exst0_def s0H_internal_def ready_queues_relation_def)
+                apply (clarsimp simp: s0_internal_def exst0_def s0H_internal_def
+                                      ready_queues_relation_def ready_queue_relation_def
+                                      list_queue_relation_def queue_end_valid_def
+                                      prev_queue_head_def inQ_def tcbQueueEmpty_def
+                                      projectKOs opt_map_def opt_pred_def
+                               split: option.splits)
+                using kh0H_dom_tcb
+                apply (fastforce simp: kh0H_obj_def)
                apply (clarsimp simp: s0_internal_def exst0_def s0H_internal_def ghost_relation_def)
                apply (rule conjI)
                 apply clarsimp
diff --git a/proof/infoflow/refine/RISCV64/ArchADT_IF_Refine_C.thy b/proof/infoflow/refine/RISCV64/ArchADT_IF_Refine_C.thy
index 7982e61afb..62a5a61064 100644
--- a/proof/infoflow/refine/RISCV64/ArchADT_IF_Refine_C.thy
+++ b/proof/infoflow/refine/RISCV64/ArchADT_IF_Refine_C.thy
@@ -47,9 +47,7 @@ qed
 
 lemma handleInvocation_ccorres'[ADT_IF_Refine_assms]:
   "ccorres (K dc \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
-       (invs' and arch_extras and
-        ct_active' and sch_act_simple and
-        (\<lambda>s. \<forall>x. ksCurThread s \<notin> set (ksReadyQueues s x)))
+       (invs' and arch_extras and ct_active' and sch_act_simple)
        (UNIV \<inter> {s. isCall_' s = from_bool isCall}
              \<inter> {s. isBlocking_' s = from_bool isBlocking}) []
        (handleInvocation isCall isBlocking) (Call handleInvocation_'proc)"
@@ -119,20 +117,24 @@ lemma do_user_op_if_C_corres[ADT_IF_Refine_assms]:
   apply (rule corres_gen_asm)
   apply (simp add: doUserOp_if_def doUserOp_C_if_def uop_nonempty_def del: split_paired_All)
   apply (rule corres_gets_same)
-    apply (clarsimp simp: absKState_crelation ptable_rights_s'_def ptable_rights_s''_def
-           rf_sr_def  cstate_relation_def Let_def cstate_to_H_correct)
+    apply (fastforce dest: ex_abs_ksReadyQueues_asrt
+                     simp: absKState_crelation ptable_rights_s'_def ptable_rights_s''_def
+                           rf_sr_def cstate_relation_def Let_def cstate_to_H_correct)
    apply simp
   apply (rule corres_gets_same)
-    apply (clarsimp simp: ptable_xn_s'_def ptable_xn_s''_def ptable_attrs_s_def
-                          absKState_crelation ptable_attrs_s'_def ptable_attrs_s''_def  rf_sr_def)
+    apply (fastforce dest: ex_abs_ksReadyQueues_asrt
+                     simp: ptable_xn_s'_def ptable_xn_s''_def ptable_attrs_s_def
+                           absKState_crelation ptable_attrs_s'_def ptable_attrs_s''_def rf_sr_def)
    apply simp
   apply (rule corres_gets_same)
+    apply clarsimp
+    apply (frule ex_abs_ksReadyQueues_asrt)
     apply (clarsimp simp: absKState_crelation curthread_relation ptable_lift_s'_def ptable_lift_s''_def
                          ptable_lift_s_def rf_sr_def)
    apply simp
   apply (simp add: getCurThread_def)
   apply (rule corres_gets_same)
-    apply (simp add: absKState_crelation rf_sr_def)
+    apply (fastforce dest: ex_abs_ksReadyQueues_asrt simp: absKState_crelation rf_sr_def)
    apply simp
   apply (rule corres_gets_same)
     apply (rule fun_cong[where x=ptrFromPAddr])
diff --git a/proof/infoflow/refine/RISCV64/Example_Valid_StateH.thy b/proof/infoflow/refine/RISCV64/Example_Valid_StateH.thy
index 5968a1063f..7e47d663af 100644
--- a/proof/infoflow/refine/RISCV64/Example_Valid_StateH.thy
+++ b/proof/infoflow/refine/RISCV64/Example_Valid_StateH.thy
@@ -216,6 +216,8 @@ definition Low_tcbH :: tcb where
      \<comment> \<open>tcbFaultHandler      =\<close> 0
      \<comment> \<open>tcbIPCBuffer         =\<close> 0
      \<comment> \<open>tcbBoundNotification =\<close> None
+     \<comment> \<open>tcbSchedPrev         =\<close> None
+     \<comment> \<open>tcbSchedNext         =\<close> None
      \<comment> \<open>tcbContext           =\<close> (ArchThread undefined)"
 
 
@@ -240,6 +242,8 @@ definition High_tcbH :: tcb where
      \<comment> \<open>tcbFaultHandler      =\<close> 0
      \<comment> \<open>tcbIPCBuffer         =\<close> 0
      \<comment> \<open>tcbBoundNotification =\<close> None
+     \<comment> \<open>tcbSchedPrev         =\<close> None
+     \<comment> \<open>tcbSchedNext         =\<close> None
      \<comment> \<open>tcbContext           =\<close> (ArchThread undefined)"
 
 
@@ -262,6 +266,8 @@ definition idle_tcbH :: tcb where
      \<comment> \<open>tcbFaultHandler      =\<close> 0
      \<comment> \<open>tcbIPCBuffer         =\<close> 0
      \<comment> \<open>tcbBoundNotification =\<close> None
+     \<comment> \<open>tcbSchedPrev         =\<close> None
+     \<comment> \<open>tcbSchedNext         =\<close> None
      \<comment> \<open>tcbContext           =\<close> (ArchThread empty_context)"
 
 
@@ -1175,7 +1181,7 @@ definition s0H_internal :: "kernel_state" where
      ksDomSchedule = [(0, 10), (1, 10)],
      ksCurDomain = 0,
      ksDomainTime = 5,
-     ksReadyQueues = const [],
+     ksReadyQueues = const (TcbQueue None None),
      ksReadyQueuesL1Bitmap = const 0,
      ksReadyQueuesL2Bitmap = const 0,
      ksCurThread = Low_tcb_ptr,
@@ -3253,8 +3259,6 @@ lemma s0H_invs:
                          s0H_internal_def s0_ptrs_aligned objBitsKO_def Low_tcbH_def)
    apply (rule pspace_distinctD''[OF _ s0H_pspace_distinct', simplified s0H_internal_def])
    apply (simp add: objBitsKO_def)
-  apply (rule conjI)
-   apply (clarsimp simp: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs s0H_internal_def)
   apply (rule conjI)
    apply (clarsimp simp: sym_refs_def state_refs_of'_def refs_of'_def split: option.splits)
    apply (frule kh0H_SomeD)
@@ -3421,9 +3425,16 @@ lemma s0H_invs:
   apply (rule conjI)
    apply (clarsimp simp: irqs_masked'_def s0H_internal_def maxIRQ_def timer_irq_def irqInvalid_def)
   apply (rule conjI)
-   apply (clarsimp simp: valid_queues'_def obj_at'_def s0H_internal_def inQ_def)
-   apply (frule kh0H_dom_tcb)
-   apply (elim disjE, (clarsimp simp: kh0H_obj_def)+)[1]
+   apply (clarsimp simp: sym_heap_def opt_map_def projectKOs split: option.splits)
+   using kh0H_dom_tcb
+   apply (fastforce simp: kh0H_obj_def)
+  apply (rule conjI)
+   apply (clarsimp simp: valid_sched_pointers_def opt_map_def projectKOs split: option.splits)
+   using kh0H_dom_tcb
+   apply (fastforce simp: kh0H_obj_def)
+  apply (rule conjI)
+   apply (clarsimp simp: valid_bitmaps_def valid_bitmapQ_def bitmapQ_def s0H_internal_def
+                         tcbQueueEmpty_def bitmapQ_no_L1_orphans_def bitmapQ_no_L2_orphans_def)
   apply (rule conjI)
    apply (clarsimp simp: ct_not_inQ_def obj_at'_def objBitsKO_def
                          s0H_internal_def s0_ptrs_aligned Low_tcbH_def)
@@ -3596,7 +3607,7 @@ lemma s0_pspace_rel:
                   apply (clarsimp simp: kh0_obj_def bit_simps dest!: less_0x200_exists_ucast)
                  defer
                  apply ((clarsimp simp: kh0_obj_def kh0H_obj_def bit_simps word_bits_def
-                                        other_obj_relation_def fault_rel_optionation_def
+                                        fault_rel_optionation_def tcb_relation_cut_def
                                         tcb_relation_def arch_tcb_relation_def the_nat_to_bl_simps
                              split del: if_split)+)[3]
               prefer 13
@@ -3657,7 +3668,14 @@ lemma s0_srel:
                                         High_etcb_def Low_etcb_def default_etcb_def
                                  split: if_split_asm)
                  apply (simp add: s0_internal_def exst0_def s0H_internal_def sched_act_relation_def)
-                apply (simp add: s0_internal_def exst0_def s0H_internal_def ready_queues_relation_def)
+                apply (clarsimp simp: s0_internal_def exst0_def s0H_internal_def
+                                      ready_queues_relation_def ready_queue_relation_def
+                                      list_queue_relation_def queue_end_valid_def
+                                      prev_queue_head_def inQ_def tcbQueueEmpty_def
+                                      projectKOs opt_map_def opt_pred_def
+                               split: option.splits)
+                using kh0H_dom_tcb
+                apply (fastforce simp: kh0H_obj_def)
                apply (clarsimp simp: s0_internal_def exst0_def s0H_internal_def ghost_relation_def)
                apply (rule conjI)
                 apply (fastforce simp: kh0_def kh0_obj_def dest: kh0_SomeD)
diff --git a/proof/invariant-abstract/DetSchedInvs_AI.thy b/proof/invariant-abstract/DetSchedInvs_AI.thy
index b89890f632..5e4395749a 100644
--- a/proof/invariant-abstract/DetSchedInvs_AI.thy
+++ b/proof/invariant-abstract/DetSchedInvs_AI.thy
@@ -129,6 +129,11 @@ abbreviation valid_blocked_except :: "obj_ref \<Rightarrow> det_ext state \<Righ
 
 lemmas valid_blocked_except_def = valid_blocked_except_2_def
 
+lemma valid_blocked_except_cur_thread[simp]:
+  "valid_blocked_except_2 (cur_thread s) queues kh sa (cur_thread s)
+   = valid_blocked_2 queues kh sa (cur_thread s)"
+  by (fastforce simp: valid_blocked_except_2_def valid_blocked_2_def)
+
 definition in_cur_domain_2 where
   "in_cur_domain_2 thread cdom ekh \<equiv> etcb_at' (\<lambda>t. tcb_domain t = cdom) thread ekh"
 
@@ -281,6 +286,10 @@ lemma valid_queues_lift:
   apply (wp hoare_vcg_ball_lift hoare_vcg_all_lift hoare_vcg_conj_lift a)
   done
 
+lemma valid_sched_valid_queues[elim!]:
+  "valid_sched s \<Longrightarrow> valid_queues s"
+  by (clarsimp simp: valid_sched_def)
+
 lemma typ_at_st_tcb_at_lift:
   assumes typ_lift: "\<And>P T p. \<lbrace>\<lambda>s. P (typ_at T p s)\<rbrace> f \<lbrace>\<lambda>r s. P (typ_at T p s)\<rbrace>"
   assumes st_lift: "\<And>P. \<lbrace>st_tcb_at P t\<rbrace> f \<lbrace>\<lambda>_. st_tcb_at P t\<rbrace>"
@@ -401,6 +410,10 @@ lemma valid_sched_lift:
             valid_sched_action_lift valid_blocked_lift a b c d e f g h i hoare_vcg_conj_lift)
   done
 
+lemma valid_sched_valid_etcbs[elim!]:
+  "valid_sched s \<Longrightarrow> valid_etcbs s"
+  by (clarsimp simp: valid_sched_def)
+
 lemma valid_etcbs_tcb_etcb:
   "\<lbrakk> valid_etcbs s; kheap s ptr = Some (TCB tcb) \<rbrakk> \<Longrightarrow> \<exists>etcb. ekheap s ptr = Some etcb"
   by (force simp: valid_etcbs_def is_etcb_at_def st_tcb_at_def obj_at_def)
diff --git a/proof/invariant-abstract/DetSchedSchedule_AI.thy b/proof/invariant-abstract/DetSchedSchedule_AI.thy
index 39c628e750..7e1ec8501b 100644
--- a/proof/invariant-abstract/DetSchedSchedule_AI.thy
+++ b/proof/invariant-abstract/DetSchedSchedule_AI.thy
@@ -2212,6 +2212,13 @@ end
 
 crunch valid_sched[wp]: dec_domain_time valid_sched
 
+lemma thread_set_time_slice_valid_queues[wp]:
+  "ethread_set (tcb_time_slice_update f) tptr \<lbrace>valid_queues\<rbrace>"
+  apply (unfold thread_set_time_slice_def ethread_set_def set_eobject_def)
+  apply wpsimp
+  apply (fastforce simp: get_etcb_def valid_queues_def is_etcb_at'_def etcb_at'_def)
+  done
+
 lemma timer_tick_valid_sched[wp]:
   "\<lbrace>valid_sched\<rbrace> timer_tick \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
   apply (simp add: timer_tick_def crunch_simps thread_set_time_slice_def
diff --git a/proof/refine/AARCH64/ADT_H.thy b/proof/refine/AARCH64/ADT_H.thy
index d509b4b577..5f6824b914 100644
--- a/proof/refine/AARCH64/ADT_H.thy
+++ b/proof/refine/AARCH64/ADT_H.thy
@@ -483,7 +483,7 @@ proof -
     apply (intro conjI impI allI)
            apply (erule pspace_dom_relatedE[OF _ pspace_relation])
            apply clarsimp
-           apply (case_tac ko; simp add: other_obj_relation_def)
+           apply (case_tac ko; simp add: tcb_relation_cut_def other_obj_relation_def)
              apply (clarsimp simp: cte_relation_def split: if_split_asm)
             apply (clarsimp simp: ep_relation_def EndpointMap_def
                             split: Structures_A.endpoint.splits)
@@ -494,7 +494,7 @@ proof -
            apply (clarsimp split: if_split_asm)+
 
           apply (erule pspace_dom_relatedE[OF _ pspace_relation])
-          apply (case_tac ko; simp add: other_obj_relation_def)
+          apply (case_tac ko; simp add: tcb_relation_cut_def other_obj_relation_def)
             apply (clarsimp simp: cte_relation_def split: if_split_asm)
            apply (clarsimp simp: ntfn_relation_def AEndpointMap_def
                            split: Structures_A.ntfn.splits)
@@ -505,7 +505,7 @@ proof -
           apply (clarsimp split: if_split_asm)+
 
          apply (erule pspace_dom_relatedE[OF _ pspace_relation])
-         apply (case_tac ko; simp add: other_obj_relation_def)
+         apply (case_tac ko; simp add: tcb_relation_cut_def other_obj_relation_def)
           apply (clarsimp simp: cte_relation_def split: if_split_asm)
          apply (rename_tac arch_kernel_obj)
          apply (case_tac arch_kernel_obj; simp add: other_obj_relation_def)
@@ -513,7 +513,7 @@ proof -
          apply (clarsimp split: if_split_asm)+
 
         apply (erule pspace_dom_relatedE[OF _ pspace_relation])
-        apply (case_tac ko, simp_all add: other_obj_relation_def)
+        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)
@@ -536,7 +536,7 @@ proof -
          apply (erule n_less_2p_pageBitsForSize)
         apply (clarsimp simp: shiftl_t2n mult_ac)
        apply (erule pspace_dom_relatedE[OF _ pspace_relation])
-       apply (case_tac ko, simp_all add: other_obj_relation_def)
+       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)
@@ -559,7 +559,7 @@ proof -
         apply (erule n_less_2p_pageBitsForSize)
        apply (clarsimp simp: shiftl_t2n mult_ac)
       apply (erule pspace_dom_relatedE[OF _ pspace_relation])
-      apply (case_tac ko, simp_all add: other_obj_relation_def)
+      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)
@@ -585,7 +585,7 @@ proof -
                                 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: other_obj_relation_def
+     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)
@@ -652,7 +652,7 @@ proof -
     (* mapping architecture-specific objects *)
     apply clarsimp
     apply (erule pspace_dom_relatedE[OF _ pspace_relation])
-    apply (case_tac ko, simp_all add: other_obj_relation_def)
+    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
@@ -868,7 +868,7 @@ lemma absEkheap_correct:
    apply (case_tac "ksPSpace s' x", clarsimp)
     apply (erule_tac x=x in allE, clarsimp)
    apply clarsimp
-   apply (case_tac a, simp_all add: other_obj_relation_def)
+   apply (case_tac a, simp_all add: tcb_relation_cut_def other_obj_relation_def)
   apply (insert pspace_relation)
   apply (clarsimp simp: obj_at'_def)
   apply (erule(1) pspace_dom_relatedE)
@@ -896,7 +896,7 @@ lemma TCB_implies_KOTCB:
   apply (clarsimp simp add: pspace_relation_def pspace_dom_def
                             dom_def UNION_eq Collect_eq)
   apply (erule_tac x=a in allE)+
-  apply (clarsimp simp add: other_obj_relation_def
+  apply (clarsimp simp add: tcb_relation_cut_def
                   split: Structures_H.kernel_object.splits)
   apply (drule iffD1)
    apply (fastforce simp add: dom_def image_def)
@@ -1651,7 +1651,7 @@ definition
       domain_index_internal = ksDomScheduleIdx s,
       cur_domain_internal = ksCurDomain s,
       domain_time_internal = ksDomainTime s,
-      ready_queues_internal = curry (ksReadyQueues s),
+      ready_queues_internal = (\<lambda>d p. heap_walk (tcbSchedNexts_of s) (tcbQueueHead (ksReadyQueues s (d, p))) []),
       cdt_list_internal = absCDTList (cteMap (gsCNodes s)) (ctes_of s)\<rparr>"
 
 lemma absExst_correct:
@@ -1659,12 +1659,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 absEkheap_correct
-                           absCDTList_correct[THEN fun_cong] state_relation_def invs_def valid_state_def
-                           ready_queues_relation_def invs'_def valid_state'_def
-                           valid_pspace_def valid_sched_def valid_pspace'_def curry_def fun_eq_iff)
-      apply (fastforce simp: absEkheap_correct)
+           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
 
 
diff --git a/proof/refine/AARCH64/ArchAcc_R.thy b/proof/refine/AARCH64/ArchAcc_R.thy
index 28262e4233..c21322d823 100644
--- a/proof/refine/AARCH64/ArchAcc_R.thy
+++ b/proof/refine/AARCH64/ArchAcc_R.thy
@@ -53,17 +53,23 @@ lemma pspace_aligned_cross:
   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)
-     apply (clarsimp simp: cte_map_def)
-     apply (simp add: cteSizeBits_def cte_level_bits_def)
-     apply (rule is_aligned_add)
-      apply (erule is_aligned_weaken)
-      apply simp
-     apply (rule is_aligned_shift)
+      \<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_shiftl_self, simp)
+     \<comment>\<open>TCB\<close>
+     apply (clarsimp simp: tcbBlockSizeBits_def elim!: is_aligned_weaken)
+    \<comment>\<open>PageTable\<close>
     apply (rule is_aligned_add)
      apply (erule is_aligned_weaken)
      apply (simp add: bit_simps)
     apply (rule is_aligned_shift)
+   \<comment>\<open>DataPage\<close>
    apply (rule is_aligned_add)
     apply (erule is_aligned_weaken)
     apply (rule pbfs_atleast_pageBits)
@@ -71,9 +77,7 @@ lemma pspace_aligned_cross:
   apply (simp add: other_obj_relation_def)
   apply (clarsimp simp: bit_simps' tcbBlockSizeBits_def epSizeBits_def ntfnSizeBits_def
                   split: kernel_object.splits Structures_A.kernel_object.splits)
-  apply (clarsimp simp: archObjSize_def bit_simps
-                  split: arch_kernel_object.splits arch_kernel_obj.splits)
-   apply (erule is_aligned_weaken, simp add: bit_simps)+
+  apply (fastforce simp: archObjSize_def split: arch_kernel_object.splits arch_kernel_obj.splits)
   done
 
 lemma of_bl_shift_cte_level_bits:
@@ -85,10 +89,12 @@ 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)
-     apply (rule_tac x=cte_level_bits in exI)
-     apply (simp add: is_aligned_shift of_bl_shift_cte_level_bits)
+      apply (drule (1) wf_cs_nD)
+      apply (clarsimp simp: cte_map_def)
+      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=tcbBlockSizeBits in exI)
+     apply (simp add: tcbBlockSizeBits_def)
     apply (rule_tac x=pte_bits in exI)
     apply (simp add: is_aligned_shift mask_def)
     apply (rule shiftl_less_t2n)
@@ -233,14 +239,6 @@ lemma getObject_ASIDPool_corres:
   apply (clarsimp simp: other_obj_relation_def)
   done
 
-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 project_inject pspace_distinct'_def pspace_aligned'_def)
-  apply (drule bspec, erule domI)+
-  apply simp
-  done
-
 lemma storePTE_cte_wp_at'[wp]:
   "storePTE ptr val \<lbrace>\<lambda>s. P (cte_wp_at' P' p s)\<rbrace>"
   apply (simp add: storePTE_def)
@@ -447,7 +445,8 @@ lemma setObject_PT_corres:
    apply (drule bspec, assumption)
    apply clarsimp
    apply (erule (1) obj_relation_cutsE)
-      apply simp
+       apply simp
+      apply clarsimp
      apply clarsimp
      apply (smt (verit, best) pspace_aligned_pts_ofD pts_of_Some pts_of_type_unique aobjs_of_Some
                               table_base_plus)
@@ -459,10 +458,14 @@ lemma setObject_PT_corres:
    apply (drule_tac x=p in bspec, erule domI)
    apply (simp add: other_obj_relation_def
            split: Structures_A.kernel_object.splits)
-  apply (rule conjI)
+  apply (extract_conjunct \<open>match conclusion in "ghost_relation _ _ _ _" \<Rightarrow> -\<close>)
    apply (clarsimp simp add: ghost_relation_def)
    apply (erule_tac x="p && ~~ mask (pt_bits (pt_type pt))" in allE)+
    apply fastforce
+  apply (extract_conjunct \<open>match conclusion in "ready_queues_relation_2 _ _ _ _ _" \<Rightarrow> -\<close>)
+   apply (prop_tac "typ_at' (koTypeOf (injectKO pte')) p b")
+    apply (simp add: typ_at'_def ko_wp_at'_def)
+   subgoal by (fastforce dest: tcbs_of'_non_tcb_update)
   apply (simp add: map_to_ctes_upd_other)
   apply (simp add: fun_upd_def)
   apply (simp add: caps_of_state_after_update obj_at_def swp_cte_at_caps_of)
diff --git a/proof/refine/AARCH64/Arch_R.thy b/proof/refine/AARCH64/Arch_R.thy
index bd6f5e5d1e..d265c8b81b 100644
--- a/proof/refine/AARCH64/Arch_R.thy
+++ b/proof/refine/AARCH64/Arch_R.thy
@@ -275,9 +275,9 @@ lemma performASIDControlInvocation_corres:
        apply (fold_subgoals (prefix))[2]
      subgoal premises prems using prems by (clarsimp simp:invs_def valid_state_def)+
       apply (clarsimp simp: schact_is_rct_def)
-     apply (clarsimp simp:cte_wp_at_caps_of_state)
+     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 (fastforce simp: cte_wp_at_caps_of_state)
     apply simp
    apply (frule_tac ptr = "(aa,ba)" in detype_invariants [rotated 3])
         apply fastforce
@@ -342,7 +342,7 @@ lemma performASIDControlInvocation_corres:
      apply (simp add:pageBits_def)
     apply clarsimp
     apply (drule(1) cte_cap_in_untyped_range)
-         apply (fastforce simp:cte_wp_at_ctes_of)
+         apply (fastforce simp: cte_wp_at_ctes_of)
         apply assumption+
      apply fastforce
     apply simp
@@ -1854,7 +1854,7 @@ lemma assoc_invs':
                     valid_irq_node_lift_asm [where Q=\<top>] valid_irq_handlers_lift'
                     cteCaps_of_ctes_of_lift irqs_masked_lift ct_idle_or_in_cur_domain'_lift
                     valid_irq_states_lift' hoare_vcg_all_lift hoare_vcg_disj_lift
-                    setObject_typ_at' cur_tcb_lift
+                    setObject_typ_at' cur_tcb_lift valid_bitmaps_lift sym_heap_sched_pointers_lift
                     setVCPU_valid_arch'
               simp: objBits_simps archObjSize_def vcpuBits_def pageBits_def
                     state_refs_of'_vcpu_empty state_hyp_refs_of'_vcpu_absorb valid_arch_tcb'_def
diff --git a/proof/refine/AARCH64/Bits_R.thy b/proof/refine/AARCH64/Bits_R.thy
index a548deb670..8fd5064679 100644
--- a/proof/refine/AARCH64/Bits_R.thy
+++ b/proof/refine/AARCH64/Bits_R.thy
@@ -67,6 +67,10 @@ lemma projectKO_tcb:
   "(projectKO_opt ko = Some t) = (ko = KOTCB t)"
   by (cases ko) (auto simp: projectKO_opts_defs)
 
+lemma tcb_of'_TCB[simp]:
+  "tcb_of' (KOTCB tcb) = Some tcb"
+  by (simp add: projectKO_tcb)
+
 lemma projectKO_cte:
   "(projectKO_opt ko = Some t) = (ko = KOCTE t)"
   by (cases ko) (auto simp: projectKO_opts_defs)
diff --git a/proof/refine/AARCH64/CNodeInv_R.thy b/proof/refine/AARCH64/CNodeInv_R.thy
index f724a14ba8..2afaebfe59 100644
--- a/proof/refine/AARCH64/CNodeInv_R.thy
+++ b/proof/refine/AARCH64/CNodeInv_R.thy
@@ -5044,8 +5044,6 @@ crunch valid_arch_state'[wp]: cteSwap "valid_arch_state'"
 
 crunch irq_states'[wp]: cteSwap "valid_irq_states'"
 
-crunch vq'[wp]: cteSwap "valid_queues'"
-
 crunch ksqsL1[wp]: cteSwap "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
 
 crunch ksqsL2[wp]: cteSwap "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
@@ -5060,6 +5058,12 @@ crunch ct_not_inQ[wp]: cteSwap "ct_not_inQ"
 
 crunch ksDomScheduleIdx [wp]: cteSwap "\<lambda>s. P (ksDomScheduleIdx s)"
 
+crunches cteSwap
+  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: valid_bitmaps_lift)
+
 lemma cteSwap_invs'[wp]:
   "\<lbrace>invs' and valid_cap' c and valid_cap' c' and
     ex_cte_cap_to' c1 and ex_cte_cap_to' c2 and
@@ -5509,6 +5513,10 @@ lemma updateCap_untyped_ranges_zero_simple:
 crunch tcb_in_cur_domain'[wp]: updateCap "tcb_in_cur_domain' t"
   (wp: crunch_wps simp: crunch_simps rule: tcb_in_cur_domain'_lift)
 
+crunches updateCap
+  for valid_bitmaps[wp]: valid_bitmaps
+  (rule: valid_bitmaps_lift)
+
 lemma make_zombie_invs':
   "\<lbrace>\<lambda>s. invs' s \<and> s \<turnstile>' cap \<and>
     cte_wp_at' (\<lambda>cte. isFinal (cteCap cte) sl (cteCaps_of s)) sl s \<and>
@@ -5526,7 +5534,8 @@ lemma make_zombie_invs':
                              \<and> bound_tcb_at' ((=) None) p s
                              \<and> obj_at' (Not \<circ> tcbQueued) p s
                              \<and> ko_wp_at' (Not \<circ> hyp_live') p s
-                             \<and> (\<forall>pr. p \<notin> set (ksReadyQueues s pr)))) sl s\<rbrace>
+                             \<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_state'_def valid_pspace'_def valid_mdb'_def
@@ -5564,7 +5573,9 @@ lemma make_zombie_invs':
    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> ko_wp_at' (Not \<circ> hyp_live') p' s")
+                               \<and> ko_wp_at' (Not \<circ> hyp_live') 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 live'_def hyp_live'_def)
    apply (auto dest!: isCapDs)[1]
   apply (clarsimp simp: cte_wp_at_ctes_of disj_ac
@@ -8549,6 +8560,15 @@ lemma cteMove_urz [wp]:
   apply auto
   done
 
+crunches updateMDB
+  for valid_bitmaps[wp]: valid_bitmaps
+  (rule: valid_bitmaps_lift)
+
+(* FIXME: arch_split *)
+lemma haskell_assert_inv:
+  "haskell_assert Q L \<lbrace>P\<rbrace>"
+  by wpsimp
+
 lemma cteMove_invs' [wp]:
   "\<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>
@@ -8626,6 +8646,10 @@ crunch ksDomSchedule[wp]: updateCap "\<lambda>s. P (ksDomSchedule s)"
 crunch ksDomScheduleIdx[wp]: updateCap "\<lambda>s. P (ksDomScheduleIdx s)"
 crunch ksDomainTime[wp]: updateCap "\<lambda>s. P (ksDomainTime s)"
 
+crunches updateCap
+  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 corres_null_cap_update:
   "cap_relation cap cap' \<Longrightarrow>
    corres dc (invs and cte_wp_at ((=) cap) slot)
diff --git a/proof/refine/AARCH64/CSpace1_R.thy b/proof/refine/AARCH64/CSpace1_R.thy
index d9c1fb277c..637819592d 100644
--- a/proof/refine/AARCH64/CSpace1_R.thy
+++ b/proof/refine/AARCH64/CSpace1_R.thy
@@ -234,7 +234,7 @@ lemma pspace_relation_cte_wp_at:
    apply (clarsimp elim!: cte_wp_at_weakenE')
   apply clarsimp
   apply (drule(1) pspace_relation_absD)
-  apply (clarsimp simp: other_obj_relation_def)
+  apply (clarsimp simp: tcb_relation_cut_def)
   apply (simp split: kernel_object.split_asm)
   apply (drule(2) aligned_distinct_obj_atI'[where 'a=tcb])
    apply simp
@@ -1632,10 +1632,10 @@ lemma cte_map_pulls_tcb_to_abstract:
      \<Longrightarrow> \<exists>tcb'. kheap s x = Some (TCB tcb') \<and> tcb_relation tcb' tcb
                   \<and> (z = (x, tcb_cnode_index (unat ((y - x) >> cte_level_bits))))"
   apply (rule pspace_dom_relatedE, assumption+)
-  apply (erule(1) obj_relation_cutsE, simp_all split: if_split_asm)
-  apply (clarsimp simp: other_obj_relation_def
-                 split: Structures_A.kernel_object.split_asm
-                        AARCH64_A.arch_kernel_obj.split_asm)
+  apply (erule(1) obj_relation_cutsE;
+         clarsimp simp: other_obj_relation_def
+                  split: Structures_A.kernel_object.split_asm
+                         AARCH64_A.arch_kernel_obj.split_asm if_split_asm)
   apply (drule tcb_cases_related2)
   apply clarsimp
   apply (frule(1) cte_wp_at_tcbI [OF _ _ TrueI, where t="(a, b)" for a b, simplified])
@@ -1651,8 +1651,7 @@ lemma pspace_relation_update_tcbs:
               del: dom_fun_upd)
   apply (erule conjE)
   apply (rule ballI, drule(1) bspec)
-  apply (rule conjI, simp add: other_obj_relation_def)
-  apply (clarsimp split: Structures_A.kernel_object.split_asm)
+  apply (clarsimp simp: tcb_relation_cut_def split: Structures_A.kernel_object.split_asm)
   apply (drule bspec, fastforce)
   apply clarsimp
   apply (erule(1) obj_relation_cutsE, simp_all split: if_split_asm)
@@ -1874,6 +1873,27 @@ lemma descendants_of_eq':
   apply simp
   done
 
+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
+
+lemma setObject_cte_tcbSchedNexts_of_use_valid_ksPSpace:
+  assumes step: "(x, s\<lparr>ksPSpace := ps\<rparr>) \<in> fst (setObject p (cte :: cte) s)"
+  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_inQ_of_use_valid_ksPSpace:
+  assumes step: "(x, s\<lparr>ksPSpace := ps\<rparr>) \<in> fst (setObject p (cte :: cte) s)"
+  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>
@@ -1887,7 +1907,12 @@ lemma updateCap_stuff:
          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'')" using assms
+         (pspace_distinct' s' \<longrightarrow> pspace_distinct' s'') \<and>
+         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)
@@ -1896,8 +1921,11 @@ lemma updateCap_stuff:
   apply (frule setCTE_pspace_only)
   apply (clarsimp simp: setCTE_def)
   apply (intro conjI impI)
-   apply (erule(1) use_valid [OF _ setObject_aligned])
-  apply (erule(1) use_valid [OF _ setObject_distinct])
+      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 *)
@@ -1914,16 +1942,16 @@ lemma pspace_relation_cte_wp_atI':
    apply (simp split: if_split_asm)
   apply (erule(1) pspace_dom_relatedE)
   apply (erule(1) obj_relation_cutsE, simp_all split: if_split_asm)
+   apply (subgoal_tac "n = x - y", clarsimp)
+    apply (drule tcb_cases_related2, clarsimp)
+    apply (intro exI, rule conjI)
+     apply (erule(1) cte_wp_at_tcbI[where t="(a, b)" for a b, simplified])
+     apply fastforce
+    apply simp
+   apply clarsimp
   apply (simp add: other_obj_relation_def
             split: Structures_A.kernel_object.split_asm
                    AARCH64_A.arch_kernel_obj.split_asm)
-  apply (subgoal_tac "n = x - y", clarsimp)
-   apply (drule tcb_cases_related2, clarsimp)
-   apply (intro exI, rule conjI)
-    apply (erule(1) cte_wp_at_tcbI[where t="(a, b)" for a b, simplified])
-    apply fastforce
-   apply simp
-  apply clarsimp
   done
 
 lemma pspace_relation_cte_wp_atI:
@@ -2445,7 +2473,7 @@ lemma updateCap_corres:
   apply (clarsimp simp: in_set_cap_cte_at_swp pspace_relations_def)
   apply (drule updateCap_stuff)
   apply simp
-  apply (rule conjI)
+  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 (rule conjI)
    prefer 2
@@ -2533,9 +2561,9 @@ lemma updateMDB_pspace_relation:
     apply (clarsimp simp: tcb_ctes_clear cte_level_bits_def objBits_defs)
    apply clarsimp
    apply (rule pspace_dom_relatedE, assumption+)
-   apply (rule obj_relation_cutsE, assumption+, simp_all split: if_split_asm)[1]
-   apply (clarsimp split: Structures_A.kernel_object.split_asm
-                          AARCH64_A.arch_kernel_obj.split_asm
+   apply (rule obj_relation_cutsE, assumption+;
+          clarsimp split: Structures_A.kernel_object.split_asm
+                          AARCH64_A.arch_kernel_obj.split_asm if_split_asm
                     simp: other_obj_relation_def)
    apply (frule(1) tcb_cte_cases_aligned_helpers(1))
    apply (frule(1) tcb_cte_cases_aligned_helpers(2))
@@ -2597,6 +2625,25 @@ lemma updateMDB_ctes_of:
 
 crunch aligned[wp]: updateMDB "pspace_aligned'"
 crunch pdistinct[wp]: updateMDB "pspace_distinct'"
+crunch tcbSchedPrevs_of[wp]: updateMDB "\<lambda>s. P (tcbSchedPrevs_of s)"
+crunch tcbSchedNexts_of[wp]: updateMDB "\<lambda>s. P (tcbSchedNexts_of s)"
+crunch inQ_opt_pred[wp]: updateMDB "\<lambda>s. P (inQ d p |< tcbs_of' s)"
+crunch inQ_opt_pred'[wp]: updateMDB "\<lambda>s. P (\<lambda>d p. inQ d p |< tcbs_of' s)"
+crunch ksReadyQueues[wp]: updateMDB "\<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
+
+crunches 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')"
@@ -2619,7 +2666,11 @@ lemma updateMDB_the_lot:
          ksDomScheduleIdx s'' = ksDomScheduleIdx s' \<and>
          ksDomSchedule s''    = ksDomSchedule s' \<and>
          ksCurDomain s''      = ksCurDomain s' \<and>
-         ksDomainTime s''     = ksDomainTime s'"
+         ksDomainTime s''     = ksDomainTime s' \<and>
+         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)
@@ -2628,9 +2679,8 @@ using assms
    apply (erule use_valid)
     apply wp
    apply simp
-  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 is_cap_revocable_eq:
@@ -3793,6 +3843,9 @@ lemma updateUntypedCap_descendants_of:
   apply (clarsimp simp:mdb_next_rel_def mdb_next_def split:if_splits)
   done
 
+crunches setCTE
+  for tcbQueued[wp]: "\<lambda>s. P (tcbQueued |< tcbs_of' s)"
+
 lemma setCTE_UntypedCap_corres:
   "\<lbrakk>cap_relation cap (cteCap cte); is_untyped_cap cap; idx' = idx\<rbrakk>
    \<Longrightarrow> corres dc (cte_wp_at ((=) cap) src and valid_objs and
@@ -3822,10 +3875,19 @@ lemma setCTE_UntypedCap_corres:
    apply assumption
   apply (clarsimp simp: pspace_relations_def)
   apply (subst conj_assoc[symmetric])
+  apply clarsimp
   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)
@@ -5105,11 +5167,15 @@ lemma updateMDB_the_lot':
          ksDomScheduleIdx s'' = ksDomScheduleIdx s' \<and>
          ksDomSchedule s''    = ksDomSchedule s' \<and>
          ksCurDomain s''      = ksCurDomain s' \<and>
-         ksDomainTime s''     = ksDomainTime s'"
+         ksDomainTime s''     = ksDomainTime s' \<and>
+         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
+   done
 
 lemma cte_map_inj_eq':
   "\<lbrakk>(cte_map p = cte_map p');
@@ -5211,7 +5277,6 @@ lemma cteInsert_corres:
             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 "ksReadyQueues t = p" for p t)+
             apply (thin_tac "ksSchedulerAction t = p" for p t)+
             apply (clarsimp simp: pspace_relations_def)
 
diff --git a/proof/refine/AARCH64/CSpace_R.thy b/proof/refine/AARCH64/CSpace_R.thy
index c077663541..67ea635cea 100644
--- a/proof/refine/AARCH64/CSpace_R.thy
+++ b/proof/refine/AARCH64/CSpace_R.thy
@@ -1092,43 +1092,6 @@ lemma bitmapQ_no_L2_orphans_lift:
   apply (rule hoare_vcg_prop, assumption)
   done
 
-lemma valid_queues_lift_asm:
-  assumes tat1: "\<And>d p tcb. \<lbrace>obj_at' (inQ d p) tcb and Q \<rbrace> f \<lbrace>\<lambda>_. obj_at' (inQ d p) tcb\<rbrace>"
-  and     tat2: "\<And>tcb. \<lbrace>st_tcb_at' runnable' tcb and Q \<rbrace> f \<lbrace>\<lambda>_. st_tcb_at' runnable' tcb\<rbrace>"
-  and     prq: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueues s) \<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueues s)\<rbrace>"
-  and     prqL1: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueuesL1Bitmap s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueuesL1Bitmap s)\<rbrace>"
-  and     prqL2: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueuesL2Bitmap s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueuesL2Bitmap s)\<rbrace>"
-  shows   "\<lbrace>Invariants_H.valid_queues and Q\<rbrace> f \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  proof -
-    have tat:  "\<And>d p tcb. \<lbrace>obj_at' (inQ d p) tcb and st_tcb_at' runnable' tcb and Q\<rbrace> f
-                         \<lbrace>\<lambda>_. obj_at' (inQ d p) tcb and st_tcb_at' runnable' tcb\<rbrace>"
-      apply (rule hoare_chain [OF hoare_vcg_conj_lift [OF tat1 tat2]])
-       apply (fastforce)+
-       done
-    have tat_combined: "\<And>d p tcb. \<lbrace>obj_at' (inQ d p and runnable' \<circ> tcbState) tcb and Q\<rbrace> f
-                         \<lbrace>\<lambda>_. obj_at' (inQ d p and runnable' \<circ> tcbState) tcb\<rbrace>"
-      apply (rule hoare_chain [OF tat])
-       apply (fastforce simp add: obj_at'_and pred_tcb_at'_def o_def)+
-      done
-    show ?thesis unfolding valid_queues_def valid_queues_no_bitmap_def
-      by (wp tat_combined prq prqL1 prqL2 valid_bitmapQ_lift bitmapQ_no_L2_orphans_lift
-             bitmapQ_no_L1_orphans_lift hoare_vcg_all_lift hoare_vcg_conj_lift hoare_Ball_helper)
-         simp_all
-  qed
-
-lemmas valid_queues_lift = valid_queues_lift_asm[where Q="\<lambda>_. True", simplified]
-
-lemma valid_queues_lift':
-  assumes tat: "\<And>d p tcb. \<lbrace>\<lambda>s. \<not> obj_at' (inQ d p) tcb s\<rbrace> f \<lbrace>\<lambda>_ s. \<not> obj_at' (inQ d p) tcb s\<rbrace>"
-  and     prq: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueues s)\<rbrace>"
-  shows   "\<lbrace>valid_queues'\<rbrace> f \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  unfolding valid_queues'_def imp_conv_disj
-  by (wp hoare_vcg_all_lift hoare_vcg_disj_lift tat prq)
-
-lemma setCTE_norq [wp]:
-  "\<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace> setCTE ptr cte \<lbrace>\<lambda>r s. P (ksReadyQueues s) \<rbrace>"
-  by (clarsimp simp: valid_def dest!: setCTE_pspace_only)
-
 lemma setCTE_norqL1 [wp]:
   "\<lbrace>\<lambda>s. P (ksReadyQueuesL1Bitmap s)\<rbrace> setCTE ptr cte \<lbrace>\<lambda>r s. P (ksReadyQueuesL1Bitmap s) \<rbrace>"
   by (clarsimp simp: valid_def dest!: setCTE_pspace_only)
@@ -2787,12 +2750,6 @@ lemma setCTE_inQ[wp]:
    apply (simp_all add: inQ_def)
   done
 
-lemma setCTE_valid_queues'[wp]:
-  "\<lbrace>valid_queues'\<rbrace> setCTE p cte \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (simp only: valid_queues'_def imp_conv_disj)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-  done
-
 crunch inQ[wp]: cteInsert "\<lambda>s. P (obj_at' (inQ d p) t s)"
   (wp: crunch_wps)
 
@@ -3305,6 +3262,13 @@ lemma cteInsert_untyped_ranges_zero[wp]:
   apply blast
   done
 
+crunches cteInsert
+  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
   (\<lambda>s. src \<noteq> dest) and (\<lambda>s. cte_wp_at' (is_derived' (ctes_of s) src cap \<circ> cteCap) src s)
@@ -3313,9 +3277,9 @@ lemma cteInsert_invs:
   cteInsert cap src dest
   \<lbrace>\<lambda>rv. invs'\<rbrace>"
   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 CSpace_R.valid_queues_lift
-                    valid_irq_node_lift valid_queues_lift' irqs_masked_lift cteInsert_norq
-              simp: st_tcb_at'_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
 
@@ -3641,10 +3605,13 @@ lemma corres_caps_decomposition:
              "\<And>P. \<lbrace>\<lambda>s. P (new_cns s)\<rbrace> f \<lbrace>\<lambda>rv s. P (cns_of_heap (kheap s))\<rbrace>"
              "\<And>P. \<lbrace>\<lambda>s. P (new_cns' s)\<rbrace> g \<lbrace>\<lambda>rv s. P (gsCNodes s)\<rbrace>"
              "\<And>P. \<lbrace>\<lambda>s. P (new_pt_types s)\<rbrace> f \<lbrace>\<lambda>rv s. P (pt_types_of s)\<rbrace>"
-             "\<And>P. \<lbrace>\<lambda>s. P (new_queues s)\<rbrace> f \<lbrace>\<lambda>rv s. P (ready_queues s)\<rbrace>"
+             "\<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_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>"
@@ -3660,7 +3627,9 @@ lemma corres_caps_decomposition:
              "\<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 (new_queues s) (new_rqs' s')"
+                       \<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>
@@ -4179,6 +4148,9 @@ crunches setupReplyMaster
   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]:
@@ -4207,7 +4179,8 @@ lemma setupReplyMaster_invs'[wp]:
   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 valid_queues_lift' hoare_vcg_disj_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
@@ -4471,8 +4444,8 @@ lemma arch_update_setCTE_invs:
   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
+             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)
@@ -5847,7 +5820,7 @@ lemma cteInsert_simple_invs:
   apply (rule hoare_pre)
    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' irqs_masked_lift
+             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
@@ -5982,6 +5955,21 @@ lemma arch_update_updateCap_invs:
   apply clarsimp
   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
@@ -6013,6 +6001,8 @@ lemma updateCap_same_master:
         apply 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
@@ -6241,8 +6231,9 @@ lemma updateFreeIndex_forward_invs':
        apply (simp add:updateCap_def)
        apply (wp setCTE_irq_handlers' getCTE_wp)
       apply (simp add:updateCap_def)
-      apply (wp irqs_masked_lift valid_queues_lift' cur_tcb_lift ct_idle_or_in_cur_domain'_lift
+      apply (wp irqs_masked_lift cur_tcb_lift ct_idle_or_in_cur_domain'_lift
                 hoare_vcg_disj_lift untyped_ranges_zero_lift getCTE_wp
+                sym_heap_sched_pointers_lift valid_bitmaps_lift
                | wp (once) hoare_use_eq[where f="gsUntypedZeroRanges"]
                | simp add: getSlotCap_def)+
   apply (clarsimp simp: cte_wp_at_ctes_of fun_upd_def[symmetric])
diff --git a/proof/refine/AARCH64/Detype_R.thy b/proof/refine/AARCH64/Detype_R.thy
index b3e6358b3c..ca15168e2b 100644
--- a/proof/refine/AARCH64/Detype_R.thy
+++ b/proof/refine/AARCH64/Detype_R.thy
@@ -628,8 +628,9 @@ lemma valid_objs: "valid_objs' s'"
   and        pa: "pspace_aligned' s'"
   and        pc: "pspace_canonical' s'"
   and        pd: "pspace_distinct' s'"
-  and        vq: "valid_queues s'"
-  and       vq': "valid_queues' s'"
+  and       vbm: "valid_bitmaps s'"
+  and sym_sched: "sym_heap_sched_pointers s'"
+  and       vsp: "valid_sched_pointers s'"
   and  sym_refs: "sym_refs (state_refs_of' s')"
   and  sym_hyp_refs: "sym_refs (state_hyp_refs_of' s')"
   and    iflive: "if_live_then_nonz_cap' s'"
@@ -852,7 +853,6 @@ lemma sym_refs_TCB_hyp_live':
   apply (simp add: ko_wp_at'_def)
   apply (clarsimp simp: hyp_refs_of_rev' hyp_live'_def arch_live'_def)
   done
-
 end
 
 context begin interpretation Arch . (*FIXME: arch_split*)
@@ -960,6 +960,70 @@ crunches doMachineOp
   and deletionIsSafe_delete_locale[wp]: "deletionIsSafe_delete_locale base magnitude"
   (simp: deletionIsSafe_delete_locale_def)
 
+lemma detype_tcbSchedNexts_of:
+  "\<lbrakk>pspace_aligned' s'; pspace_distinct' 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) |> tcb_of' |> tcbSchedNext)
+       = tcbSchedNexts_of s'"
+  using pspace_alignedD' pspace_distinctD'
+  apply (clarsimp simp: opt_map_def)
+  apply (rule ext)
+  apply (rename_tac s)
+  apply (clarsimp simp: ko_wp_at'_def live'_def split: option.splits)
+  apply (drule_tac x=s in spec)
+  apply force
+  done
+
+lemma detype_tcbSchedPrevs_of:
+  "\<lbrakk>pspace_aligned' s'; pspace_distinct' 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) |> tcb_of' |> tcbSchedPrev)
+       = tcbSchedPrevs_of s'"
+  using pspace_alignedD' pspace_distinctD'
+  using pspace_alignedD' pspace_distinctD'
+  apply (clarsimp simp: opt_map_def)
+  apply (rule ext)
+  apply (rename_tac s)
+  apply (clarsimp simp: ko_wp_at'_def live'_def split: option.splits)
+  apply (drule_tac x=s in spec)
+  apply force
+  done
+
+lemma detype_inQ:
+  "\<lbrakk>pspace_aligned' s'; pspace_distinct' s'; \<forall>p. p \<in> S \<longrightarrow> \<not> ko_wp_at' live' p s'\<rbrakk>
+   \<Longrightarrow> \<forall>d p. (inQ d p |< ((\<lambda>x. if x \<in> S then None else ksPSpace s' x) |> tcb_of'))
+             = (inQ d p |< tcbs_of' s')"
+  using pspace_alignedD' pspace_distinctD'
+  using pspace_alignedD' pspace_distinctD'
+  apply (clarsimp simp: opt_map_def)
+  apply (rule ext)
+  apply (rename_tac s)
+  apply (clarsimp simp: inQ_def opt_pred_def ko_wp_at'_def live'_def split: option.splits)
+  apply (drule_tac x=s in spec)
+  apply force
+  done
+
+lemma detype_ready_queues_relation:
+  "\<lbrakk>pspace_aligned' s'; pspace_distinct' s';
+    \<forall>p. p \<in> {lower..upper} \<longrightarrow> \<not> ko_wp_at' live' p s';
+    ready_queues_relation s s'; upper = upper'\<rbrakk>
+   \<Longrightarrow> ready_queues_relation_2
+        (ready_queues (detype {lower..upper'} s))
+        (ksReadyQueues s')
+        ((\<lambda>x. if lower \<le> x \<and> x \<le> upper then None
+              else ksPSpace s' x) |>
+         tcb_of' |>
+         tcbSchedNext)
+        ((\<lambda>x. if lower \<le> x \<and> x \<le> upper then None
+              else ksPSpace s' x) |>
+         tcb_of' |>
+         tcbSchedPrev)
+        (\<lambda>d p. inQ d p |< ((\<lambda>x. if lower \<le> x \<and> x \<le> upper then None else ksPSpace s' x) |> tcb_of'))"
+  apply (clarsimp simp: detype_ext_def ready_queues_relation_def Let_def)
+  apply (frule (1) detype_tcbSchedNexts_of[where S="{lower..upper}"]; simp)
+  apply (frule (1) detype_tcbSchedPrevs_of[where S="{lower..upper}"]; simp)
+  apply (frule (1) detype_inQ[where S="{lower..upper}"]; simp)
+  apply (fastforce simp add: detype_def detype_ext_def wrap_ext_det_ext_ext_def)
+  done
+
 lemma deleteObjects_corres:
   "is_aligned base magnitude \<Longrightarrow> magnitude \<ge> 3 \<Longrightarrow>
    corres dc
@@ -980,19 +1044,19 @@ lemma deleteObjects_corres:
   apply (rule corres_stateAssert_implied[where P'=\<top>, simplified])
    prefer 2
    apply clarsimp
-   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 p_assoc_help invs_valid_pspace)[1]
-   apply (simp add:valid_cap_simps)
+   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 (fastforce simp: sch_act_simple_def schact_is_rct_def state_relation_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: valid_cap_simps)
   apply (simp add: ksASIDMapSafe_def)
   apply (simp add: delete_objects_def)
   apply (rule corres_underlying_split[where r'=dc])
@@ -1015,39 +1079,44 @@ lemma deleteObjects_corres:
                  untyped_children_in_mdb s \<and> if_unsafe_then_cap s \<and>
                  valid_global_refs s" and
                P'="\<lambda>s. s \<turnstile>' capability.UntypedCap d base magnitude idx \<and>
-                              valid_pspace' s" in corres_modify)
+                       valid_pspace' s \<and>
+                       deletionIsSafe_delete_locale base magnitude s" in corres_modify)
         apply (simp add: valid_pspace'_def)
         apply (rule state_relation_null_filterE, assumption,
                simp_all add: pspace_aligned'_cut pspace_distinct'_cut)[1]
-               apply (simp add: detype_def, rule state.equality;
-                      simp add: detype_ext_def wrap_ext_det_ext_ext_def)
-              apply (intro exI, fastforce)
-             apply (rule ext, clarsimp simp add: null_filter_def)
+                apply (simp add: detype_def, rule state.equality;
+                       simp add: detype_ext_def wrap_ext_det_ext_ext_def)
+               apply (intro exI, fastforce)
+              apply (rule ext, clarsimp simp add: null_filter_def)
+              apply (rule sym, rule ccontr, clarsimp)
+              apply (drule(4) cte_map_not_null_outside')
+               apply (fastforce simp add: cte_wp_at_caps_of_state)
+              apply simp
+             apply (rule ext, clarsimp simp: null_filter'_def map_to_ctes_delete)
              apply (rule sym, rule ccontr, clarsimp)
-             apply (drule(4) cte_map_not_null_outside')
-              apply (fastforce simp add: cte_wp_at_caps_of_state)
-             apply simp
-            apply (rule ext, clarsimp simp: null_filter'_def map_to_ctes_delete)
-            apply (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 (frule(2) pspace_relation_cte_wp_atI
+                             [OF state_relation_pspace_relation])
+             apply (elim exE)
+             apply (frule(4) cte_map_not_null_outside')
+              apply (rule cte_wp_at_weakenE, erule conjunct1)
+              apply (case_tac y, clarsimp)
+              apply (clarsimp simp: valid_mdb'_def valid_mdb_ctes_def
+                                    valid_nullcaps_def)
+             apply clarsimp
+             apply (frule_tac cref="(aa, ba)" in cte_map_untyped_range,
+                    erule cte_wp_at_weakenE[OF _ TrueI], assumption+)
+             apply (simp add: add_mask_fold)
             apply (simp add: add_mask_fold)
-           apply (simp add: add_mask_fold)
-           apply (rule detype_pspace_relation[simplified],
-                  simp_all add: state_relation_pspace_relation valid_pspace_def)[1]
-            apply (simp add: valid_cap'_def capAligned_def)
-           apply (clarsimp simp: valid_cap_def, assumption)
-          apply (fastforce simp: detype_def detype_ext_def add_mask_fold wrap_ext_det_ext_ext_def
-                           intro!: ekheap_relation_detype)
+            apply (rule detype_pspace_relation[simplified],
+                   simp_all add: state_relation_pspace_relation valid_pspace_def)[1]
+             apply (simp add: valid_cap'_def capAligned_def)
+            apply (clarsimp simp: valid_cap_def, assumption)
+           apply (fastforce simp: detype_def detype_ext_def add_mask_fold wrap_ext_det_ext_ext_def
+                            intro!: ekheap_relation_detype)
+          apply (rule detype_ready_queues_relation; blast?)
+            apply (clarsimp simp: deletionIsSafe_delete_locale_def)
+           apply (erule state_relation_ready_queues_relation)
+          apply (simp add: add_mask_fold)
          apply (clarsimp simp: state_relation_def ghost_relation_of_heap
                                detype_def)
          apply (drule_tac t="gsUserPages s'" in sym)
@@ -1063,13 +1132,31 @@ lemma deleteObjects_corres:
    apply fastforce
   apply (wpsimp wp: hoare_vcg_op_lift)
   done
-
 end
 
 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"
+  apply (case_tac "ko_wp_at' live' 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 invs_valid_idle'[OF invs])
+  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 mask_eq_exp_minus_1)
+  by fastforce
+
+lemma untyped_range_live_idle':
+  "p \<in> base_bits \<Longrightarrow> \<not> (ko_wp_at' live' p s' \<or> p = idle_thread_ptr)"
+  using live_idle_untyped_range' by blast
+
 lemma valid_obj':
-  "\<lbrakk> valid_obj' obj s'; ko_wp_at' ((=) obj) p s' \<rbrakk> \<Longrightarrow> valid_obj' obj state'"
+  "\<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 (rename_tac endpoint)
      apply (case_tac endpoint, simp_all add: valid_ep'_def)[1]
@@ -1096,18 +1183,30 @@ lemma valid_obj':
     apply (erule(2) cte_wp_at_tcbI')
      apply fastforce
     apply simp
-   apply (rename_tac tcb)
-   apply (simp only: conj_assoc[symmetric], rule conjI)
-   apply (case_tac "tcbState tcb";
-          clarsimp simp: valid_tcb_state'_def valid_bound_ntfn'_def
-                  dest!: refs_notRange split: option.splits)
-    using sym_hyp_refs
-    apply (clarsimp simp add: valid_arch_tcb'_def split: option.split_asm)
-    apply (drule (1) sym_refs_TCB_hyp_live'[rotated])
-     apply (clarsimp simp: ko_wp_at'_def objBits_simps; (rule conjI|assumption)+)
-    apply (drule live_notRange, clarsimp simp: live'_def)
-     apply (case_tac ko; simp)
-    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 live'_def)
+    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 live'_def)
+   using sym_hyp_refs
+   apply (clarsimp simp add: valid_arch_tcb'_def split: option.split_asm)
+   apply (drule (1) sym_refs_TCB_hyp_live'[rotated])
+    apply (clarsimp simp: ko_wp_at'_def objBits_simps; (rule conjI|assumption)+)
+   apply (drule live_notRange, clarsimp simp: live'_def)
+    apply (case_tac ko; simp)
+   apply clarsimp
   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])
@@ -1115,6 +1214,38 @@ lemma valid_obj':
   apply simp
   done
 
+lemma tcbSchedNexts_of_pspace':
+  "\<lbrakk>pspace_aligned' s'; pspace_distinct' s'; pspace_distinct' state'\<rbrakk>
+   \<Longrightarrow> (pspace' |> tcb_of' |> tcbSchedNext) = tcbSchedNexts_of s'"
+  apply (rule ext)
+  apply (rename_tac p)
+  apply (case_tac "p \<in> base_bits")
+   apply (frule untyped_range_live_idle')
+   apply (clarsimp simp: opt_map_def)
+   apply (case_tac "ksPSpace s' p"; clarsimp)
+   apply (rename_tac obj)
+   apply (case_tac "tcb_of' obj"; clarsimp)
+   apply (clarsimp simp: ko_wp_at'_def obj_at'_def live'_def)
+   apply (fastforce simp: pspace_alignedD' pspace_distinctD')
+  apply (clarsimp simp: opt_map_def split: option.splits)
+  done
+
+lemma tcbSchedPrevs_of_pspace':
+  "\<lbrakk>pspace_aligned' s'; pspace_distinct' s'; pspace_distinct' state'\<rbrakk>
+   \<Longrightarrow> (pspace' |> tcb_of' |> tcbSchedPrev) = tcbSchedPrevs_of s'"
+  apply (rule ext)
+  apply (rename_tac p)
+  apply (case_tac "p \<in> base_bits")
+   apply (frule untyped_range_live_idle')
+   apply (clarsimp simp: opt_map_def)
+   apply (case_tac "ksPSpace s' p"; clarsimp)
+   apply (rename_tac obj)
+   apply (case_tac "tcb_of' obj"; clarsimp)
+   apply (clarsimp simp: ko_wp_at'_def obj_at'_def live'_def)
+   apply (fastforce simp: pspace_alignedD' pspace_distinctD')
+  apply (clarsimp simp: opt_map_def split: option.splits)
+  done
+
 lemma st_tcb:
   "\<And>P p. \<lbrakk> st_tcb_at' P p s'; \<not> P Inactive; \<not> P IdleThreadState \<rbrakk> \<Longrightarrow> st_tcb_at' P p state'"
   by (fastforce simp: pred_tcb_at'_def obj_at'_real_def live'_def hyp_live'_def dest: live_notRange)
@@ -1324,17 +1455,18 @@ proof (simp add: invs'_def valid_state'_def valid_pspace'_def
   show "pspace_canonical' ?s" using pc
     by (simp add: pspace_canonical'_def dom_def)
 
-  show "pspace_distinct' ?s" using pd
+  show pspace_distinct'_state': "pspace_distinct' ?s" using pd
     by (clarsimp simp add: pspace_distinct'_def ps_clear_def
                            dom_if_None Diff_Int_distrib)
 
-  show "valid_objs' ?s" using valid_objs
+  show "valid_objs' ?s" using valid_objs sym_sched
     apply (clarsimp simp: valid_objs'_def ran_def)
     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
+     apply (frule pspace_alignedD'[OF _ pa])
+     apply (frule pspace_distinctD'[OF _ pd])
+     apply (clarsimp simp: ko_wp_at'_def)
+    apply fastforce
     done
 
   from sym_refs show "sym_refs (state_refs_of' ?s)"
@@ -1355,19 +1487,6 @@ proof (simp add: invs'_def valid_state'_def valid_pspace'_def
     apply (simp add: hyp_refs_notRange[simplified] state_hyp_refs_ko_wp_at_eq)
     done
 
-  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: inQ_def live'_def)
-    apply (clarsimp dest!: ex_nonz_cap_notRange)
-    done
-
-  from vq' show "valid_queues' ?s"
-    by (simp add: valid_queues'_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)
@@ -1609,6 +1728,20 @@ proof (simp add: invs'_def valid_state'_def valid_pspace'_def
     apply simp
     done
 
+  from vbm
+  show "valid_bitmaps state'"
+    by (simp add: valid_bitmaps_def bitmapQ_defs)
+
+  from sym_sched
+  show "sym_heap (pspace' |> tcb_of' |> tcbSchedNext) (pspace' |> tcb_of' |> tcbSchedPrev)"
+    using pa pd pspace_distinct'_state'
+    by (fastforce simp: tcbSchedNexts_of_pspace' tcbSchedPrevs_of_pspace')
+
+  from vsp show "valid_sched_pointers_2 (pspace' |> tcb_of' |> tcbSchedPrev)
+                                        (pspace' |> tcb_of' |> tcbSchedNext)
+                                        (tcbQueued |< (pspace' |> tcb_of'))"
+    by (clarsimp simp: valid_sched_pointers_def opt_pred_def opt_map_def)
+
 qed (clarsimp)
 
 lemma (in delete_locale) delete_ko_wp_at':
diff --git a/proof/refine/AARCH64/EmptyFail_H.thy b/proof/refine/AARCH64/EmptyFail_H.thy
index 9eebd65456..5b3b6380bf 100644
--- a/proof/refine/AARCH64/EmptyFail_H.thy
+++ b/proof/refine/AARCH64/EmptyFail_H.thy
@@ -183,7 +183,7 @@ lemma ignoreFailure_empty_fail[intro!, wp, simp]:
   by (simp add: ignoreFailure_def empty_fail_catch)
 
 crunch (empty_fail) empty_fail[intro!, wp, simp]: cancelIPC, setThreadState, tcbSchedDequeue, setupReplyMaster, isStopped, possibleSwitchTo, tcbSchedAppend
-(simp: Let_def setNotification_def setBoundNotification_def)
+(simp: Let_def setNotification_def setBoundNotification_def wp: empty_fail_getObject)
 
 crunch (empty_fail) "_H_empty_fail"[intro!, wp, simp]: "ThreadDecls_H.suspend"
   (ignore_del: ThreadDecls_H.suspend)
diff --git a/proof/refine/AARCH64/Finalise_R.thy b/proof/refine/AARCH64/Finalise_R.thy
index 7c6b922749..ccd451937a 100644
--- a/proof/refine/AARCH64/Finalise_R.thy
+++ b/proof/refine/AARCH64/Finalise_R.thy
@@ -79,20 +79,10 @@ crunch ksRQL1[wp]: emptySlot "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
 crunch ksRQL2[wp]: emptySlot "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
 crunch obj_at'[wp]: postCapDeletion "obj_at' P p"
 
-lemmas postCapDeletion_valid_queues[wp] =
-    valid_queues_lift [OF postCapDeletion_obj_at'
-                          postCapDeletion_pred_tcb_at'
-                          postCapDeletion_ksRQ]
-
 crunch inQ[wp]: clearUntypedFreeIndex "\<lambda>s. P (obj_at' (inQ d p) t s)"
 crunch tcbDomain[wp]: clearUntypedFreeIndex "obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t"
 crunch tcbPriority[wp]: clearUntypedFreeIndex "obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t"
 
-lemma emptySlot_queues [wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> emptySlot sl opt \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  unfolding emptySlot_def
-  by (wp | wpcw | wp valid_queues_lift | simp)+
-
 crunch nosch[wp]: emptySlot "\<lambda>s. P (ksSchedulerAction s)"
 crunch ksCurDomain[wp]: emptySlot "\<lambda>s. P (ksCurDomain s)"
 
@@ -1169,8 +1159,7 @@ definition
  "removeable' sl \<equiv> \<lambda>s cap.
     (\<exists>p. p \<noteq> sl \<and> cte_wp_at' (\<lambda>cte. capMasterCap (cteCap cte) = capMasterCap cap) p s)
     \<or> ((\<forall>p \<in> cte_refs' cap (irq_node' s). p \<noteq> sl \<longrightarrow> cte_wp_at' (\<lambda>cte. cteCap cte = NullCap) p s)
-         \<and> (\<forall>p \<in> zobj_refs' cap. ko_wp_at' (Not \<circ> live') p s)
-         \<and> (\<forall>t \<in> threadCapRefs cap. \<forall>p. t \<notin> set (ksReadyQueues s p)))"
+         \<and> (\<forall>p \<in> zobj_refs' cap. ko_wp_at' (Not \<circ> live') p s))"
 
 lemma not_Final_removeable:
   "\<not> isFinal cap sl (cteCaps_of s)
@@ -1388,11 +1377,6 @@ crunch irq_states' [wp]: emptySlot valid_irq_states'
 crunch no_0_obj' [wp]: emptySlot no_0_obj'
  (wp: crunch_wps)
 
-crunch valid_queues'[wp]: setInterruptState "valid_queues'"
-  (simp: valid_queues'_def)
-
-crunch valid_queues'[wp]: emptySlot "valid_queues'"
-
 end
 
 lemma deletedIRQHandler_irqs_masked'[wp]:
@@ -1484,6 +1468,13 @@ crunches deletedIRQHandler, updateMDB, updateCap, clearUntypedFreeIndex
 crunches global.postCapDeletion
   for valid_arch'[wp]: valid_arch_state'
 
+crunches emptySlot
+  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> (info \<noteq> NullCap \<longrightarrow> post_cap_delete_pre' info sl (cteCaps_of s) )\<rbrace>
@@ -2279,6 +2270,14 @@ 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)
 
+crunches 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]:
   "\<lbrace>invs'\<rbrace> unbindNotification tcb \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (simp add: unbindNotification_def invs'_def valid_state'_def)
@@ -2287,8 +2286,8 @@ lemma unbindNotification_invs[wp]:
   apply clarsimp
   apply (rule hoare_seq_ext[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
+  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 (clarsimp elim!: obj_atE'
@@ -2328,7 +2327,7 @@ lemma unbindMaybeNotification_invs[wp]:
   apply (simp add: unbindMaybeNotification_def invs'_def valid_state'_def)
   apply (rule hoare_seq_ext[OF _ get_ntfn_sp'])
   apply (rule hoare_pre)
-   apply (wp sbn'_valid_pspace'_inv sbn_sch_act' sbn_valid_queues valid_irq_node_lift
+   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)+
@@ -2551,14 +2550,6 @@ lemma archThreadSet_valid_arch_state'[wp]:
   apply (clarsimp simp: pred_conj_def)
   done
 
-lemma archThreadSet_valid_queues'[wp]:
-  "archThreadSet f t \<lbrace>valid_queues'\<rbrace>"
-  unfolding valid_queues'_def
-  apply (rule hoare_lift_Pf[where f=ksReadyQueues]; wp?)
-  apply (wp hoare_vcg_all_lift hoare_vcg_imp_lift)
-  apply auto
-  done
-
 lemma archThreadSet_ct_not_inQ[wp]:
   "archThreadSet f t \<lbrace>ct_not_inQ\<rbrace>"
   unfolding ct_not_inQ_def
@@ -2588,6 +2579,51 @@ lemma archThreadSet_tcb_at'[wp]:
   unfolding archThreadSet_def
   by (wpsimp wp: getObject_tcb_wp simp: obj_at'_def)
 
+lemma setObject_tcb_tcbs_of'[wp]:
+  "\<lbrace>\<lambda>s. P ((tcbs_of' s) (t \<mapsto> tcb))\<rbrace>
+   setObject t tcb
+   \<lbrace>\<lambda>_ s. P (tcbs_of' s)\<rbrace>"
+  unfolding setObject_def
+  apply (wpsimp simp: updateObject_default_def)
+  apply (erule rsubst[where P=P])
+  apply (rule ext)
+  apply (clarsimp simp: opt_map_def split: option.splits)
+  done
+
+lemma archThreadSet_tcbSchedPrevs_of[wp]:
+  "archThreadSet f t \<lbrace>\<lambda>s. P (tcbSchedPrevs_of s)\<rbrace>"
+  unfolding archThreadSet_def
+  apply (wp getObject_tcb_wp)
+  apply normalise_obj_at'
+  apply (erule rsubst[where P=P])
+  apply (rule ext)
+  apply (clarsimp simp: opt_map_def obj_at'_def split: option.splits)
+  done
+
+lemma archThreadSet_tcbSchedNexts_of[wp]:
+  "archThreadSet f t \<lbrace>\<lambda>s. P (tcbSchedNexts_of s)\<rbrace>"
+  unfolding archThreadSet_def
+  apply (wp getObject_tcb_wp)
+  apply normalise_obj_at'
+  apply (erule rsubst[where P=P])
+  apply (rule ext)
+  apply (clarsimp simp: opt_map_def obj_at'_def split: option.splits)
+  done
+
+lemma archThreadSet_tcbQueued[wp]:
+  "archThreadSet f t \<lbrace>\<lambda>s. P (tcbQueued |< tcbs_of' s)\<rbrace>"
+  unfolding archThreadSet_def
+  apply (wp getObject_tcb_wp)
+  apply normalise_obj_at'
+  apply (erule rsubst[where P=P])
+  apply (rule ext)
+  apply (clarsimp simp: opt_pred_def opt_map_def obj_at'_def split: option.splits)
+  done
+
+lemma archThreadSet_valid_sched_pointers[wp]:
+  "archThreadSet f t \<lbrace>valid_sched_pointers\<rbrace>"
+  by (wp_pre, wps, wp, assumption)
+
 lemma dissoc_invs':
   "\<lbrace>invs' and (\<lambda>s. \<forall>p. (\<exists>a. armHSCurVCPU (ksArchState s) = Some (p, a)) \<longrightarrow> p \<noteq> v) and
     ko_at' vcpu v and K (vcpuTCBPtr vcpu = Some t) and
@@ -2605,8 +2641,8 @@ lemma dissoc_invs':
                     valid_irq_node_lift_asm [where Q=\<top>] valid_irq_handlers_lift'
                     cteCaps_of_ctes_of_lift irqs_masked_lift ct_idle_or_in_cur_domain'_lift
                     valid_irq_states_lift' hoare_vcg_all_lift hoare_vcg_disj_lift
-                    setObject_typ_at' cur_tcb_lift
-                    setVCPU_valid_arch' archThreadSet_if_live'
+                    setObject_typ_at' cur_tcb_lift valid_bitmaps_lift
+                    setVCPU_valid_arch' archThreadSet_if_live' sym_heap_sched_pointers_lift
               simp: objBits_simps archObjSize_def vcpuBits_def pageBits_def
                     state_refs_of'_vcpu_empty state_hyp_refs_of'_vcpu_absorb valid_arch_tcb'_def
         | clarsimp simp: live'_def hyp_live'_def arch_live'_def)+
@@ -2651,7 +2687,7 @@ lemma when_assert_eq:
 lemma dissociateVCPUTCB_invs'[wp]:
   "dissociateVCPUTCB vcpu tcb \<lbrace>invs'\<rbrace>"
   unfolding dissociateVCPUTCB_def setVCPU_archThreadSet_None_eq when_assert_eq
-  apply ( wpsimp wp: dissoc_invs' getVCPU_wp | wpsimp wp: getObject_tcb_wp simp: archThreadGet_def)+
+  apply (wpsimp wp: dissoc_invs' getVCPU_wp | wpsimp wp: getObject_tcb_wp simp: archThreadGet_def)+
   apply (drule tcb_ko_at')
   apply clarsimp
   apply (rule exI, rule conjI, assumption)
@@ -2699,9 +2735,7 @@ lemma asUser_unlive[wp]:
   apply (case_tac ko; simp)
   apply (rename_tac tcb)
   apply (rule_tac x=tcb in exI)
-  apply (clarsimp simp: obj_at'_def)
-  apply (rule_tac x=tcb in exI, rule conjI; clarsimp simp: o_def)
-  apply (clarsimp simp: ko_wp_at'_def live'_def hyp_live'_def)
+  apply (clarsimp simp: obj_at'_def ko_wp_at'_def live'_def hyp_live'_def)
   done
 
 lemma dissociateVCPUTCB_unlive:
@@ -2793,7 +2827,6 @@ lemma cteDeleteOne_isFinal:
 
 lemmas setEndpoint_cteCaps_of[wp] = cteCaps_of_ctes_of_lift [OF set_ep_ctes_of]
 lemmas setNotification_cteCaps_of[wp] = cteCaps_of_ctes_of_lift [OF set_ntfn_ctes_of]
-lemmas setQueue_cteCaps_of[wp] = cteCaps_of_ctes_of_lift [OF setQueue_ctes_of]
 lemmas threadSet_cteCaps_of = cteCaps_of_ctes_of_lift [OF threadSet_ctes_of]
 
 crunches archThreadSet, vcpuUpdate, dissociateVCPUTCB
@@ -2882,16 +2915,6 @@ lemma unbindNotification_valid_objs'_helper':
   by (clarsimp simp: valid_bound_tcb'_def valid_ntfn'_def
                   split: option.splits ntfn.splits)
 
-lemma typ_at'_valid_tcb'_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_tcb' tcb s\<rbrace> f \<lbrace>\<lambda>rv s. valid_tcb' tcb s\<rbrace>"
-  including no_pre
-  apply (simp add: valid_tcb'_def)
-  apply (case_tac "tcbState tcb", simp_all add: valid_tcb_state'_def split_def valid_bound_ntfn'_def)
-         apply (wp hoare_vcg_const_Ball_lift typ_at_lifts[OF P]
-               | case_tac "tcbBoundNotification tcb", simp_all)+
-  done
-
 lemmas setNotification_valid_tcb' = typ_at'_valid_tcb'_lift [OF setNotification_typ_at']
 
 lemma unbindNotification_valid_objs'[wp]:
@@ -3040,10 +3063,6 @@ lemma unbindNotification_bound_tcb_at':
   apply (wp setBoundNotification_bound_tcb gbn_wp' | wpc | simp)+
   done
 
-crunches unbindNotification, unbindMaybeNotification
-  for valid_queues[wp]: "Invariants_H.valid_queues"
-  (wp: sbn_valid_queues)
-
 crunches unbindNotification, unbindMaybeNotification
   for weak_sch_act_wf[wp]: "\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s"
 
@@ -3126,6 +3145,52 @@ crunch invs[wp]: prepareThreadDelete "invs'" (ignore: doMachineOp)
 
 end
 
+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 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
+               split: option.splits)
+
+crunches updateRestartPC, cancelIPC
+  for valid_sched_pointers[wp]: valid_sched_pointers
+  (simp: crunch_simps wp: crunch_wps)
+
+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')
+
+context begin interpretation Arch . (*FIXME: arch_split*)
+
+lemma archThreadSet_tcbSchedPrevNext[wp]:
+  "archThreadSet f t' \<lbrace>obj_at' (\<lambda>tcb. P (tcbSchedNext tcb) (tcbSchedPrev tcb)) t\<rbrace>"
+  unfolding archThreadSet_def
+  apply (wpsimp wp: setObject_tcb_strongest getObject_tcb_wp)
+  apply normalise_obj_at'
+  apply auto
+  done
+
+crunches prepareThreadDelete
+  for tcbSchedPrevNext[wp]: "obj_at' (\<lambda>tcb. P (tcbSchedNext tcb) (tcbSchedPrev tcb)) t"
+  (wp: threadGet_wp getVCPU_wp archThreadGet_wp crunch_wps simp: crunch_simps)
+
+end
+
 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)))
@@ -3146,21 +3211,22 @@ lemma (in delete_one_conc_pre) finaliseCap_replaceable:
                      \<and> obj_at' (Not \<circ> tcbQueued) p s
                      \<and> bound_tcb_at' ((=) None) p s
                      \<and> ko_wp_at' (Not \<circ> hyp_live') p s
-                     \<and> (\<forall>pr. p \<notin> set (ksReadyQueues s pr))))\<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 (wp prepares_delete_helper'' [OF cancelAllIPC_unlive]
              prepares_delete_helper'' [OF cancelAllSignals_unlive]
-             suspend_isFinal prepareThreadDelete_unqueued prepareThreadDelete_nonq
+             suspend_isFinal prepareThreadDelete_unqueued
              prepareThreadDelete_inactive prepareThreadDelete_isFinal
-             suspend_makes_inactive suspend_nonq
+             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]],
@@ -3227,7 +3293,9 @@ lemma cancelIPC_cte_wp_at':
   apply (clarsimp simp: cteCaps_of_def cte_wp_at_ctes_of x)
   done
 
-crunch cte_wp_at'[wp]: tcbSchedDequeue "cte_wp_at' P p"
+crunches tcbSchedDequeue
+  for cte_wp_at'[wp]: "cte_wp_at' P p"
+  (wp: crunch_wps)
 
 lemma suspend_cte_wp_at':
   assumes x: "\<And>cap final. P cap \<Longrightarrow> finaliseCap cap final True = fail"
@@ -3355,25 +3423,6 @@ crunch sch_act_not[wp]: cteDeleteOne "sch_act_not t"
   (simp: crunch_simps case_Null_If unless_def
    wp: crunch_wps getObject_inv loadObject_default_inv)
 
-lemma cancelAllIPC_mapM_x_valid_queues:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. \<forall>t\<in>set q. tcb_at' t s)\<rbrace>
-   mapM_x (\<lambda>t. do
-                 y \<leftarrow> setThreadState Structures_H.thread_state.Restart t;
-                 tcbSchedEnqueue t
-               od) q
-   \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (rule_tac R="\<lambda>_ s. (\<forall>t\<in>set q. tcb_at' t s) \<and> valid_objs' s"
-               in hoare_post_add)
-  apply (rule hoare_pre)
-  apply (rule mapM_x_wp')
-  apply (rule hoare_name_pre_state)
-  apply (wp hoare_vcg_const_Ball_lift
-            tcbSchedEnqueue_valid_queues tcbSchedEnqueue_not_st
-            sts_valid_queues sts_st_tcb_at'_cases setThreadState_not_st
-       | simp
-       | ((elim conjE)?, drule (1) bspec, clarsimp elim!: obj_at'_weakenE simp: valid_tcb_state'_def))+
-  done
-
 lemma cancelAllIPC_mapM_x_weak_sch_act:
   "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
    mapM_x (\<lambda>t. do
@@ -3387,13 +3436,15 @@ lemma cancelAllIPC_mapM_x_weak_sch_act:
   done
 
 lemma cancelAllIPC_mapM_x_valid_objs':
-  "\<lbrace>valid_objs'\<rbrace>
+  "\<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 (wpsimp wp: mapM_x_wp' sts_valid_objs')
+  apply (rule hoare_strengthen_post)
+   apply (rule mapM_x_wp')
+  apply (wpsimp wp: sts_valid_objs')
    apply (clarsimp simp: valid_tcb_state'_def)+
   done
 
@@ -3404,17 +3455,12 @@ lemma cancelAllIPC_mapM_x_tcbDomain_obj_at':
                  tcbSchedEnqueue t
                od) q
   \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
-  by (wp mapM_x_wp' tcbSchedEnqueue_not_st setThreadState_oa_queued | simp)+
+  by (wp mapM_x_wp' | simp)+
 
 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)
-  apply (wp tcbSchedEnqueue_not_st
-       | wpc
-       | simp)+
-  done
+  "rescheduleRequired \<lbrace>obj_at' (\<lambda>tcb. Q (tcbDomain tcb) (tcbPriority tcb)) t\<rbrace>"
+  unfolding rescheduleRequired_def tcbSchedEnqueue_def tcbQueuePrepend_def
+  by wpsimp
 
 lemma cancelAllIPC_tcbDomain_obj_at':
   "\<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>
@@ -3428,21 +3474,6 @@ lemma cancelAllIPC_tcbDomain_obj_at':
        | simp)+
   done
 
-lemma cancelAllIPC_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)\<rbrace>
-   cancelAllIPC ep_ptr
-   \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: cancelAllIPC_def ep'_Idle_case_helper)
-  apply (wp hoare_vcg_conj_lift hoare_vcg_const_Ball_lift
-            cancelAllIPC_mapM_x_valid_queues cancelAllIPC_mapM_x_valid_objs' cancelAllIPC_mapM_x_weak_sch_act
-            set_ep_valid_objs' getEndpoint_wp)
-  apply (clarsimp simp: valid_ep'_def)
-  apply (drule (1) ko_at_valid_objs')
-  apply (auto simp: valid_obj'_def valid_ep'_def valid_tcb'_def
-             split: endpoint.splits
-              elim: valid_objs_valid_tcbE)
-  done
-
 lemma cancelAllSignals_tcbDomain_obj_at':
   "\<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>
      cancelAllSignals epptr
@@ -3459,41 +3490,8 @@ 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>"
-  apply (simp add: unbindMaybeNotification_def)
-  apply (wp setBoundNotification_oa_queued getNotification_wp gbn_wp' | wpc | simp)+
-  done
-
-lemma cancelAllSignals_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)\<rbrace>
-   cancelAllSignals ntfn
-   \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: cancelAllSignals_def)
-  apply (rule hoare_seq_ext [OF _ get_ntfn_sp'])
-  apply (case_tac "ntfnObj ntfna", simp_all)
-    apply (wp, simp)+
-    apply (wp hoare_vcg_conj_lift hoare_vcg_const_Ball_lift
-              cancelAllIPC_mapM_x_valid_queues cancelAllIPC_mapM_x_valid_objs' cancelAllIPC_mapM_x_weak_sch_act
-              set_ntfn_valid_objs'
-          | simp)+
-  apply (clarsimp simp: valid_ep'_def)
-  apply (drule (1) ko_at_valid_objs')
-  apply (auto simp: valid_obj'_def valid_ntfn'_def valid_tcb'_def
-             split: endpoint.splits
-              elim: valid_objs_valid_tcbE)
-  done
-
-lemma finaliseCapTrue_standin_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)\<rbrace>
-   finaliseCapTrue_standin cap final
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: finaliseCapTrue_standin_def Let_def)
-  apply (safe)
-       apply (wp | clarsimp | wpc)+
-  done
-
-
-crunch valid_queues[wp]: isFinalCapability "Invariants_H.valid_queues"
-  (simp: crunch_simps)
+  unfolding unbindMaybeNotification_def
+  by (wpsimp wp: getNotification_wp gbn_wp' simp: setBoundNotification_def)+
 
 crunch sch_act[wp]: isFinalCapability "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
   (simp: crunch_simps)
@@ -3502,93 +3500,6 @@ crunch weak_sch_act[wp]:
   isFinalCapability "\<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. \<lbrace>obj_at' (inQ d p) tcb\<rbrace> f \<lbrace>\<lambda>_. obj_at' (inQ d p) tcb\<rbrace>"
-  and     prq: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueues s)\<rbrace>"
-  shows   "\<lbrace>valid_inQ_queues\<rbrace> f \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  proof -
-    show ?thesis
-      apply (clarsimp simp: valid_def valid_inQ_queues_def)
-      apply safe
-       apply (rule use_valid [OF _ tat], assumption)
-       apply (drule spec, drule spec, erule conjE, erule bspec)
-       apply (rule ccontr)
-       apply (erule notE[rotated], erule(1) use_valid [OF _ prq])
-      apply (erule use_valid [OF _ prq])
-      apply simp
-      done
-  qed
-
-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)+
-
-lemma cancelAllIPC_mapM_x_valid_inQ_queues:
-  "\<lbrace>valid_inQ_queues\<rbrace>
-   mapM_x (\<lambda>t. do
-                 y \<leftarrow> setThreadState Structures_H.thread_state.Restart t;
-                 tcbSchedEnqueue t
-               od) q
-   \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (rule mapM_x_wp_inv)
-  apply (wp sts_valid_queues [where st="Structures_H.thread_state.Restart", simplified]
-            setThreadState_st_tcb)
-   done
-
-lemma cancelAllIPC_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace>
-   cancelAllIPC ep_ptr
-   \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (simp add: cancelAllIPC_def ep'_Idle_case_helper)
-  apply (wp cancelAllIPC_mapM_x_valid_inQ_queues)
-  apply (wp hoare_conjI hoare_drop_imp | simp)+
-  done
-
-lemma cancelAllSignals_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace>
-   cancelAllSignals ntfn
-   \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (simp add: cancelAllSignals_def)
-  apply (rule hoare_seq_ext [OF _ get_ntfn_sp'])
-  apply (case_tac "ntfnObj ntfna", simp_all)
-    apply (wp, simp)+
-    apply (wp cancelAllIPC_mapM_x_valid_inQ_queues)+
-   apply (simp)
-  done
-
-crunches unbindNotification, unbindMaybeNotification
-  for valid_inQ_queues[wp]: "valid_inQ_queues"
-
-lemma finaliseCapTrue_standin_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace>
-   finaliseCapTrue_standin cap final
-   \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  apply (simp add: finaliseCapTrue_standin_def Let_def)
-  apply (safe)
-       apply (wp | clarsimp | wpc)+
-  done
-
-crunch valid_inQ_queues[wp]: isFinalCapability valid_inQ_queues
-  (simp: crunch_simps)
-
-lemma cteDeleteOne_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<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)
-  done
-
 crunch ksCurDomain[wp]: cteDeleteOne "\<lambda>s. P (ksCurDomain s)"
   (wp: crunch_wps simp: crunch_simps unless_def)
 
@@ -4114,178 +4025,6 @@ lemma isFinal_lift:
 
 lemmas final_matters'_simps = final_matters'_def [split_simps capability.split arch_capability.split]
 
-definition set_thread_all :: "obj_ref \<Rightarrow> Structures_A.tcb \<Rightarrow> etcb
-                                \<Rightarrow> unit det_ext_monad" where
-  "set_thread_all ptr tcb etcb \<equiv>
-     do s \<leftarrow> get;
-       kh \<leftarrow> return $ (kheap s)(ptr \<mapsto> (TCB tcb));
-       ekh \<leftarrow> return $ (ekheap s)(ptr \<mapsto> etcb);
-       put (s\<lparr>kheap := kh, ekheap := ekh\<rparr>)
-     od"
-
-definition thread_gets_the_all :: "obj_ref \<Rightarrow> (Structures_A.tcb \<times> etcb) det_ext_monad" where
-  "thread_gets_the_all tptr \<equiv>
-          do tcb \<leftarrow> gets_the $ get_tcb tptr;
-             etcb \<leftarrow> gets_the $ get_etcb tptr;
-             return $ (tcb, etcb) od"
-
-definition thread_set_all :: "(Structures_A.tcb \<Rightarrow> Structures_A.tcb) \<Rightarrow> (etcb \<Rightarrow> etcb)
-                  \<Rightarrow> obj_ref \<Rightarrow> unit det_ext_monad" where
-  "thread_set_all f g tptr \<equiv>
-     do (tcb, etcb) \<leftarrow> thread_gets_the_all tptr;
-        set_thread_all tptr (f tcb) (g etcb)
-     od"
-
-lemma set_thread_all_corres:
-  fixes ob' :: "'a :: pspace_storable"
-  assumes x: "updateObject ob' = updateObject_default ob'"
-  assumes z: "\<And>s. obj_at' P ptr s
-               \<Longrightarrow> map_to_ctes ((ksPSpace s) (ptr \<mapsto> injectKO ob')) = map_to_ctes (ksPSpace s)"
-  assumes b: "\<And>ko. P ko \<Longrightarrow> objBits ko = objBits ob'"
-  assumes P: "\<And>(v::'a::pspace_storable). (1 :: machine_word) < 2 ^ (objBits v)"
-  assumes e: "etcb_relation etcb tcb'"
-  assumes is_t: "injectKO (ob' :: 'a :: pspace_storable) = KOTCB tcb'"
-  shows      "other_obj_relation (TCB tcb) (injectKO (ob' :: 'a :: pspace_storable)) \<Longrightarrow>
-  corres dc (obj_at (same_caps (TCB tcb)) ptr and is_etcb_at ptr)
-            (obj_at' (P :: 'a \<Rightarrow> bool) ptr)
-            (set_thread_all ptr tcb etcb) (setObject ptr ob')"
-  apply (rule corres_no_failI)
-   apply (rule no_fail_pre)
-    apply wp
-    apply (rule x)
-   apply (clarsimp simp: b elim!: obj_at'_weakenE)
-  apply (unfold set_thread_all_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
-                        updateObject_default_def in_magnitude_check [OF _ P])
-  apply (clarsimp simp add: state_relation_def z)
-  apply (simp flip: trans_state_update)
-  apply (clarsimp simp add: swp_def fun_upd_def obj_at_def is_etcb_at_def)
-  apply (subst cte_wp_at_after_update,fastforce simp add: obj_at_def)
-  apply (subst caps_of_state_after_update,fastforce simp add: obj_at_def)
-  apply clarsimp
-  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
-                   split: Structures_A.kernel_object.splits if_split_asm)
-
-  apply (fold fun_upd_def)
-  apply (simp only: pspace_relation_def dom_fun_upd2 simp_thms)
-  apply (subst pspace_dom_update)
-    apply assumption
-   apply simp
-  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: is_other_obj_relation_type)
-   apply (drule(1) bspec)
-   apply clarsimp
-   apply (frule_tac ko'="TCB tcb'" and x'=ptr in obj_relation_cut_same_type,
-           (fastforce simp add: is_other_obj_relation_type)+)[1]
-  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 is_t)
-  by (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)
-
-lemma tcb_update_all_corres':
-  assumes tcbs: "tcb_relation tcb tcb' \<Longrightarrow> tcb_relation tcbu tcbu'"
-  assumes tables: "\<forall>(getF, v) \<in> ran tcb_cap_cases. getF tcbu = getF tcb"
-  assumes tables': "\<forall>(getF, v) \<in> ran tcb_cte_cases. getF tcbu' = getF tcb'"
-  assumes r: "r () ()"
-  assumes e: "etcb_relation etcb tcb' \<Longrightarrow> etcb_relation etcbu tcbu'"
-  shows "corres r (ko_at (TCB tcb) add and (\<lambda>s. ekheap s add = Some etcb))
-                  (ko_at' tcb' add)
-                  (set_thread_all add tcbu etcbu) (setObject add tcbu')"
-  apply (rule_tac F="tcb_relation tcb tcb' \<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 (force simp: other_obj_relation_def ekheap_relation_def e)
-  apply (erule conjE)
-  apply (rule corres_guard_imp)
-    apply (rule corres_rel_imp)
-     apply (rule set_thread_all_corres[where P="(=) tcb'"])
-           apply (rule ext)+
-           apply simp
-          defer
-          apply (simp add: is_other_obj_relation_type_def
-                           objBits_simps' other_obj_relation_def tcbs r)+
-    apply (fastforce simp: is_etcb_at_def elim!: obj_at_weakenE dest: bspec[OF tables])
-   apply (subst(asm) eq_commute, assumption)
-  apply (clarsimp simp: obj_at'_def objBits_simps)
-  apply (subst map_to_ctes_upd_tcb, assumption+)
-   apply (simp add: ps_clear_def3 field_simps objBits_defs mask_def)
-  apply (subst if_not_P)
-   apply (fastforce dest: bspec [OF tables', OF ranI])
-  apply simp
-  done
-
-lemma thread_gets_the_all_corres:
-  shows      "corres (\<lambda>(tcb, etcb) tcb'. tcb_relation tcb tcb' \<and> etcb_relation etcb tcb')
-                (tcb_at t and is_etcb_at t) (tcb_at' t)
-                (thread_gets_the_all t) (getObject t)"
-  apply (rule corres_no_failI)
-   apply wp
-  apply (clarsimp simp: gets_def get_def return_def bind_def get_tcb_def thread_gets_the_all_def
-                        threadGet_def ethread_get_def gets_the_def assert_opt_def get_etcb_def
-                        is_etcb_at_def tcb_at_def liftM_def
-                  split: option.splits Structures_A.kernel_object.splits)
-  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 ko)
-   apply (simp_all add: fail_def return_def)
-  apply (clarsimp simp add: state_relation_def pspace_relation_def ekheap_relation_def)
-  apply (drule bspec)
-   apply clarsimp
-   apply blast
-  apply (drule bspec, erule domI)
-  apply (clarsimp simp add: other_obj_relation_def
-                            lookupAround2_known1)
-  done
-
-lemma thread_set_all_corresT:
-  assumes x: "\<And>tcb tcb'. tcb_relation tcb tcb' \<Longrightarrow>
-                         tcb_relation (f tcb) (f' tcb')"
-  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"
-  assumes e: "\<And>etcb tcb'. etcb_relation etcb tcb' \<Longrightarrow>
-                         etcb_relation (g etcb) (f' tcb')"
-  shows      "corres dc (tcb_at t and valid_etcbs)
-                        (tcb_at' t)
-                    (thread_set_all f g t) (threadSet f' t)"
-  apply (simp add: thread_set_all_def threadSet_def bind_assoc)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF thread_gets_the_all_corres])
-      apply (simp add: split_def)
-      apply (rule tcb_update_all_corres')
-          apply (erule x)
-         apply (rule y)
-        apply (clarsimp simp: bspec_split [OF spec [OF z]])
-       apply fastforce
-      apply (erule e)
-     apply (simp add: thread_gets_the_all_def, wp+)
-   apply clarsimp
-   apply (frule(1) tcb_at_is_etcb_at)
-   apply (clarsimp simp add: tcb_at_def get_etcb_def obj_at_def)
-   apply (drule get_tcb_SomeD)
-   apply fastforce
-  apply simp
-  done
-
-lemmas thread_set_all_corres =
-    thread_set_all_corresT [OF _ _ all_tcbI, OF _ ball_tcb_cap_casesI ball_tcb_cte_casesI]
-
 crunch idle_thread[wp]: deleteCallerCap "\<lambda>s. P (ksIdleThread s)"
   (wp: crunch_wps)
 crunch sch_act_simple: deleteCallerCap sch_act_simple
@@ -4301,89 +4040,6 @@ lemma setEndpoint_sch_act_not_ct[wp]:
    setEndpoint ptr val \<lbrace>\<lambda>_ s. sch_act_not (ksCurThread s) s\<rbrace>"
   by (rule hoare_weaken_pre, wps setEndpoint_ct', wp, simp)
 
-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
-
-lemma cancelAllIPC_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>
-   cancelAllIPC epptr
-   \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  (is "\<lbrace>?PRE\<rbrace> _ \<lbrace>\<lambda>_. ?POST\<rbrace>")
-  apply (simp add: cancelAllIPC_def)
-  apply (wp, wpc, wp)
-        apply (wps rescheduleRequired_ct')
-        apply (wp rescheduleRequired_ksQ')
-       apply (clarsimp)
-       apply (wp cancelAll_ct_not_ksQ_helper mapM_x_wp_inv)
-      apply (wp hoare_lift_Pf2 [OF setEndpoint_ksQ setEndpoint_ct'])+
-      apply (wps rescheduleRequired_ct')
-      apply (wp rescheduleRequired_ksQ')
-     apply (clarsimp)
-     apply (wp cancelAll_ct_not_ksQ_helper mapM_x_wp_inv)
-    apply (wp hoare_lift_Pf2 [OF setEndpoint_ksQ setEndpoint_ct'])+
-   prefer 2
-   apply assumption
-  apply (rule_tac Q="\<lambda>ep. ?PRE and ko_at' ep epptr" in hoare_post_imp)
-   apply (clarsimp)
-   apply (rule conjI)
-    apply ((clarsimp simp: invs'_def valid_state'_def
-                           sch_act_sane_def
-            | drule(1) ct_not_in_epQueue)+)[2]
-  apply (wp get_ep_sp')
-  done
-
-lemma cancelAllSignals_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>
-   cancelAllSignals ntfnptr
-   \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  (is "\<lbrace>?PRE\<rbrace> _ \<lbrace>\<lambda>_. ?POST\<rbrace>")
-  apply (simp add: cancelAllSignals_def)
-  apply (wp, wpc, wp+)
-      apply (wps rescheduleRequired_ct')
-      apply (wp rescheduleRequired_ksQ')
-     apply clarsimp
-     apply (wp cancelAll_ct_not_ksQ_helper mapM_x_wp_inv)
-    apply (wp hoare_lift_Pf2 [OF setNotification_ksQ setNotification_ksCurThread])
-    apply (wps setNotification_ksCurThread, wp)
-   prefer 2
-   apply assumption
-  apply (rule_tac Q="\<lambda>ep. ?PRE and ko_at' ep ntfnptr" in hoare_post_imp)
-   apply ((clarsimp simp: invs'_def valid_state'_def sch_act_sane_def
-          | drule(1) ct_not_in_ntfnQueue)+)[1]
-  apply (wp get_ntfn_sp')
-  done
-
-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 hoare_seq_ext[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 setNotification_ksCurThread, wp)
-  apply clarsimp
-  done
-
 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)
@@ -4416,37 +4072,6 @@ lemma unbindMaybeNotification_sch_act_sane[wp]:
   apply (wp setNotification_sch_act_sane sbn_sch_act_sane | wpc | clarsimp)+
   done
 
-lemma finaliseCapTrue_standin_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>
-   finaliseCapTrue_standin cap final
-   \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: finaliseCapTrue_standin_def Let_def)
-  apply (safe)
-      apply (wp cancelAllIPC_ct_not_ksQ cancelAllSignals_ct_not_ksQ
-                hoare_drop_imps unbindMaybeNotification_ct_not_ksQ
-             | wpc
-             | clarsimp simp: isNotificationCap_def isReplyCap_def split:capability.splits)+
-  done
-
-lemma cteDeleteOne_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>
-   cteDeleteOne slot
-   \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: cteDeleteOne_def unless_def split_def)
-  apply (rule hoare_seq_ext [OF _ getCTE_sp])
-  apply (case_tac "\<forall>final. finaliseCap (cteCap cte) final True = fail")
-   apply (simp add: finaliseCapTrue_standin_simple_def)
-   apply wp
-   apply (clarsimp)
-  apply (wp emptySlot_cteCaps_of hoare_lift_Pf2 [OF emptySlot_ksRQ emptySlot_ct])
-    apply (simp add: cteCaps_of_def)
-    apply (wp (once) hoare_drop_imps)
-    apply (wp finaliseCapTrue_standin_ct_not_ksQ isFinalCapability_inv)+
-  apply (clarsimp)
-  done
-
 end
 
 end
diff --git a/proof/refine/AARCH64/Init_R.thy b/proof/refine/AARCH64/Init_R.thy
index 9b15030e68..ce9e5cbc2b 100644
--- a/proof/refine/AARCH64/Init_R.thy
+++ b/proof/refine/AARCH64/Init_R.thy
@@ -98,7 +98,7 @@ definition zeroed_intermediate_state ::
     ksDomSchedule = [],
     ksCurDomain = 0,
     ksDomainTime = 0,
-    ksReadyQueues = K [],
+    ksReadyQueues = K (TcbQueue None None),
     ksReadyQueuesL1Bitmap = K 0,
     ksReadyQueuesL2Bitmap = K 0,
     ksCurThread = 0,
@@ -119,9 +119,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: ekheap_relation_def)
-         apply (clarsimp simp: ready_queues_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/AARCH64/InterruptAcc_R.thy b/proof/refine/AARCH64/InterruptAcc_R.thy
index 3f046d309e..d5d604d382 100644
--- a/proof/refine/AARCH64/InterruptAcc_R.thy
+++ b/proof/refine/AARCH64/InterruptAcc_R.thy
@@ -50,14 +50,14 @@ lemma setIRQState_invs[wp]:
   apply (simp add: setIRQState_def setInterruptState_def getInterruptState_def)
   apply (wp dmo_maskInterrupt)
   apply (clarsimp simp: invs'_def valid_state'_def cur_tcb'_def
-                        Invariants_H.valid_queues_def valid_queues'_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 split: option.splits)
+                        bitmapQ_defs valid_bitmaps_def
+                  split: option.splits)
    apply (rule conjI, clarsimp)
    apply (clarsimp simp: irqs_masked'_def ct_not_inQ_def)
    apply (rule conjI, fastforce)
@@ -150,8 +150,7 @@ lemma invs'_irq_state_independent [simp, intro!]:
           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_queues_no_bitmap_def
-          valid_queues'_def
+          irqs_masked'_def bitmapQ_defs valid_bitmaps_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
diff --git a/proof/refine/AARCH64/Interrupt_R.thy b/proof/refine/AARCH64/Interrupt_R.thy
index c93c7b9f24..fb63b89d88 100644
--- a/proof/refine/AARCH64/Interrupt_R.thy
+++ b/proof/refine/AARCH64/Interrupt_R.thy
@@ -599,13 +599,6 @@ lemma decDomainTime_corres:
   apply (clarsimp simp:state_relation_def)
   done
 
-lemma tcbSchedAppend_valid_objs':
-  "\<lbrace>valid_objs'\<rbrace>tcbSchedAppend t \<lbrace>\<lambda>r. valid_objs'\<rbrace>"
-  apply (simp add:tcbSchedAppend_def)
-  apply (wpsimp wp: unless_wp threadSet_valid_objs' threadGet_wp)
-  apply (clarsimp simp add:obj_at'_def typ_at'_def)
-  done
-
 lemma thread_state_case_if:
  "(case state of Structures_A.thread_state.Running \<Rightarrow> f | _ \<Rightarrow> g) =
   (if state = Structures_A.thread_state.Running then f else g)"
@@ -616,26 +609,19 @@ lemma threadState_case_if:
   (if state = Structures_H.thread_state.Running then f else g)"
   by (case_tac state,auto)
 
-lemma tcbSchedAppend_invs_but_ct_not_inQ':
-  "\<lbrace>invs' and st_tcb_at' runnable' t \<rbrace>
-   tcbSchedAppend t \<lbrace>\<lambda>_. all_invs_but_ct_not_inQ'\<rbrace>"
-  apply (simp add: invs'_def valid_state'_def)
-  apply (rule hoare_pre)
-   apply (wp 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
-        | fastforce elim!: st_tcb_ex_cap'' split: thread_state.split_asm)+
-  done
+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 timerTick_corres:
-  "corres dc (cur_tcb and valid_sched and pspace_aligned and pspace_distinct)
-             invs'
-             timer_tick timerTick"
+  "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="\<top> and (cur_tcb and valid_sched and pspace_aligned and pspace_distinct)"
-                  and Q'="\<top> and invs'" in corres_guard_imp)
+  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
@@ -655,41 +641,51 @@ lemma timerTick_corres:
                 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])
+                  apply (rule corres_split[OF tcbSchedAppend_corres], simp)
                     apply (rule rescheduleRequired_corres)
-                   apply (wp)[1]
-                  apply (rule hoare_strengthen_post)
-                   apply (rule tcbSchedAppend_invs_but_ct_not_inQ', clarsimp simp: sch_act_wf_weak)
-                 apply (wp threadSet_timeslice_invs threadSet_valid_queues
-                           threadSet_valid_queues' threadSet_pred_tcb_at_state)+
-             apply simp
-            apply (rule corres_when,simp)
+                   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 (simp add:dec_domain_time_def)
-             apply wp+
-            apply (simp add:decDomainTime_def)
-            apply wp
-           apply (wpsimp wp: hoare_weak_lift_imp threadSet_timeslice_invs threadSet_valid_queues
-                             threadSet_valid_queues' tcbSchedAppend_valid_objs'
+             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 tcbSchedAppend_valid_queues)+
-             apply (strengthen sch_act_wf_weak)
-             apply (clarsimp simp:conj_comms)
-             apply (wp tcbSchedAppend_valid_queues tcbSchedAppend_sch_act_wf)
-            apply simp
-            apply (wpsimp wp: threadSet_valid_queues threadSet_pred_tcb_at_state threadSet_sch_act
-                              threadSet_tcbDomain_triv threadSet_valid_queues' threadSet_valid_objs'
-                              threadGet_wp gts_wp gts_wp')+
-     apply (clarsimp simp: cur_tcb_def tcb_at_is_etcb_at valid_sched_def valid_sched_action_def)
-    apply (clarsimp simp: invs'_def valid_state'_def sch_act_wf_weak cur_tcb'_def inQ_def
-                          ct_in_state'_def obj_at'_def)
-    apply (clarsimp simp:st_tcb_at'_def valid_idle'_def ct_idle_or_in_cur_domain'_def obj_at'_def)
-   apply simp
-  apply simp
+                             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
 
 lemma corres_return_VGICMaintenance [corres]:
@@ -749,7 +745,7 @@ lemma not_pred_tcb':
 
 lemma vgic_maintenance_corres [corres]:
   "corres dc einvs
-    (\<lambda>s. invs' s \<and> sch_act_not (ksCurThread s) s \<and> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)))
+    (\<lambda>s. invs' s \<and> sch_act_not (ksCurThread s) s)
     vgic_maintenance vgicMaintenance"
 proof -
   (* hoare_lift_Pf-style rules match too often, slowing down proof unless specialised *)
@@ -760,7 +756,6 @@ proof -
   note wplr' = vilr'[where P="sch_act_not"]
                vilr'[where P="ex_nonz_cap_to'"]
                vilr'[where P="st_tcb_at' simple'"]
-               vilr'[where P="\<lambda>t s. t \<notin> set (ksReadyQueues s x)" for x]
   show ?thesis
     unfolding vgic_maintenance_def vgicMaintenance_def isRunnable_def Let_def
     apply (rule corres_guard_imp)
@@ -819,8 +814,7 @@ proof -
                   apply clarsimp
                   apply (rule_tac Q="\<lambda>rv x. tcb_at' rv x
                                             \<and> invs' x
-                                            \<and> sch_act_not rv x
-                                            \<and> (\<forall>d p. rv \<notin> set (ksReadyQueues x (d, p)))"
+                                            \<and> sch_act_not rv x"
                            in hoare_post_imp)
                    apply (rename_tac rv s)
                    apply clarsimp
@@ -850,7 +844,7 @@ qed
 
 lemma vppiEvent_corres:
   "corres dc einvs
-    (\<lambda>s. invs' s \<and> sch_act_not (ksCurThread s) s \<and> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)))
+    (\<lambda>s. invs' s \<and> sch_act_not (ksCurThread s) s)
     (vppi_event irq) (vppiEvent irq)"
   unfolding vppi_event_def vppiEvent_def isRunnable_def
   supply [[simproc del: defined_all]]
@@ -893,8 +887,7 @@ lemma vppiEvent_corres:
           apply (clarsimp cong: imp_cong conj_cong simp: pred_conj_def)
           apply (rule_tac Q="\<lambda>rv x. tcb_at' rv x
                                     \<and> invs' x
-                                    \<and> sch_act_not rv x
-                                    \<and> (\<forall>d p. rv \<notin> set (ksReadyQueues x (d, p)))" in hoare_post_imp)
+                                    \<and> sch_act_not rv x" in hoare_post_imp)
            apply (rename_tac rv s)
            apply (strengthen st_tcb_ex_cap''[where P=active'])
            apply (strengthen invs_iflive')
@@ -922,8 +915,7 @@ lemma vppiEvent_corres:
 
 lemma handle_reserved_irq_corres[corres]:
   "corres dc einvs
-      (\<lambda>s. invs' s \<and> (irq \<in> non_kernel_IRQs \<longrightarrow>
-              sch_act_not (ksCurThread s) s \<and> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))))
+      (\<lambda>s. invs' s \<and> (irq \<in> non_kernel_IRQs \<longrightarrow> sch_act_not (ksCurThread s) s))
       (handle_reserved_irq irq) (handleReservedIRQ irq)"
   apply (clarsimp simp: handle_reserved_irq_def handleReservedIRQ_def irqVPPIEventIndex_def
                         irq_vppi_event_index_def non_kernel_IRQs_def IRQ_def irqVGICMaintenance_def
@@ -981,16 +973,10 @@ lemma handleInterrupt_corres:
       apply (rule corres_machine_op)
       apply (rule corres_eq_trivial; simp)
      apply wp+
-   apply (clarsimp simp: invs_distinct invs_psp_aligned)
+   apply (clarsimp simp: invs_distinct invs_psp_aligned schact_is_rct_def)
   apply clarsimp
   done
 
-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 ksDomainTime[wp]: rescheduleRequired "\<lambda>s. P (ksDomainTime s)"
 (simp:tcbSchedEnqueue_def wp:unless_wp)
 
@@ -1004,14 +990,6 @@ lemma updateTimeSlice_valid_pspace[wp]:
   apply (auto simp:tcb_cte_cases_def cteSizeBits_def)
   done
 
-lemma updateTimeSlice_valid_queues[wp]:
-  "\<lbrace>\<lambda>s. Invariants_H.valid_queues s \<rbrace>
-   threadSet (tcbTimeSlice_update (\<lambda>_. ts')) thread
-   \<lbrace>\<lambda>r s. Invariants_H.valid_queues s\<rbrace>"
-  apply (wp threadSet_valid_queues,simp)
-  apply (clarsimp simp:obj_at'_def inQ_def)
-  done
-
 lemma dom_upd_eq:
   "f t = Some y \<Longrightarrow> dom (\<lambda>a. if a = t then Some x else f a) = dom f"
   by (auto split: if_split_asm)
@@ -1036,29 +1014,29 @@ crunches tcbSchedAppend
   (simp: unless_def tcb_cte_cases_def cteSizeBits_def wp: crunch_wps cur_tcb_lift)
 
 lemma timerTick_invs'[wp]:
-  "\<lbrace>invs'\<rbrace> timerTick \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  "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
-                    tcbSchedAppend_invs_but_ct_not_inQ'
-                simp: tcb_cte_cases_def)
-     apply (rule_tac Q="\<lambda>rv. invs'" in hoare_post_imp)
-     apply (clarsimp simp add:invs'_def valid_state'_def)
+              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'
-                          del: tcbSchedAppend_sch_act_wf)+
-             apply (rule hoare_strengthen_post[OF tcbSchedAppend_invs_but_ct_not_inQ'])
-             apply (wpsimp simp: valid_pspace'_def sch_act_wf_weak)+
-           apply (wpsimp wp: threadSet_pred_tcb_no_state threadSet_tcbDomain_triv
-                             threadSet_valid_objs' threadSet_timeslice_invs)+
-       apply (wp threadGet_wp)
+            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 (clarsimp simp: invs'_def st_tcb_at'_def obj_at'_def valid_state'_def)
+  apply (auto simp: invs'_def st_tcb_at'_def obj_at'_def valid_state'_def cong: conj_cong)
   done
 
 lemma resetTimer_invs'[wp]:
@@ -1088,7 +1066,7 @@ lemma runnable'_eq:
   by (cases st; simp)
 
 lemma vgicMaintenance_invs'[wp]:
-  "\<lbrace>invs' and (\<lambda>s. sch_act_not (ksCurThread s) s \<and> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)))\<rbrace>
+  "\<lbrace>invs' and (\<lambda>s. sch_act_not (ksCurThread s) s)\<rbrace>
    vgicMaintenance
    \<lbrace>\<lambda>_. invs'\<rbrace>"
   supply if_split[split del]
@@ -1101,8 +1079,7 @@ lemma vgicMaintenance_invs'[wp]:
             apply (clarsimp cong: imp_cong conj_cong simp: pred_conj_def)
             apply (rule_tac Q="\<lambda>_ s. tcb_at' (ksCurThread s) s
                                       \<and> invs' s
-                                      \<and> sch_act_not (ksCurThread s) s
-                                      \<and> (\<forall>d p. (ksCurThread s) \<notin> set (ksReadyQueues s (d, p)))"
+                                      \<and> sch_act_not (ksCurThread s) s"
                     in hoare_post_imp)
              apply (clarsimp cong: imp_cong conj_cong simp: not_pred_tcb')
              apply (clarsimp simp: st_tcb_at'_def obj_at'_def runnable'_eq)
@@ -1126,7 +1103,7 @@ lemma vgicMaintenance_invs'[wp]:
   done
 
 lemma vppiEvent_invs'[wp]:
-  "\<lbrace>invs' and (\<lambda>s. sch_act_not (ksCurThread s) s \<and> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)))\<rbrace>
+  "\<lbrace>invs' and (\<lambda>s. sch_act_not (ksCurThread s) s)\<rbrace>
     vppiEvent irq \<lbrace>\<lambda>y. invs'\<rbrace>"
   supply if_split[split del]
   apply (clarsimp simp: vppiEvent_def doMachineOp_bind)
@@ -1136,8 +1113,7 @@ lemma vppiEvent_invs'[wp]:
             apply (clarsimp cong: imp_cong conj_cong simp: pred_conj_def)
             apply (rule_tac Q="\<lambda>_ s. tcb_at' (ksCurThread s) s
                                       \<and> invs' s
-                                      \<and> sch_act_not (ksCurThread s) s
-                                      \<and> (\<forall>d p. (ksCurThread s) \<notin> set (ksReadyQueues s (d, p)))"
+                                      \<and> sch_act_not (ksCurThread s) s"
                     in hoare_post_imp)
              apply (clarsimp cong: imp_cong conj_cong simp: not_pred_tcb')
              apply (clarsimp simp: st_tcb_at'_def obj_at'_def runnable'_eq)
@@ -1152,8 +1128,7 @@ lemma vppiEvent_invs'[wp]:
   done
 
 lemma hint_invs[wp]:
-  "\<lbrace>invs' and (\<lambda>s. irq \<in> non_kernel_IRQs \<longrightarrow>
-              sch_act_not (ksCurThread s) s \<and> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)))\<rbrace>
+  "\<lbrace>invs' and (\<lambda>s. irq \<in> non_kernel_IRQs \<longrightarrow> sch_act_not (ksCurThread s) s)\<rbrace>
     handleInterrupt irq \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (simp add: handleInterrupt_def getSlotCap_def cong: irqstate.case_cong)
   apply (rule conjI; rule impI)
diff --git a/proof/refine/AARCH64/InvariantUpdates_H.thy b/proof/refine/AARCH64/InvariantUpdates_H.thy
index 95253db5ad..899ed9627d 100644
--- a/proof/refine/AARCH64/InvariantUpdates_H.thy
+++ b/proof/refine/AARCH64/InvariantUpdates_H.thy
@@ -38,8 +38,9 @@ lemma invs'_machine:
 proof -
   show ?thesis
     apply (cases "ksSchedulerAction s")
-    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_queues_def valid_queues_no_bitmap_def bitmapQ_defs
+    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
@@ -56,12 +57,13 @@ lemma invs_no_cicd'_machine:
 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_queues_def valid_queues_no_bitmap_def bitmapQ_defs
-                    vms ct_not_inQ_def
-                    state_refs_of'_def ps_clear_def
-                    valid_irq_node'_def mask
-              cong: option.case_cong)
+    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)
     done
 qed
 
@@ -103,14 +105,9 @@ 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_queues_ksSchedulerAction_update[simp]:
-  "valid_queues (ksSchedulerAction_update f s) = valid_queues s"
- unfolding valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs
- by simp
-
-lemma valid_queues'_ksSchedulerAction_update[simp]:
-  "valid_queues' (ksSchedulerAction_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_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'"
@@ -145,45 +142,25 @@ lemma tcb_in_cur_domain_ct[simp]:
   "tcb_in_cur_domain' t  (ksCurThread_update f s) = tcb_in_cur_domain' t s"
   by (fastforce simp: tcb_in_cur_domain'_def)
 
-lemma valid_queues'_ksCurDomain[simp]:
-  "valid_queues' (ksCurDomain_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
-
-lemma valid_queues'_ksDomScheduleIdx[simp]:
-  "valid_queues' (ksDomScheduleIdx_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
+lemma valid_bitmaps_ksCurDomain[simp]:
+  "valid_bitmaps (ksCurDomain_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
 
-lemma valid_queues'_ksDomSchedule[simp]:
-  "valid_queues' (ksDomSchedule_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
+lemma valid_bitmaps_ksDomScheduleIdx[simp]:
+  "valid_bitmaps (ksDomScheduleIdx_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
 
-lemma valid_queues'_ksDomainTime[simp]:
-  "valid_queues' (ksDomainTime_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
+lemma valid_bitmaps_ksDomSchedule[simp]:
+   "valid_bitmaps (ksDomSchedule_update f s) = valid_bitmaps s"
+   by (simp add: valid_bitmaps_def bitmapQ_defs)
 
-lemma valid_queues'_ksWorkUnitsCompleted[simp]:
-  "valid_queues' (ksWorkUnitsCompleted_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
+lemma valid_bitmaps_ksDomainTime[simp]:
+  "valid_bitmaps (ksDomainTime_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
 
-lemma valid_queues_ksCurDomain[simp]:
-  "valid_queues (ksCurDomain_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
-
-lemma valid_queues_ksDomScheduleIdx[simp]:
-  "valid_queues (ksDomScheduleIdx_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
-
-lemma valid_queues_ksDomSchedule[simp]:
-  "valid_queues (ksDomSchedule_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
-
-lemma valid_queues_ksDomainTime[simp]:
-  "valid_queues (ksDomainTime_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
-
-lemma valid_queues_ksWorkUnitsCompleted[simp]:
-  "valid_queues (ksWorkUnitsCompleted_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
+lemma valid_bitmaps_ksWorkUnitsCompleted[simp]:
+  "valid_bitmaps (ksWorkUnitsCompleted_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
 
 lemma valid_irq_node'_ksCurDomain[simp]:
   "valid_irq_node' w (ksCurDomain_update f s) = valid_irq_node' w s"
@@ -260,6 +237,10 @@ lemma valid_mdb_interrupts'[simp]:
   "valid_mdb' (ksInterruptState_update f s) = valid_mdb' s"
   by (simp add: valid_mdb'_def)
 
+lemma valid_mdb'_ksReadyQueues_update[simp]:
+  "valid_mdb' (ksReadyQueues_update f s) = valid_mdb' s"
+  by (simp add: valid_mdb'_def)
+
 lemma vms_ksReadyQueues_update[simp]:
   "valid_machine_state' (ksReadyQueues_update f s) = valid_machine_state' s"
   by (simp add: valid_machine_state'_def)
@@ -284,10 +265,10 @@ lemma ct_in_state_ksSched[simp]:
 
 lemma invs'_wu [simp]:
   "invs' (ksWorkUnitsCompleted_update f s) = invs' s"
-  apply (simp add: invs'_def cur_tcb'_def valid_state'_def Invariants_H.valid_queues_def
-                   valid_queues'_def valid_irq_node'_def valid_machine_state'_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 valid_queues_no_bitmap_def)
+                   bitmapQ_defs)
   done
 
 lemma valid_arch_state'_interrupt[simp]:
@@ -339,9 +320,8 @@ lemma sch_act_simple_ksReadyQueuesL2Bitmap[simp]:
 
 lemma ksDomainTime_invs[simp]:
   "invs' (ksDomainTime_update f s) = invs' s"
-  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)
+  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"
@@ -369,10 +349,8 @@ 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 valid_state'_def valid_queues_def valid_queues'_def
-                      valid_irq_node'_def cur_tcb'_def ct_idle_or_in_cur_domain'_def
-                      tcb_in_cur_domain'_def valid_queues_no_bitmap_def
-                      bitmapQ_no_L2_orphans_def bitmapQ_no_L1_orphans_def)
+   by (clarsimp simp: invs'_def valid_state'_def valid_queues_def valid_irq_node'_def cur_tcb'_def
+                      ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def bitmapQ_defs)
 
 
 context begin interpretation Arch .
diff --git a/proof/refine/AARCH64/Invariants_H.thy b/proof/refine/AARCH64/Invariants_H.thy
index d925849ad3..f03c85e5f1 100644
--- a/proof/refine/AARCH64/Invariants_H.thy
+++ b/proof/refine/AARCH64/Invariants_H.thy
@@ -9,6 +9,7 @@ theory Invariants_H
 imports
   LevityCatch
   "AInvs.ArchDetSchedSchedule_AI"
+  "Lib.Heap_List"
 begin
 
 (* global data and code of the kernel, not covered by any cap *)
@@ -141,6 +142,21 @@ definition cte_wp_at' :: "(cte \<Rightarrow> bool) \<Rightarrow> obj_ref \<Right
 abbreviation cte_at' :: "obj_ref \<Rightarrow> kernel_state \<Rightarrow> bool" where
   "cte_at' \<equiv> cte_wp_at' \<top>"
 
+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 tcbSchedPrevs_of :: "kernel_state \<Rightarrow> obj_ref \<Rightarrow> obj_ref option" where
+   "tcbSchedPrevs_of s \<equiv> tcbs_of' s |> tcbSchedPrev"
+
+abbreviation tcbSchedNexts_of :: "kernel_state \<Rightarrow> obj_ref \<Rightarrow> obj_ref option" where
+  "tcbSchedNexts_of s \<equiv> tcbs_of' s |> tcbSchedNext"
+
+abbreviation sym_heap_sched_pointers :: "global.kernel_state \<Rightarrow> bool" where
+  "sym_heap_sched_pointers s \<equiv> sym_heap (tcbSchedNexts_of s) (tcbSchedPrevs_of s)"
+
 definition tcb_cte_cases :: "machine_word \<rightharpoonup> ((tcb \<Rightarrow> cte) \<times> ((cte \<Rightarrow> cte) \<Rightarrow> tcb \<Rightarrow> tcb))" where
  "tcb_cte_cases \<equiv> [ 0 << cteSizeBits \<mapsto> (tcbCTable, tcbCTable_update),
                     1 << cteSizeBits \<mapsto> (tcbVTable, tcbVTable_update),
@@ -193,8 +209,10 @@ definition state_refs_of' :: "kernel_state \<Rightarrow> obj_ref \<Rightarrow> (
 (* the non-hyp, non-arch part of live' *)
 primrec live0' :: "Structures_H.kernel_object \<Rightarrow> bool" where
   "live0' (KOTCB tcb) =
-     (bound (tcbBoundNotification 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))"
 | "live0' (KOCTE cte)           = False"
 | "live0' (KOEndpoint ep)       = (ep \<noteq> IdleEP)"
 | "live0' (KONotification ntfn) = (bound (ntfnBoundTCB ntfn) \<or> (\<exists>ts. ntfnObj ntfn = WaitingNtfn ts))"
@@ -252,14 +270,14 @@ definition hyp_live' :: "kernel_object \<Rightarrow> bool" where
 
 definition live' :: "kernel_object \<Rightarrow> bool" where
  "live' ko \<equiv> case ko of
-    (KOTCB tcb)           => live0' ko \<or> hyp_live' ko
-  | (KOCTE cte)           => False
-  | (KOEndpoint ep)       => live0' ko
-  | (KONotification ntfn) => live0' ko
-  | (KOUserData)          => False
-  | (KOUserDataDevice)    => False
-  | (KOKernelData)        => False
-  | (KOArch ako)          => hyp_live' ko"
+    KOTCB tcb           => live0' ko \<or> hyp_live' ko
+  | KOCTE cte           => False
+  | KOEndpoint ep       => live0' ko
+  | KONotification ntfn => live0' ko
+  | KOUserData          => False
+  | KOUserDataDevice    => False
+  | KOKernelData        => False
+  | KOArch ako          => hyp_live' ko"
 
 context begin interpretation Arch . (*FIXME: arch_split*)
 
@@ -483,6 +501,11 @@ definition is_device_frame_cap' :: "capability \<Rightarrow> bool" where
 definition   valid_arch_tcb' :: "Structures_H.arch_tcb \<Rightarrow> kernel_state \<Rightarrow> bool" where
   "valid_arch_tcb' \<equiv> \<lambda>t s. \<forall>v. atcbVCPUPtr t = Some v \<longrightarrow> vcpu_at' v s "
 
+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
   "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
@@ -491,6 +514,8 @@ definition valid_tcb' :: "tcb \<Rightarrow> kernel_state \<Rightarrow> bool" whe
                   \<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
                   \<and> valid_arch_tcb' (tcbArch t) s"
 
 definition valid_ep' :: "Structures_H.endpoint \<Rightarrow> kernel_state \<Rightarrow> bool" where
@@ -499,7 +524,6 @@ definition valid_ep' :: "Structures_H.endpoint \<Rightarrow> kernel_state \<Righ
    | SendEP ts \<Rightarrow> (ts \<noteq> [] \<and> (\<forall>t \<in> set ts. tcb_at' t s) \<and> distinct ts)
    | RecvEP ts \<Rightarrow> (ts \<noteq> [] \<and> (\<forall>t \<in> set ts. tcb_at' t s) \<and> distinct ts)"
 
-
 definition valid_bound_tcb' :: "machine_word 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"
 
@@ -838,10 +862,15 @@ where
 | "runnable' (Structures_H.BlockedOnSend a b c d e) = False"
 | "runnable' (Structures_H.BlockedOnNotification x) = False"
 
-definition
-  inQ :: "domain \<Rightarrow> priority \<Rightarrow> tcb \<Rightarrow> bool"
-where
- "inQ d p tcb \<equiv> tcbQueued tcb \<and> tcbPriority tcb = p \<and> tcbDomain tcb = d"
+definition inQ :: "domain \<Rightarrow> priority \<Rightarrow> tcb \<Rightarrow> bool" where
+  "inQ d p tcb \<equiv> tcbQueued tcb \<and> tcbPriority tcb = p \<and> tcbDomain tcb = d"
+
+lemma inQ_implies_tcbQueueds_of:
+  "(inQ domain priority |< tcbs_of' s') tcbPtr \<Longrightarrow> (tcbQueued |< tcbs_of' s') tcbPtr"
+  by (clarsimp simp: opt_map_def opt_pred_def inQ_def split: option.splits)
+
+defs ready_qs_runnable_def:
+  "ready_qs_runnable s \<equiv> \<forall>t. obj_at' tcbQueued t s \<longrightarrow> st_tcb_at' runnable' t s"
 
 definition
   (* for given domain and priority, the scheduler bitmap indicates a thread is in the queue *)
@@ -851,15 +880,6 @@ where
   "bitmapQ d p s \<equiv> ksReadyQueuesL1Bitmap s d !! prioToL1Index p
                      \<and> ksReadyQueuesL2Bitmap s (d, invertL1Index (prioToL1Index p))
                          !! unat (p && mask wordRadix)"
-
-definition
-  valid_queues_no_bitmap :: "kernel_state \<Rightarrow> bool"
-where
- "valid_queues_no_bitmap \<equiv> \<lambda>s.
-   (\<forall>d p. (\<forall>t \<in> set (ksReadyQueues s (d, p)). obj_at' (inQ d p and runnable' \<circ> tcbState) t s)
-    \<and>  distinct (ksReadyQueues s (d, p))
-    \<and> (d > maxDomain \<or> p > maxPriority \<longrightarrow> ksReadyQueues s (d,p) = []))"
-
 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
@@ -883,31 +903,62 @@ where
     \<forall>d i. ksReadyQueuesL1Bitmap s d !! i \<longrightarrow> ksReadyQueuesL2Bitmap s (d, invertL1Index i) \<noteq> 0 \<and>
                                              i < l2BitmapSize"
 
-definition
-  valid_bitmapQ :: "kernel_state \<Rightarrow> bool"
-where
-  "valid_bitmapQ \<equiv> \<lambda>s. (\<forall>d p. bitmapQ d p s \<longleftrightarrow> ksReadyQueues s (d,p) \<noteq> [])"
+definition valid_bitmapQ :: "kernel_state \<Rightarrow> bool" where
+  "valid_bitmapQ \<equiv> \<lambda>s. \<forall>d p. bitmapQ d p s \<longleftrightarrow> \<not> tcbQueueEmpty (ksReadyQueues s (d,p))"
 
-definition
-  valid_queues :: "kernel_state \<Rightarrow> bool"
-where
- "valid_queues \<equiv> \<lambda>s. valid_queues_no_bitmap s \<and> valid_bitmapQ s \<and>
-                     bitmapQ_no_L2_orphans s \<and> bitmapQ_no_L1_orphans s"
+definition valid_bitmaps :: "kernel_state \<Rightarrow> bool" where
+  "valid_bitmaps \<equiv> \<lambda>s. valid_bitmapQ s \<and> bitmapQ_no_L2_orphans s \<and> bitmapQ_no_L1_orphans s"
 
-definition
-  (* when a thread gets added to / removed from a queue, but before bitmap updated *)
-  valid_bitmapQ_except :: "domain \<Rightarrow> priority \<Rightarrow> kernel_state \<Rightarrow> bool"
-where
+lemma valid_bitmaps_valid_bitmapQ[elim!]:
+  "valid_bitmaps s \<Longrightarrow> valid_bitmapQ s"
+  by (simp add: valid_bitmaps_def)
+
+lemma valid_bitmaps_bitmapQ_no_L2_orphans[elim!]:
+  "valid_bitmaps s \<Longrightarrow> bitmapQ_no_L2_orphans s"
+  by (simp add: valid_bitmaps_def)
+
+lemma valid_bitmaps_bitmapQ_no_L1_orphans[elim!]:
+  "valid_bitmaps s \<Longrightarrow> bitmapQ_no_L1_orphans s"
+  by (simp add: valid_bitmaps_def)
+
+lemma valid_bitmaps_lift:
+  assumes prq: "\<And>P. f \<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace>"
+  assumes prqL1: "\<And>P. f \<lbrace>\<lambda>s. P (ksReadyQueuesL1Bitmap s)\<rbrace>"
+  assumes prqL2: "\<And>P. f \<lbrace>\<lambda>s. P (ksReadyQueuesL2Bitmap s)\<rbrace>"
+  shows "f \<lbrace>valid_bitmaps\<rbrace>"
+  unfolding valid_bitmaps_def valid_bitmapQ_def bitmapQ_def
+            bitmapQ_no_L1_orphans_def bitmapQ_no_L2_orphans_def
+  apply (rule hoare_pre)
+   apply (wps assms | wpsimp)+
+  done
+
+(* when a thread gets added to / removed from a queue, but before bitmap updated *)
+definition valid_bitmapQ_except :: "domain \<Rightarrow> priority \<Rightarrow> kernel_state \<Rightarrow> bool" where
   "valid_bitmapQ_except d' p' \<equiv> \<lambda>s.
-    (\<forall>d p. (d \<noteq> d' \<or> p \<noteq> p') \<longrightarrow> (bitmapQ d p s \<longleftrightarrow> ksReadyQueues s (d,p) \<noteq> []))"
+    \<forall>d p. (d \<noteq> d' \<or> p \<noteq> p') \<longrightarrow> (bitmapQ d p s \<longleftrightarrow> \<not> tcbQueueEmpty (ksReadyQueues s (d,p)))"
 
 lemmas bitmapQ_defs = valid_bitmapQ_def valid_bitmapQ_except_def bitmapQ_def
                        bitmapQ_no_L2_orphans_def bitmapQ_no_L1_orphans_def
 
-definition
-  valid_queues' :: "kernel_state \<Rightarrow> bool"
-where
- "valid_queues' \<equiv> \<lambda>s. \<forall>d p t. obj_at' (inQ d p) t s \<longrightarrow> t \<in> set (ksReadyQueues s (d, p))"
+\<comment> \<open>
+  The tcbSchedPrev and tcbSchedNext fields of a TCB are used only to indicate membership in
+  one of the ready queues. \<close>
+definition valid_sched_pointers_2 ::
+  "(obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> (obj_ref \<Rightarrow> bool) \<Rightarrow> bool "
+  where
+  "valid_sched_pointers_2 prevs nexts ready \<equiv>
+     \<forall>ptr. prevs ptr \<noteq> None \<or> nexts ptr \<noteq> None \<longrightarrow> ready ptr"
+
+abbreviation valid_sched_pointers :: "kernel_state \<Rightarrow> bool" where
+  "valid_sched_pointers s \<equiv>
+     valid_sched_pointers_2 (tcbSchedPrevs_of s) (tcbSchedNexts_of s) (tcbQueued |< tcbs_of' s)"
+
+lemmas valid_sched_pointers_def = valid_sched_pointers_2_def
+
+lemma valid_sched_pointersD:
+  "\<lbrakk>valid_sched_pointers s; \<not> (tcbQueued |< tcbs_of' s) t\<rbrakk>
+   \<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 tcb_in_cur_domain' :: "machine_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"
@@ -1058,7 +1109,7 @@ abbreviation
 
 definition valid_state' :: "kernel_state \<Rightarrow> bool" where
   "valid_state' \<equiv> \<lambda>s. valid_pspace' s \<and> sch_act_wf (ksSchedulerAction s) s
-                      \<and> valid_queues s \<and> sym_refs (state_refs_of' s) \<and> sym_refs (state_hyp_refs_of' s)
+                      \<and> sym_refs (state_refs_of' s) \<and> sym_refs (state_hyp_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
@@ -1067,7 +1118,9 @@ definition valid_state' :: "kernel_state \<Rightarrow> bool" where
                       \<and> valid_irq_states' s
                       \<and> valid_machine_state' s
                       \<and> irqs_masked' s
-                      \<and> valid_queues' 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> pspace_domain_valid s
@@ -1119,6 +1172,11 @@ definition
 abbreviation
   "active' st \<equiv> st = Structures_H.Running \<or> st = Structures_H.Restart"
 
+lemma runnable_eq_active': "runnable' = active'"
+  apply (rule ext)
+  apply (case_tac st, simp_all)
+  done
+
 abbreviation
   "simple' st \<equiv> st = Structures_H.Inactive \<or>
                 st = Structures_H.Running \<or>
@@ -1134,11 +1192,13 @@ abbreviation
 abbreviation(input)
  "all_invs_but_sym_refs_ct_not_inQ'
     \<equiv> \<lambda>s. valid_pspace' s \<and> sch_act_wf (ksSchedulerAction s) s
-           \<and> valid_queues s \<and> if_live_then_nonz_cap' s \<and> if_unsafe_then_cap' 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> cur_tcb' s \<and> valid_queues' s \<and> ct_idle_or_in_cur_domain' s
+           \<and> valid_irq_states' s \<and> irqs_masked' s
+           \<and> sym_heap_sched_pointers s \<and> valid_sched_pointers s \<and> valid_bitmaps s
+           \<and> valid_machine_state' s
+           \<and> cur_tcb' s \<and> ct_idle_or_in_cur_domain' s
            \<and> pspace_domain_valid s
            \<and> ksCurDomain s \<le> maxDomain
            \<and> valid_dom_schedule' s \<and> untyped_ranges_zero' s"
@@ -1146,12 +1206,14 @@ abbreviation(input)
 abbreviation(input)
  "all_invs_but_ct_not_inQ'
     \<equiv> \<lambda>s. valid_pspace' s \<and> sch_act_wf (ksSchedulerAction s) s
-           \<and> valid_queues s \<and> sym_refs (state_refs_of' s) \<and> sym_refs (state_hyp_refs_of' s)
+           \<and> sym_refs (state_refs_of' s) \<and> sym_refs (state_hyp_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> cur_tcb' s \<and> valid_queues' s \<and> ct_idle_or_in_cur_domain' s
+           \<and> valid_irq_states' s \<and> irqs_masked' s
+           \<and> sym_heap_sched_pointers s \<and> valid_sched_pointers s \<and> valid_bitmaps s
+           \<and> valid_machine_state' s
+           \<and> cur_tcb' s \<and> ct_idle_or_in_cur_domain' s
            \<and> pspace_domain_valid s
            \<and> ksCurDomain s \<le> maxDomain
            \<and> valid_dom_schedule' s \<and> untyped_ranges_zero' s"
@@ -1167,12 +1229,14 @@ lemma all_invs_but_not_ct_inQ_check':
 definition
   "all_invs_but_ct_idle_or_in_cur_domain'
     \<equiv> \<lambda>s. valid_pspace' s \<and> sch_act_wf (ksSchedulerAction s) s
-           \<and> valid_queues s \<and> sym_refs (state_refs_of' s) \<and> sym_refs (state_hyp_refs_of' s)
+           \<and> sym_refs (state_refs_of' s) \<and> sym_refs (state_hyp_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> cur_tcb' s \<and> valid_queues' s \<and> ct_not_inQ s
+           \<and> valid_irq_states' s \<and> irqs_masked' s
+           \<and> sym_heap_sched_pointers s \<and> valid_sched_pointers s \<and> valid_bitmaps s
+           \<and> valid_machine_state' s
+           \<and> cur_tcb' s \<and> ct_not_inQ s
            \<and> pspace_domain_valid s
            \<and> ksCurDomain s \<le> maxDomain
            \<and> valid_dom_schedule' s \<and> untyped_ranges_zero' s"
@@ -2983,9 +3047,9 @@ lemma sch_act_wf_arch [simp]:
   "sch_act_wf sa (ksArchState_update f s) = sch_act_wf sa s"
   by (cases sa) (simp_all add: ct_in_state'_def  tcb_in_cur_domain'_def)
 
-lemma valid_queues_arch [simp]:
-  "valid_queues (ksArchState_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
+lemma valid_bitmaps_arch[simp]:
+  "valid_bitmaps (ksArchState_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
 
 lemma if_unsafe_then_cap_arch' [simp]:
   "if_unsafe_then_cap' (ksArchState_update f s) = if_unsafe_then_cap' s"
@@ -3003,22 +3067,14 @@ lemma sch_act_wf_machine_state [simp]:
   "sch_act_wf sa (ksMachineState_update f s) = sch_act_wf sa s"
   by (cases sa) (simp_all add: ct_in_state'_def  tcb_in_cur_domain'_def)
 
-lemma valid_queues_machine_state [simp]:
-  "valid_queues (ksMachineState_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
-
-lemma valid_queues_arch' [simp]:
-  "valid_queues' (ksArchState_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
-
-lemma valid_queues_machine_state' [simp]:
-  "valid_queues' (ksMachineState_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
-
 lemma valid_irq_node'_machine_state [simp]:
   "valid_irq_node' x (ksMachineState_update f s) = valid_irq_node' x s"
   by (simp add: valid_irq_node'_def)
 
+lemma valid_bitmaps_machine_state[simp]:
+  "valid_bitmaps (ksMachineState_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
+
 (* these should be reasonable safe for automation because of the 0 pattern *)
 lemma no_0_ko_wp' [elim!]:
   "\<lbrakk> ko_wp_at' Q 0 s; no_0_obj' s \<rbrakk> \<Longrightarrow> P"
@@ -3101,19 +3157,6 @@ lemma typ_at_aligned':
   "\<lbrakk> typ_at' tp p s \<rbrakk> \<Longrightarrow> is_aligned p (objBitsT tp)"
   by (clarsimp simp add: typ_at'_def ko_wp_at'_def objBitsT_koTypeOf)
 
-lemma valid_queues_obj_at'D:
-   "\<lbrakk> t \<in> set (ksReadyQueues s (d, p)); valid_queues s \<rbrakk>
-        \<Longrightarrow> obj_at' (inQ d p) t s"
-  apply (unfold valid_queues_def valid_queues_no_bitmap_def)
-  apply (elim conjE)
-  apply (drule_tac x=d in spec)
-  apply (drule_tac x=p in spec)
-  apply (clarsimp)
-  apply (drule(1) bspec)
-  apply (erule obj_at'_weakenE)
-  apply (clarsimp)
-  done
-
 lemma obj_at'_and:
   "obj_at' (P and P') t s = (obj_at' P t s \<and> obj_at' P' t s)"
   by (rule iffI, (clarsimp simp: obj_at'_def)+)
@@ -3155,21 +3198,6 @@ lemma obj_at'_ko_at'_prop:
   "ko_at' ko t s \<Longrightarrow> obj_at' P t s = P ko"
   by (drule obj_at_ko_at', clarsimp simp: obj_at'_def)
 
-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> st_tcb_at' runnable' t s) \<and>
-                  distinct (ksReadyQueues s (d, p)) \<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_queues_running:
-  assumes Q: "t \<in> set(ksReadyQueues s (d, p))" "valid_queues s"
-  shows "st_tcb_at' runnable' t s"
-  using assms by (clarsimp simp add: valid_queues_def valid_queues_no_bitmap_def')
-
 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)
@@ -3254,8 +3282,16 @@ 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_queues [elim!]:
-  "invs' s \<Longrightarrow> valid_queues s"
+lemma invs_valid_bitmaps[elim!]:
+  "invs' s \<Longrightarrow> valid_bitmaps s"
+  by (simp add: invs'_def valid_state'_def)
+
+lemma invs_sym_heap_sched_pointers[elim!]:
+  "invs' s \<Longrightarrow> sym_heap_sched_pointers s"
+  by (simp add: invs'_def valid_state'_def)
+
+lemma invs_valid_sched_pointers[elim!]:
+  "invs' s \<Longrightarrow> valid_sched_pointers s"
   by (simp add: invs'_def valid_state'_def)
 
 lemma invs_valid_idle'[elim!]:
@@ -3278,18 +3314,12 @@ 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_valid_queues'_strg:
-  "invs' s \<longrightarrow> valid_queues' s"
-  by (clarsimp simp: invs'_def valid_state'_def)
-
-lemmas invs_valid_queues'[elim!] = invs_valid_queues'_strg[rule_format]
-
 lemma einvs_valid_etcbs: "einvs s \<longrightarrow> valid_etcbs s"
   by (clarsimp simp: valid_sched_def)
 
 lemma invs'_bitmapQ_no_L1_orphans:
   "invs' s \<Longrightarrow> bitmapQ_no_L1_orphans s"
-  by (drule invs_queues, simp add: valid_queues_def)
+  by (simp add: invs'_def valid_state'_def valid_bitmaps_def)
 
 lemma invs_ksCurDomain_maxDomain' [elim!]:
   "invs' s \<Longrightarrow> ksCurDomain s \<le> maxDomain"
@@ -3314,32 +3344,22 @@ lemma invs_no_0_obj'[elim!]:
 
 lemma invs'_gsCNodes_update[simp]:
   "invs' (gsCNodes_update f s') = invs' s'"
-  apply (clarsimp simp: invs'_def valid_state'_def valid_queues_def valid_queues_no_bitmap_def
-             bitmapQ_defs
-             valid_queues'_def 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'")
-  apply (simp_all add: ct_in_state'_def tcb_in_cur_domain'_def ct_idle_or_in_cur_domain'_def ct_not_inQ_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_state'_def valid_queues_def valid_queues_no_bitmap_def
-             bitmapQ_defs
-             valid_queues'_def 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'")
-  apply (simp_all add: ct_in_state'_def ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def ct_not_inQ_def)
-  done
-
-lemma invs_queues_tcb_in_cur_domain':
-  "\<lbrakk> ksReadyQueues s (d, p) = x # xs; invs' s; d = ksCurDomain s\<rbrakk>
-     \<Longrightarrow> tcb_in_cur_domain' x s"
-  apply (subgoal_tac "x \<in> set (ksReadyQueues s (d, p))")
-   apply (drule (1) valid_queues_obj_at'D[OF _ invs_queues])
-   apply (auto simp: inQ_def tcb_in_cur_domain'_def elim: obj_at'_weakenE)
+  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:
@@ -3355,7 +3375,7 @@ lemma invs'_ksDomScheduleIdx:
 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> ksReadyQueues s (d,p) \<noteq> []) ;
+  "\<lbrakk> valid_bitmapQ_except d p s; bitmapQ d p s \<longleftrightarrow> \<not> tcbQueueEmpty (ksReadyQueues s (d,p));
      bitmapQ_no_L2_orphans s \<rbrakk>
    \<Longrightarrow> valid_bitmapQ s"
   unfolding valid_bitmapQ_def valid_bitmapQ_except_def
diff --git a/proof/refine/AARCH64/IpcCancel_R.thy b/proof/refine/AARCH64/IpcCancel_R.thy
index b9330594ed..d5d792d5fc 100644
--- a/proof/refine/AARCH64/IpcCancel_R.thy
+++ b/proof/refine/AARCH64/IpcCancel_R.thy
@@ -39,25 +39,6 @@ lemma cancelSignal_pred_tcb_at':
 crunch pred_tcb_at'[wp]: emptySlot "pred_tcb_at' proj P t"
   (wp: setCTE_pred_tcb_at')
 
-(* valid_queues is too strong *)
-definition valid_inQ_queues :: "KernelStateData_H.kernel_state \<Rightarrow> bool" where
-  "valid_inQ_queues \<equiv>
-     \<lambda>s. \<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s) \<and> distinct (ksReadyQueues s (d, p))"
-
-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_inQ_queues_ksReadyQueuesL1Bitmap_upd[simp]:
-  "valid_inQ_queues (ksReadyQueuesL1Bitmap_update f s) = valid_inQ_queues s"
-  unfolding valid_inQ_queues_def
-  by simp
-
-lemma valid_inQ_queues_ksReadyQueuesL2Bitmap_upd[simp]:
-  "valid_inQ_queues (ksReadyQueuesL2Bitmap_update f s) = valid_inQ_queues s"
-  unfolding valid_inQ_queues_def
-  by simp
-
 defs capHasProperty_def:
   "capHasProperty ptr P \<equiv> cte_wp_at' (\<lambda>c. P (cteCap c)) ptr"
 
@@ -76,11 +57,6 @@ locale delete_one_conc_pre =
     "\<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_queues:
-    "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)\<rbrace>
-     cteDeleteOne sl \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  assumes delete_one_inQ_queues:
-    "\<lbrace>valid_inQ_queues\<rbrace> cteDeleteOne sl \<lbrace>\<lambda>rv. valid_inQ_queues\<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:
@@ -538,7 +514,7 @@ lemma (in delete_one) cancelIPC_ReplyCap_corres:
               and Q'="\<lambda>_. invs' and st_tcb_at' awaiting_reply' t"
                in corres_underlying_split)
      apply (rule corres_guard_imp)
-       apply (rule threadset_corresT)
+       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 cteSizeBits_def)
@@ -662,16 +638,15 @@ lemma sch_act_simple_not_t[simp]: "sch_act_simple s \<Longrightarrow> sch_act_no
 
 context begin interpretation Arch . (*FIXME: arch_split*)
 
+crunches setNotification
+  for sym_heap_sched_pointers[wp]: sym_heap_sched_pointers
+  and valid_bitmaps[wp]: valid_bitmaps
+  (wp: valid_bitmaps_lift)
+
 lemma cancelSignal_invs':
   "\<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> Invariants_H.valid_queues s; st_tcb_at' (Not \<circ> runnable') t s \<rbrakk>
-                                         \<Longrightarrow> \<forall>x. t \<notin> set (ksReadyQueues s x)"
-      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>"
@@ -682,9 +657,9 @@ lemma cancelSignal_invs':
     show ?thesis
       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 setNotification_ksQ] sts_valid_queues
+                hoare_vcg_all_lift
                 setThreadState_ct_not_inQ NTFNSN
-                hoare_vcg_all_lift setNotification_ksQ
+                hoare_vcg_all_lift
               | simp add: valid_tcb_state'_def list_case_If split del: if_split)+
        prefer 2
        apply assumption
@@ -692,8 +667,6 @@ lemma cancelSignal_invs':
        apply (rule get_ntfn_sp')
       apply (rename_tac rv s)
       apply (clarsimp simp: pred_tcb_at')
-      apply (frule NIQ)
-       apply (clarsimp simp: pred_tcb_at'_def obj_at'_def)
       apply (rule conjI)
        apply (clarsimp simp: valid_ntfn'_def)
        apply (case_tac "ntfnObj rv", simp_all add: isWaitingNtfn_def)
@@ -733,6 +706,7 @@ lemma cancelSignal_invs':
                                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")
@@ -790,23 +764,25 @@ lemma setEndpoint_ct_not_inQ[wp]:
   done
 
 lemma setEndpoint_ksDomScheduleIdx[wp]:
-  "\<lbrace>\<lambda>s. P (ksDomScheduleIdx s)\<rbrace> setEndpoint ptr ep \<lbrace>\<lambda>_ s. P (ksDomScheduleIdx s)\<rbrace>"
+  "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
 
+crunches 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 NIQ: "\<And>s. \<lbrakk> Invariants_H.valid_queues s; st_tcb_at' (Not \<circ> runnable') t s \<rbrakk>
-                                       \<Longrightarrow> \<forall>x. t \<notin> set (ksReadyQueues s x)"
-    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 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>"
@@ -830,21 +806,20 @@ proof -
     apply (subst P)
     apply (wp valid_irq_node_lift valid_global_refs_lift'
               irqs_masked_lift sts_sch_act'
-              hoare_vcg_all_lift [OF setEndpoint_ksQ]
-              sts_valid_queues setThreadState_ct_not_inQ EPSCHN
-              hoare_vcg_all_lift setNotification_ksQ getEndpoint_wp
+              setThreadState_ct_not_inQ EPSCHN
+              hoare_vcg_all_lift getEndpoint_wp
               | simp add: valid_tcb_state'_def split del: if_split
               | wpc)+
     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: valid_obj'_def)
     apply (rule conjI)
      apply (clarsimp simp: obj_at'_def valid_ep'_def
                     dest!: pred_tcb_at')
-    apply (frule NIQ)
-     apply (erule pred_tcb'_weakenE, fastforce)
     apply (clarsimp, rule conjI)
      apply (auto simp: pred_tcb_at'_def obj_at'_def)[1]
     apply (rule conjI)
@@ -1049,18 +1024,20 @@ lemma setBoundNotification_tcb_in_cur_domain'[wp]:
   apply (wp 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> \<lbrace>obj_at' P t'\<rbrace> cancelSignal t word \<lbrace>\<lambda>_. obj_at' P t'\<rbrace>"
-  apply (simp add: cancelSignal_def setNotification_def)
-  apply (wp setThreadState_not_st getNotification_wp | wpc | simp)+
-  done
+lemma setThreadState_tcbDomain_obj_at'[wp]:
+  "setThreadState ts t \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  unfolding setThreadState_def
+  by wpsimp
+
+crunches 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 (simp add: cancelIPC_def Let_def)
   apply (wp hoare_vcg_conj_lift
-            setThreadState_not_st delete_one_tcbDomain_obj_at' cancelSignal_tcb_obj_at'
+            delete_one_tcbDomain_obj_at'
        | wpc
        | rule hoare_drop_imps
        | simp add: getThreadReplySlot_def o_def if_fun_split)+
@@ -1167,198 +1144,17 @@ lemma setNotification_weak_sch_act_wf[wp]:
 lemmas ipccancel_weak_sch_act_wfs
     = weak_sch_act_wf_lift[OF _ setCTE_pred_tcb_at']
 
-lemma tcbSchedDequeue_corres':
-  "corres dc (is_etcb_at t and tcb_at t and pspace_aligned and pspace_distinct)
-             (valid_inQ_queues)
-             (tcb_sched_action (tcb_sched_dequeue) t) (tcbSchedDequeue t)"
-  apply (rule corres_cross_over_guard[where P'=P' and Q="tcb_at' t and P'" for P'])
-   apply (fastforce simp: tcb_at_cross dest: state_relation_pspace_relation)
-  apply (simp only: tcbSchedDequeue_def tcb_sched_action_def)
-  apply (rule corres_symb_exec_r[OF _ _ threadGet_inv, where Q'="\<lambda>rv. tcb_at' t and valid_inQ_queues and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"])
-    defer
-    apply (wp threadGet_obj_at', simp, simp)
-   apply (wp, simp)
-  apply (case_tac queued)
-   defer
-   apply (simp add: unless_def when_def)
-   apply (rule corres_no_failI)
-    apply (wp)
-   apply (clarsimp simp: in_monad ethread_get_def get_etcb_def set_tcb_queue_def is_etcb_at_def state_relation_def gets_the_def gets_def get_def return_def bind_def assert_opt_def get_tcb_queue_def modify_def put_def)
-   apply (subgoal_tac "t \<notin> set (ready_queues a (tcb_domain y) (tcb_priority y))")
-    prefer 2
-    apply (force simp: tcb_sched_dequeue_def valid_inQ_queues_def
-                       ready_queues_relation_def obj_at'_def inQ_def project_inject)
-   apply (simp add: ready_queues_relation_def)
-  apply (simp add: unless_def when_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[where r'="(=)"])
-       apply (rule ethreadget_corres, simp add: etcb_relation_def)
-      apply (simp split del: if_split)
-      apply (rule corres_split_eqr)
-         apply (rule ethreadget_corres, simp add: etcb_relation_def)
-        apply (rule corres_split_eqr[OF getQueue_corres])
-          apply (simp split del: if_split)
-          apply (subst bind_return_unit, rule corres_split[where r'=dc])
-             apply (simp add: tcb_sched_dequeue_def)
-             apply (rule setQueue_corres)
-            apply (rule corres_split_noop_rhs)
-              apply (clarsimp, rule removeFromBitmap_corres_noop)
-             apply (simp add: dc_def[symmetric])
-             apply (rule threadSet_corres_noop, simp_all add: tcb_relation_def exst_same_def)[1]
-            apply (wp | simp)+
-  done
-
-lemma setQueue_valid_inQ_queues:
-  "\<lbrace>valid_inQ_queues
-      and (\<lambda>s. \<forall>t \<in> set ts. obj_at' (inQ d p) t s)
-      and K (distinct ts)\<rbrace>
-  setQueue d p ts
-  \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  apply (simp add: setQueue_def valid_inQ_queues_def)
-  apply wp
-  apply clarsimp
-  done
-
-lemma threadSet_valid_inQ_queues:
-  "\<lbrace>valid_inQ_queues and (\<lambda>s. \<forall>d p. (\<exists>tcb. (inQ d p tcb) \<and> \<not>(inQ d p (f tcb)))
-                        \<longrightarrow> obj_at' (\<lambda>tcb. (inQ d p tcb) \<and> \<not>(inQ d p (f tcb))) t s
-                        \<longrightarrow> t \<notin> set (ksReadyQueues s (d, p)))\<rbrace>
-     threadSet f t
-   \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (simp add: threadSet_def)
-  apply wp
-   apply (simp add: valid_inQ_queues_def pred_tcb_at'_def)
-   apply (wp setObject_queues_unchanged_tcb
-             hoare_Ball_helper
-             hoare_vcg_all_lift
-             setObject_tcb_strongest)[1]
-  apply (wp getObject_tcb_wp)
-  apply (clarsimp simp: valid_inQ_queues_def pred_tcb_at'_def)
-  apply (clarsimp simp: obj_at'_def)
-  apply (fastforce)
-  done
-
-(* reorder the threadSet before the setQueue, useful for lemmas that don't refer to bitmap *)
-lemma setQueue_after_addToBitmap:
-  "(setQueue d p q >>= (\<lambda>rv. (when P (addToBitmap d p)) >>= (\<lambda>rv. threadSet f t))) =
-   (when P (addToBitmap d p) >>= (\<lambda>rv. (threadSet f t) >>= (\<lambda>rv. setQueue d p q)))"
-  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 (simp add: threadSet_def getObject_def setObject_def
-                   loadObject_default_def bitmap_fun_defs
-                   split_def projectKO_def2 alignCheck_assert
-                   magnitudeCheck_assert updateObject_default_def)
-  apply (intro oblivious_bind, simp_all)
-  apply (clarsimp simp: bind_assoc)
-  done
-
-lemma tcbSchedEnqueue_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> tcbSchedEnqueue t \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def setQueue_after_addToBitmap)
-  apply (rule hoare_pre)
-   apply (rule_tac B="\<lambda>rv. valid_inQ_queues and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"
-                in hoare_seq_ext)
-    apply (rename_tac queued)
-    apply (case_tac queued, simp_all add: unless_def)[1]
-     apply (wp setQueue_valid_inQ_queues threadSet_valid_inQ_queues threadGet_wp
-               hoare_vcg_const_Ball_lift
-          | simp add: inQ_def bitmap_fun_defs
-          | fastforce simp: valid_inQ_queues_def inQ_def obj_at'_def)+
-  done
-
- (* prevents wp from splitting on the when; stronger technique than hoare_when_weak_wp
-    FIXME: possible to replace with hoare_when_weak_wp?
- *)
-definition
-  "removeFromBitmap_conceal d p q t \<equiv> when (null [x\<leftarrow>q . x \<noteq> t]) (removeFromBitmap d p)"
-
-lemma removeFromBitmap_conceal_valid_inQ_queues[wp]:
-  "\<lbrace> valid_inQ_queues \<rbrace> removeFromBitmap_conceal d p q t \<lbrace> \<lambda>_. valid_inQ_queues \<rbrace>"
-  unfolding valid_inQ_queues_def removeFromBitmap_conceal_def
-  by (wp|clarsimp simp: bitmap_fun_defs)+
-
-lemma rescheduleRequired_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> rescheduleRequired \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply wpsimp
-  done
-
-lemma sts_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> setThreadState st t \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (simp add: setThreadState_def)
-  apply (wp threadSet_valid_inQ_queues [THEN hoare_strengthen_post])
-   apply (clarsimp simp: sch_act_simple_def Invariants_H.valid_queues_def inQ_def)+
-  done
-
 lemma updateObject_ep_inv:
   "\<lbrace>P\<rbrace> updateObject (obj::endpoint) ko p q n \<lbrace>\<lambda>rv. P\<rbrace>"
   by simp (rule updateObject_default_inv)
 
-lemma sbn_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> setBoundNotification ntfn t \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (simp add: setBoundNotification_def)
-  apply (wp threadSet_valid_inQ_queues [THEN hoare_strengthen_post])
-   apply (clarsimp simp: sch_act_simple_def Invariants_H.valid_queues_def inQ_def)+
-  done
-
-lemma setEndpoint_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> setEndpoint ptr ep \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (unfold setEndpoint_def)
-  apply (rule setObject_ep_pre)
-  apply (simp add: valid_inQ_queues_def)
-  apply (wp hoare_Ball_helper hoare_vcg_all_lift setObject_queues_unchanged[OF updateObject_ep_inv])
-  apply simp
-  done
-
-lemma set_ntfn_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> setNotification ptr ntfn \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (unfold setNotification_def)
-  apply (rule setObject_ntfn_pre)
-  apply (simp add: valid_inQ_queues_def)
-  apply (wp hoare_Ball_helper hoare_vcg_all_lift)
-    apply (clarsimp simp: updateObject_default_def in_monad)
-    apply (wp updateObject_default_inv | simp)+
-    done
-
-crunch valid_inQ_queues[wp]: cancelSignal valid_inQ_queues
-  (simp: updateObject_tcb_inv crunch_simps wp: crunch_wps)
-
-lemma (in delete_one_conc_pre) cancelIPC_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> cancelIPC t \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  apply (simp add: cancelIPC_def Let_def getThreadReplySlot_def)
-  apply (wp hoare_drop_imps delete_one_inQ_queues threadSet_valid_inQ_queues | wpc | simp add:if_apply_def2 Fun.comp_def)+
-   apply (clarsimp simp: valid_inQ_queues_def inQ_def)+
-   done
-
-lemma valid_queues_inQ_queues:
-  "Invariants_H.valid_queues s \<Longrightarrow> valid_inQ_queues s"
-  by (force simp: Invariants_H.valid_queues_def valid_inQ_queues_def obj_at'_def
-                  valid_queues_no_bitmap_def)
-
 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>"
   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_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> asUser t f \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  unfolding valid_inQ_queues_def Ball_def
-  apply (wpsimp wp: hoare_vcg_all_lift)
-    defer
-    apply (wp asUser_ksQ)
-   apply assumption
-  apply (simp add: inQ_def[abs_def] obj_at'_conj)
-  apply (rule hoare_convert_imp)
-   apply (wp asUser_ksQ)
-  apply wp
-  done
-
-context begin
-interpretation Arch .
+context begin interpretation Arch .
 
 crunches cancel_ipc
   for pspace_aligned[wp]: "pspace_aligned :: det_state \<Rightarrow> _"
@@ -1367,6 +1163,30 @@ crunches cancel_ipc
 
 end
 
+crunches asUser
+  for valid_sched_pointers[wp]: valid_sched_pointers
+  (wp: crunch_wps)
+
+crunches set_thread_state
+  for in_correct_ready_q[wp]: in_correct_ready_q
+  (wp: crunch_wps)
+
+crunches set_thread_state_ext
+  for ready_qs_distinct[wp]: ready_qs_distinct
+  (wp: crunch_wps)
+
+lemma set_thread_state_ready_qs_distinct[wp]:
+  "set_thread_state ref ts \<lbrace>ready_qs_distinct\<rbrace>"
+  unfolding set_thread_state_def
+  apply (wpsimp wp: set_object_wp)
+  by (clarsimp simp: ready_qs_distinct_def)
+
+lemma as_user_ready_qs_distinct[wp]:
+  "as_user tptr f \<lbrace>ready_qs_distinct\<rbrace>"
+  unfolding as_user_def
+  apply (wpsimp wp: set_object_wp)
+  by (clarsimp simp: ready_qs_distinct_def)
+
 lemma (in delete_one) suspend_corres:
   "corres dc (einvs and tcb_at t) invs'
              (IpcCancel_A.suspend t) (ThreadDecls_H.suspend t)"
@@ -1390,15 +1210,18 @@ lemma (in delete_one) suspend_corres:
            apply (rule corres_return_trivial)
           apply (rule corres_split_nor[OF setThreadState_corres])
              apply wpsimp
-            apply (rule tcbSchedDequeue_corres')
+            apply (rule tcbSchedDequeue_corres, simp)
            apply wp
-          apply wpsimp
-         apply (wpsimp simp: update_restart_pc_def updateRestartPC_def)+
-       apply (rule hoare_post_imp[where Q = "\<lambda>rv s. tcb_at t s \<and> is_etcb_at t s \<and> pspace_aligned s \<and> pspace_distinct s"])
-        apply simp
-       apply (wp | simp)+
-   apply (fastforce simp: valid_sched_def tcb_at_is_etcb_at)
-  apply (clarsimp simp add: invs'_def valid_state'_def valid_queues_inQ_queues)
+          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
 
 context begin interpretation Arch .
@@ -1461,11 +1284,10 @@ proof -
     by (simp add: tcb_relation_def)
   show ?thesis
   unfolding arch_thread_set_def archThreadSet_def
-  apply (corres' \<open>rotate_tac, erule tcb_rel | rule ball_tcb_cte_casesI; simp\<close>
-                corres: getObject_TCB_corres setObject_update_TCB_corres'
-                wp: getObject_tcb_wp
-                simp: exst_same_def tcb_cap_cases_def tcb_ko_at')
-  done
+  by (corres' \<open>(rotate_tac, erule tcb_rel) |
+               (rule ball_tcb_cte_casesI; simp) |
+               simp add: exst_same_def tcb_cap_cases_def\<close>
+              corres: getObject_TCB_corres setObject_update_TCB_corres')
 qed
 
 lemma archThreadSet_VCPU_None_corres[corres]:
@@ -1573,261 +1395,8 @@ lemma (in delete_one_conc_pre) cancelIPC_it[wp]:
   apply (wp hoare_drop_imps delete_one_it | wpc | simp add:if_apply_def2 Fun.comp_def)+
   done
 
-lemma tcbSchedDequeue_notksQ:
-  "\<lbrace>\<lambda>s. t' \<notin> set(ksReadyQueues s p)\<rbrace>
-    tcbSchedDequeue t
-   \<lbrace>\<lambda>_ s. t' \<notin> set(ksReadyQueues s p)\<rbrace>"
-  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+
-     apply clarsimp
-     apply (rule_tac Q="\<lambda>_ s. t' \<notin> set(ksReadyQueues s p)" in hoare_post_imp)
-      apply (wp | clarsimp)+
-  done
-
-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 B="\<lambda>rv s. (rv = ResumeCurrentThread \<or> rv = ChooseNewThread)
-                       \<and> ?OAQ t' p s" in hoare_seq_ext)
-   including classic_wp_pre
-   apply (wp | clarsimp)+
-   apply (case_tac x)
-     apply (wp | clarsimp)+
-  done
-
-lemma setThreadState_oa_queued:
-  "\<lbrace>\<lambda>s. P' (obj_at' (\<lambda>tcb. P (tcbQueued tcb) (tcbDomain tcb) (tcbPriority tcb)) t' s) \<rbrace>
-    setThreadState st 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> setThreadState st t \<lbrace>\<lambda>_. ?Q R \<rbrace>"
-      apply (simp add: setThreadState_def)
-      apply (wp rescheduleRequired_oa_queued)
-      apply (simp add: sch_act_simple_def)
-      apply (rule_tac Q="\<lambda>_. ?Q R" in hoare_post_imp, clarsimp)
-      apply (wp threadSet_obj_at'_strongish)
-      apply (clarsimp)
-      done
-    show "\<lbrace>\<lambda>s. \<not> ?Q P s\<rbrace> setThreadState st t \<lbrace>\<lambda>_ s. \<not> ?Q P s\<rbrace>"
-      by (simp add: not_obj_at' comp_def, wp hoare_convert_imp pos)
-  qed
-
-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 tcbSchedDequeue_ksQ_distinct[wp]:
-  "\<lbrace>\<lambda>s. distinct (ksReadyQueues s p)\<rbrace>
-    tcbSchedDequeue t
-   \<lbrace>\<lambda>_ s. distinct (ksReadyQueues s p)\<rbrace>"
-  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+
-     apply (rule_tac Q="\<lambda>_ s. distinct (ksReadyQueues s p)" in hoare_post_imp)
-      apply (clarsimp | wp)+
-  done
-
-lemma sts_valid_queues_partial:
-  "\<lbrace>Invariants_H.valid_queues and sch_act_simple\<rbrace>
-    setThreadState st t
-   \<lbrace>\<lambda>_ s. \<forall>t' d p.
-            (t' \<in> set(ksReadyQueues s (d, p)) \<longrightarrow>
-             (obj_at' (\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d \<and> tcbPriority tcb = p) t' s
-              \<and> (t' \<noteq> t \<longrightarrow> st_tcb_at' runnable' t' s)))
-            \<and> distinct (ksReadyQueues s (d, p))\<rbrace>"
-  (is "\<lbrace>_\<rbrace> _ \<lbrace>\<lambda>_ s. \<forall>t' d p. ?OA t' d p s \<and> ?DISTINCT d p s \<rbrace>")
-  apply (rule_tac Q="\<lambda>_ s. (\<forall>t' d p. ?OA t' d p s) \<and> (\<forall>d p. ?DISTINCT d p s)"
-           in hoare_post_imp)
-   apply (clarsimp)
-  apply (rule hoare_conjI)
-   apply (rule_tac Q="\<lambda>s. \<forall>t' d p.
-             ((t'\<in>set(ksReadyQueues s (d, p))
-               \<or> \<not> (sch_act_simple s))
-                  \<longrightarrow> (obj_at'(\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d \<and> tcbPriority tcb = p) t' s
-                       \<and> st_tcb_at' runnable' t' s))" in hoare_pre_imp)
-    apply (fastforce simp: Invariants_H.valid_queues_def valid_queues_no_bitmap_def
-                           pred_tcb_at'_def obj_at'_def inQ_def)
-   apply (rule hoare_vcg_all_lift)+
-    apply (rule hoare_convert_imp)
-     including classic_wp_pre
-     apply (wp sts_ksQ setThreadState_oa_queued hoare_impI sts_pred_tcb_neq'
-            | clarsimp)+
-  apply (rule_tac Q="\<lambda>s. \<forall>d p. ?DISTINCT d p s \<and> sch_act_simple s" in hoare_pre_imp)
-   apply (clarsimp simp: Invariants_H.valid_queues_def valid_queues_no_bitmap_def)
-  apply (wp hoare_vcg_all_lift sts_ksQ)
-  apply (clarsimp)
-  done
-
-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 Q="(\<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)
-  done
-
-lemma sts_invs_minor'_no_valid_queues:
-  "\<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. runnable' st \<and> obj_at' tcbQueued t s \<longrightarrow> st_tcb_at' runnable' t s)
-      and sch_act_simple
-      and invs'\<rbrace>
-    setThreadState st t
-   \<lbrace>\<lambda>_ s. (\<forall>t' d p.
-            (t' \<in> set(ksReadyQueues s (d, p)) \<longrightarrow>
-             (obj_at' (\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d \<and> tcbPriority tcb = p) t' s
-              \<and> (t' \<noteq> t \<longrightarrow> st_tcb_at' runnable' t' s)))
-            \<and> distinct (ksReadyQueues s (d, p)) \<and> (maxDomain < d \<or> maxPriority < p \<longrightarrow> ksReadyQueues s (d, p) = [])) \<and>
-         valid_bitmapQ s \<and>
-         bitmapQ_no_L2_orphans s \<and>
-         bitmapQ_no_L1_orphans s \<and>
-         valid_pspace' s \<and>
-         sch_act_wf (ksSchedulerAction s) s \<and>
-         sym_refs (state_refs_of' s) \<and>
-         sym_refs (state_hyp_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>
-         valid_queues' s \<and>
-         ct_not_inQ s \<and>
-         ct_idle_or_in_cur_domain' s \<and>
-         pspace_domain_valid s \<and>
-         ksCurDomain s \<le> maxDomain \<and>
-         valid_dom_schedule' s \<and>
-         untyped_ranges_zero' s \<and>
-         cur_tcb' s \<and>
-         tcb_at' t s\<rbrace>"
-  apply (simp add: invs'_def valid_state'_def valid_queues_def)
-  apply (wp sts_valid_queues_partial sts_ksQ
-            setThreadState_oa_queued sts_st_tcb_at'_cases
-            irqs_masked_lift
-            valid_irq_node_lift
-            setThreadState_ct_not_inQ
-            sts_valid_bitmapQ_sch_act_simple
-            sts_valid_bitmapQ_no_L2_orphans_sch_act_simple
-            sts_valid_bitmapQ_no_L1_orphans_sch_act_simple
-            hoare_vcg_conj_lift hoare_vcg_imp_lift hoare_vcg_all_lift)+
-  apply (clarsimp simp: disj_imp)
-  apply (intro conjI)
-        apply (clarsimp simp: valid_queues_def)
-        apply (rule conjI, clarsimp)
-         apply (drule valid_queues_no_bitmap_objD, assumption)
-         apply (clarsimp simp: inQ_def comp_def)
-         apply (rule conjI)
-          apply (erule obj_at'_weaken)
-          apply (simp add: inQ_def)
-         apply (clarsimp simp: st_tcb_at'_def)
-         apply (erule obj_at'_weaken)
-         apply (simp add: inQ_def)
-        apply (simp add: valid_queues_no_bitmap_def)
-       apply clarsimp
-     apply (clarsimp simp: st_tcb_at'_def)
-     apply (drule obj_at_valid_objs')
-      apply (clarsimp simp: valid_pspace'_def)
-     apply (clarsimp simp: valid_obj'_def valid_tcb'_def)
-     subgoal
-     by (fastforce simp: valid_tcb_state'_def
-                  split: Structures_H.thread_state.splits)
-    apply (clarsimp dest!: st_tcb_at_state_refs_ofD'
-                    elim!: rsubst[where P=sym_refs]
-                   intro!: ext)
-   apply (fastforce simp: valid_queues_def inQ_def pred_tcb_at' pred_tcb_at'_def
-                   elim!: st_tcb_ex_cap'' obj_at'_weakenE)+
-  done
-
 crunch ct_idle_or_in_cur_domain'[wp]: tcbSchedDequeue ct_idle_or_in_cur_domain'
-
-lemma tcbSchedDequeue_invs'_no_valid_queues:
-   "\<lbrace>\<lambda>s. (\<forall>t' d p.
-            (t' \<in> set(ksReadyQueues s (d, p)) \<longrightarrow>
-             (obj_at' (\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d \<and> tcbPriority tcb = p) t' s
-              \<and> (t' \<noteq> t \<longrightarrow> st_tcb_at' runnable' t' s)))
-            \<and> distinct (ksReadyQueues s (d, p)) \<and> (maxDomain < d \<or> maxPriority < p \<longrightarrow> ksReadyQueues s (d, p) = [])) \<and>
-         valid_bitmapQ s \<and>
-         bitmapQ_no_L2_orphans s \<and>
-         bitmapQ_no_L1_orphans s \<and>
-         valid_pspace' s \<and>
-         sch_act_wf (ksSchedulerAction s) s \<and>
-         sym_refs (state_refs_of' s) \<and>
-         sym_refs (state_hyp_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>
-         valid_queues' s \<and>
-         ct_not_inQ s \<and>
-         ct_idle_or_in_cur_domain' s \<and>
-         pspace_domain_valid s \<and>
-         ksCurDomain s \<le> maxDomain \<and>
-         valid_dom_schedule' s \<and>
-         untyped_ranges_zero' s \<and>
-         cur_tcb' s \<and>
-         tcb_at' t s\<rbrace>
-    tcbSchedDequeue t
-   \<lbrace>\<lambda>_. invs' \<rbrace>"
-  apply (simp add: invs'_def valid_state'_def)
-  apply (wp tcbSchedDequeue_valid_queues_weak valid_irq_handlers_lift
-            valid_irq_node_lift valid_irq_handlers_lift'
-            tcbSchedDequeue_irq_states irqs_masked_lift cur_tcb_lift
-            untyped_ranges_zero_lift
-         | clarsimp simp add: cteCaps_of_def valid_queues_def o_def)+
-  apply (rule conjI)
-   apply (fastforce simp: obj_at'_def inQ_def st_tcb_at'_def valid_queues_no_bitmap_except_def)
-  apply (rule conjI, clarsimp simp: correct_queue_def)
-  apply (fastforce simp: valid_pspace'_def intro: obj_at'_conjI
-                   elim: valid_objs'_maxDomain valid_objs'_maxPriority)
-  done
-
-lemmas sts_tcbSchedDequeue_invs' =
-  sts_invs_minor'_no_valid_queues
-  tcbSchedDequeue_invs'_no_valid_queues
+  (wp: crunch_wps)
 
 lemma asUser_sch_act_simple[wp]:
   "\<lbrace>sch_act_simple\<rbrace> asUser s t \<lbrace>\<lambda>_. sch_act_simple\<rbrace>"
@@ -1839,11 +1408,14 @@ lemma (in delete_one_conc) suspend_invs'[wp]:
   "\<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 (wp sts_tcbSchedDequeue_invs')
-      apply (simp add: updateRestartPC_def | strengthen no_refs_simple_strg')+
-      prefer 2
-      apply (wpsimp wp: hoare_drop_imps hoare_vcg_imp_lift'
-                 | strengthen no_refs_simple_strg')+
+  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]:
@@ -1887,109 +1459,6 @@ lemma (in delete_one_conc_pre) suspend_st_tcb_at':
 lemmas (in delete_one_conc_pre) suspend_makes_simple' =
        suspend_st_tcb_at' [where P=simple', simplified]
 
-lemma valid_queues_not_runnable'_not_ksQ:
-  assumes "Invariants_H.valid_queues s" and "st_tcb_at' (Not \<circ> runnable') t s"
-  shows   "\<forall>d p. t \<notin> set (ksReadyQueues s (d, p))"
-  using assms
-  apply -
-  apply (clarsimp simp: Invariants_H.valid_queues_def valid_queues_no_bitmap_def pred_tcb_at'_def)
-  apply (erule_tac x=d in allE)
-  apply (erule_tac x=p in allE)
-  apply (clarsimp)
-  apply (drule(1) bspec)
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-declare valid_queues_not_runnable'_not_ksQ[OF ByAssum, simp]
-
-lemma cancelSignal_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues and st_tcb_at' (Not \<circ> runnable') t\<rbrace>
-   cancelSignal t ae \<lbrace>\<lambda>_. Invariants_H.valid_queues \<rbrace>"
-  apply (simp add: cancelSignal_def)
-  apply (wp sts_valid_queues)
-      apply (rule_tac Q="\<lambda>_ s. \<forall>p. t \<notin> set (ksReadyQueues s p)" in hoare_post_imp, simp)
-      apply (wp hoare_vcg_all_lift)
-     apply (wpc)
-      apply (wp)+
-   apply (rule_tac Q="\<lambda>_ s. Invariants_H.valid_queues s \<and> (\<forall>p. t \<notin> set (ksReadyQueues s p))" in hoare_post_imp)
-    apply (clarsimp)
-   apply (wp)
-  apply (clarsimp)
-  done
-
-lemma (in delete_one_conc_pre) cancelIPC_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)\<rbrace>
-   cancelIPC t \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: cancelIPC_def Let_def getThreadReplySlot_def
-             cong: Structures_H.thread_state.case_cong list.case_cong)
-  apply (rule hoare_seq_ext [OF _ gts_sp'])
-  apply (rule hoare_pre)
-   apply (wpc
-           | wp hoare_vcg_conj_lift delete_one_queues threadSet_valid_queues
-                threadSet_valid_objs' sts_valid_queues setEndpoint_ksQ
-                hoare_vcg_all_lift threadSet_sch_act threadSet_weak_sch_act_wf
-           | simp add: o_def if_apply_def2 inQ_def
-           | rule hoare_drop_imps
-           | clarsimp simp: valid_tcb'_def tcb_cte_cases_def cteSizeBits_def
-                     elim!: pred_tcb'_weakenE)+
-  apply (fastforce dest: valid_queues_not_runnable'_not_ksQ elim: pred_tcb'_weakenE)
-  done
-
-(* FIXME: move to Schedule_R *)
-lemma tcbSchedDequeue_nonq[wp]:
-  "\<lbrace>Invariants_H.valid_queues and tcb_at' t and K (t = t')\<rbrace>
-    tcbSchedDequeue t \<lbrace>\<lambda>_ s. \<forall>d p. t' \<notin> set (ksReadyQueues s (d, p))\<rbrace>"
-  apply (rule hoare_gen_asm)
-  apply (simp add: tcbSchedDequeue_def)
-  apply (wp threadGet_wp|simp)+
-  apply (fastforce simp: Invariants_H.valid_queues_def valid_queues_no_bitmap_def obj_at'_def inQ_def)
-  done
-
-lemma sts_ksQ_oaQ:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace>
-   setThreadState st t
-   \<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>"
-  (is "\<lbrace>_\<rbrace> _ \<lbrace>\<lambda>_. ?POST\<rbrace>")
-  proof -
-    have RR: "\<lbrace>sch_act_simple and ?POST\<rbrace> rescheduleRequired \<lbrace>\<lambda>_. ?POST\<rbrace>"
-      apply (simp add: rescheduleRequired_def)
-      apply (wp)
-        apply (clarsimp)
-       apply (rule_tac
-                Q="(\<lambda>s. action = ResumeCurrentThread \<or> action = ChooseNewThread) and ?POST"
-                                                               in hoare_pre_imp, assumption)
-       apply (case_tac action)
-         apply (clarsimp)+
-      apply (wp)
-      apply (clarsimp simp: sch_act_simple_def)
-      done
-    show ?thesis
-      apply (simp add: setThreadState_def)
-      apply (wp RR)
-      apply (rule_tac Q="\<lambda>_. ?POST" in hoare_post_imp)
-       apply (clarsimp simp add: sch_act_simple_def)
-      apply (wp hoare_convert_imp)
-      apply (clarsimp simp: Invariants_H.valid_queues_def valid_queues_no_bitmap_def)
-      apply (drule_tac x=d in spec)
-      apply (drule_tac x=p in spec)
-      apply (fastforce dest: bspec elim!: obj_at'_weakenE simp: inQ_def)
-      done
-  qed
-
-lemma (in delete_one_conc_pre) suspend_nonq:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and tcb_at' t
-                 and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
-                 and (\<lambda>s. t \<noteq> ksIdleThread s) and K (t = t')\<rbrace>
-     suspend t
-   \<lbrace>\<lambda>rv s. \<forall>d p. t' \<notin> set (ksReadyQueues s (d, p))\<rbrace>"
-  apply (rule hoare_gen_asm)
-  apply (simp add: suspend_def)
-  unfolding updateRestartPC_def
-  apply (wp hoare_allI tcbSchedDequeue_t_notksQ sts_ksQ_oaQ)
-    apply wpsimp+
-  done
-
 lemma suspend_makes_inactive:
   "\<lbrace>K (t = t')\<rbrace> suspend t \<lbrace>\<lambda>rv. st_tcb_at' ((=) Inactive) t'\<rbrace>"
   apply (cases "t = t'", simp_all)
@@ -2000,29 +1469,21 @@ lemma suspend_makes_inactive:
 declare threadSet_sch_act_sane [wp]
 declare sts_sch_act_sane [wp]
 
-lemma tcbSchedEnqueue_ksQset_weak:
-  "\<lbrace>\<lambda>s. t' \<in> set (ksReadyQueues s p)\<rbrace>
-   tcbSchedEnqueue t
-   \<lbrace>\<lambda>_ s. t' \<in> set (ksReadyQueues s p)\<rbrace>" (is "\<lbrace>?PRE\<rbrace> _ \<lbrace>_\<rbrace>")
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply (wp hoare_vcg_conj_lift hoare_vcg_imp_lift hoare_vcg_if_lift)
-  apply (rule_tac Q="\<lambda>_. ?PRE" in hoare_post_imp, ((wp | clarsimp)+))+
-  done
-
 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 tcbSchedEnqueue_ct', wp, simp)
+  by (rule hoare_weaken_pre, wps, wp, simp)
 
 lemma sts_sch_act_not_ct[wp]:
   "\<lbrace>\<lambda>s. sch_act_not (ksCurThread s) s\<rbrace>
    setThreadState st t \<lbrace>\<lambda>_ s. sch_act_not (ksCurThread s) s\<rbrace>"
-  by (rule hoare_weaken_pre, wps tcbSchedEnqueue_ct', wp, simp)
+  by (rule hoare_weaken_pre, wps, wp, simp)
 
 text \<open>Cancelling all IPC in an endpoint or notification object\<close>
 
 lemma ep_cancel_corres_helper:
-  "corres dc ((\<lambda>s. \<forall>t \<in> set list. tcb_at t s) and valid_etcbs and pspace_aligned and pspace_distinct)
-             (Invariants_H.valid_queues and valid_queues' and valid_objs')
+  "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
@@ -2031,28 +1492,34 @@ lemma ep_cancel_corres_helper:
                         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 (rule corres_guard_imp [OF setThreadState_corres])
-            apply simp
-           apply (simp add: valid_tcb_state_def)
-          apply simp
-         apply (wp sts_valid_queues)+
-       apply (force simp: tcb_at_is_etcb_at)
-      apply (fastforce elim: obj_at'_weakenE)
-     apply ((wp hoare_vcg_const_Ball_lift | simp)+)[1]
-    apply (rule hoare_pre)
-     apply (wp hoare_vcg_const_Ball_lift
-               weak_sch_act_wf_lift_linear sts_st_tcb' setThreadState_not_st
-               sts_valid_queues tcbSchedEnqueue_not_st
-          | simp)+
-    apply (auto elim: obj_at'_weakenE simp: valid_tcb_state'_def)
+         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
 
+crunches 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 ep_cancel_corres:
   "corres dc (invs and valid_sched and ep_at ep) (invs' and ep_at' ep)
              (cancel_all_ipc ep) (cancelAllIPC ep)"
@@ -2060,10 +1527,10 @@ proof -
   have P:
     "\<And>list.
      corres dc (\<lambda>s. (\<forall>t \<in> set list. tcb_at t s) \<and> valid_pspace s \<and> ep_at ep s
-                        \<and> valid_etcbs s \<and> weak_valid_sched_action s)
+                        \<and> valid_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> Invariants_H.valid_queues s \<and> valid_queues' s \<and> valid_objs' 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;
@@ -2085,22 +1552,23 @@ proof -
         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 R="\<lambda>_ s. \<forall>x\<in>set list. tcb_at' x s \<and> valid_objs' s"
+      apply (rule_tac R="\<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 (rule hoare_name_pre_state)
-      apply ((wp hoare_vcg_const_Ball_lift mapM_x_wp'
-                sts_valid_queues setThreadState_not_st sts_st_tcb' tcbSchedEnqueue_not_st
-           | clarsimp
-           | fastforce elim: obj_at'_weakenE simp: valid_tcb_state'_def)+)[2]
-    apply (rule hoare_name_pre_state)
+      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 elim!: valid_objs_valid_tcbE))+
+           | (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 (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
@@ -2128,6 +1596,8 @@ lemma cancelAllSignals_corres:
   "corres dc (invs and valid_sched and ntfn_at ntfn) (invs' and ntfn_at' ntfn)
              (cancel_all_signals ntfn) (cancelAllSignals ntfn)"
   apply (simp add: cancel_all_signals_def cancelAllSignals_def)
+  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+
@@ -2138,17 +1608,19 @@ lemma cancelAllSignals_corres:
       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 setThreadState_not_st
+                 weak_sch_act_wf_lift_linear
                  set_thread_state_runnable_weak_valid_sched_action
             | simp)+
       apply (rename_tac list)
-      apply (rule_tac R="\<lambda>_ s. (\<forall>x\<in>set list. tcb_at' x s) \<and> valid_objs' s"
+      apply (rule_tac R="\<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_queues setThreadState_not_st
-                  simp: valid_tcb_state'_def)
+      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)+
@@ -2195,6 +1667,11 @@ proof -
   done
 qed
 
+lemma tcbSchedEnqueue_valid_pspace'[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>valid_pspace'\<rbrace>"
+  unfolding valid_pspace'_def
+  by wpsimp
+
 lemma cancel_all_invs'_helper:
   "\<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}
@@ -2210,8 +1687,7 @@ lemma cancel_all_invs'_helper:
    apply clarsimp
   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_valid_queues sts_st_tcb' setThreadState_not_st
+             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
@@ -2220,7 +1696,7 @@ lemma cancel_all_invs'_helper:
                  elim!: rsubst[where P=sym_refs]
                  dest!: set_mono_suffix
                 intro!: ext
-       | (drule (1) bspec, clarsimp simp: valid_pspace'_def valid_tcb'_def elim!: valid_objs_valid_tcbE))+
+       | (drule (1) bspec, clarsimp simp: valid_pspace'_def valid_tcb'_def))+
   done
 
 lemma ep_q_refs_max:
@@ -2237,10 +1713,9 @@ lemma ep_q_refs_max:
   done
 
 lemma rescheduleRequired_invs'[wp]:
-  "\<lbrace>invs'\<rbrace> rescheduleRequired \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  "rescheduleRequired \<lbrace>invs'\<rbrace>"
   apply (simp add: rescheduleRequired_def)
   apply (wpsimp wp: ssa_invs')
-  apply (clarsimp simp: invs'_def valid_state'_def)
   done
 
 lemma invs_rct_ct_activatable':
@@ -2367,6 +1842,7 @@ lemma rescheduleRequired_all_invs_but_ct_not_inQ:
 lemma cancelAllIPC_invs'[wp]:
   "\<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 hoare_seq_ext[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'
@@ -2395,6 +1871,7 @@ lemma cancelAllIPC_invs'[wp]:
 lemma cancelAllSignals_invs'[wp]:
   "\<lbrace>invs'\<rbrace> cancelAllSignals ntfn \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (simp add: cancelAllSignals_def)
+  apply (rule hoare_seq_ext[OF _ stateAssert_sp])
   apply (rule hoare_seq_ext [OF _ get_ntfn_sp'])
   apply (case_tac "ntfnObj ntfna", simp_all)
     apply (wp, simp)
@@ -2426,12 +1903,14 @@ lemma cancelAllSignals_invs'[wp]:
   done
 
 lemma cancelAllIPC_valid_objs'[wp]:
-  "\<lbrace>valid_objs'\<rbrace> cancelAllIPC ep \<lbrace>\<lambda>rv. valid_objs'\<rbrace>"
+  "\<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 hoare_seq_ext[OF _ stateAssert_sp])
   apply (rule hoare_seq_ext [OF _ get_ep_sp'])
   apply (rule hoare_pre)
    apply (wp set_ep_valid_objs' setSchedulerAction_valid_objs')
-    apply (rule_tac Q="\<lambda>rv s. valid_objs' s \<and> (\<forall>x\<in>set (epQueue ep). tcb_at' x s)"
+    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)
@@ -2448,8 +1927,9 @@ lemma cancelAllIPC_valid_objs'[wp]:
   done
 
 lemma cancelAllSignals_valid_objs'[wp]:
-  "\<lbrace>valid_objs'\<rbrace> cancelAllSignals ntfn \<lbrace>\<lambda>rv. valid_objs'\<rbrace>"
+  "\<lbrace>valid_objs' and pspace_aligned' and pspace_distinct'\<rbrace> cancelAllSignals ntfn \<lbrace>\<lambda>rv. valid_objs'\<rbrace>"
   apply (simp add: cancelAllSignals_def)
+  apply (rule hoare_seq_ext[OF _ stateAssert_sp])
   apply (rule hoare_seq_ext [OF _ get_ntfn_sp'])
   apply (case_tac "ntfnObj ntfna", simp_all)
     apply (wp, simp)
@@ -2502,19 +1982,17 @@ 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>"
-  apply (simp add: setThreadState_def setQueue_def
-                   rescheduleRequired_def tcbSchedEnqueue_def
-                   unless_def bitmap_fun_defs
-             cong: scheduler_action.case_cong  cong del: if_cong
-            | wp | wpcw)+
-  done
+  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 unless_def)
+  apply (simp add: tcbSchedEnqueue_def tcbQueuePrepend_def unless_def)
   apply (wp | simp add: setQueue_def bitmap_fun_defs)+
   done
 
@@ -2548,19 +2026,41 @@ lemma setObject_ko_wp_at':
                      objBits_def[symmetric] ps_clear_upd
                      in_magnitude_check v)
 
-lemma rescheduleRequired_unlive:
-  "\<lbrace>\<lambda>s. ko_wp_at' (Not \<circ> live') p s \<and> ksSchedulerAction s \<noteq> SwitchToThread p\<rbrace>
-      rescheduleRequired
+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>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | simp | wpc)+
-   apply (simp add: tcbSchedEnqueue_def unless_def
-                    threadSet_def setQueue_def threadGet_def)
-   apply (wp setObject_ko_wp_at getObject_tcb_wp
-            | simp add: objBits_simps' bitmap_fun_defs split del: if_split)+
-  apply (clarsimp simp: o_def)
-  apply (drule obj_at_ko_at')
-  apply clarsimp
+  by (clarsimp simp: threadSet_def valid_def getObject_def
+                     setObject_def in_monad loadObject_default_def
+                     ko_wp_at'_def split_def in_magnitude_check
+                     objBits_simps' updateObject_default_def
+                     ps_clear_upd)
+
+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 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 live'_def
+                   split: option.splits)
+  done
+
+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>"
+  supply comp_apply[simp del]
+  unfolding rescheduleRequired_def
+  apply (wpsimp wp: tcbSchedEnqueue_unlive_other)
   done
 
 lemmas setEndpoint_ko_wp_at'
@@ -2570,6 +2070,7 @@ 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>"
   apply (simp add: cancelAllIPC_def ep'_Idle_case_helper)
+  apply (rule hoare_seq_ext[OF _ stateAssert_sp])
   apply (rule hoare_seq_ext [OF _ get_ep_sp'])
   apply (rule hoare_pre)
    apply (wp cancelAll_unlive_helper setEndpoint_ko_wp_at'
@@ -2589,6 +2090,7 @@ lemma cancelAllSignals_unlive:
       \<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 (rule hoare_seq_ext[OF _ stateAssert_sp])
   apply (rule hoare_seq_ext [OF _ get_ntfn_sp'])
   apply (case_tac "ntfnObj ntfn", simp_all add: setNotification_def)
     apply wp
@@ -2655,25 +2157,20 @@ lemma cancelBadgedSends_filterM_helper':
   apply (rule hoare_pre)
    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' sts_valid_queues setThreadState_not_st
-             tcbSchedEnqueue_not_st
-             untyped_ranges_zero_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
+  apply (clarsimp simp: valid_pspace'_def cong: conj_cong)
   apply (intro conjI)
-      apply (clarsimp simp: valid_pspace'_def valid_tcb'_def elim!: valid_objs_valid_tcbE dest!: st_tcb_ex_cap'')
-     apply (fastforce dest!: 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)
-    apply (fastforce elim!: obj_atE'
-                      simp: state_refs_of'_def tcb_bound_refs'_def
-                            subsetD symreftype_inverse'
-                     split: if_split_asm)+
-  done
+    by (fastforce elim!: obj_atE'
+                   simp: state_refs_of'_def tcb_bound_refs'_def subsetD symreftype_inverse'
+                  split: if_split_asm)+
 
 lemmas cancelBadgedSends_filterM_helper
     = spec [where x=Nil, OF cancelBadgedSends_filterM_helper', simplified]
@@ -2683,7 +2180,8 @@ lemma cancelBadgedSends_invs[wp]:
   shows
   "\<lbrace>invs'\<rbrace> cancelBadgedSends epptr badge \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (simp add: cancelBadgedSends_def)
-  apply (rule hoare_seq_ext [OF _ get_ep_sp'])
+  apply (rule hoare_seq_ext[OF _ stateAssert_sp])
+  apply (rule hoare_seq_ext [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",
@@ -2715,10 +2213,20 @@ lemma cancelBadgedSends_invs[wp]:
 
 crunch state_refs_of[wp]: tcb_sched_action "\<lambda>s. P (state_refs_of s)"
 
+lemma setEndpoint_valid_tcbs'[wp]:
+  "setEndpoint ePtr val \<lbrace>valid_tcbs'\<rbrace>"
+  unfolding setEndpoint_def
+  apply (wpsimp wp: setObject_valid_tcbs'[where P=\<top>])
+   apply (clarsimp simp: updateObject_default_def monad_simps)
+  apply fastforce
+  done
+
 lemma cancelBadgedSends_corres:
   "corres dc (invs and valid_sched and ep_at epptr) (invs' and ep_at' epptr)
          (cancel_badged_sends epptr bdg) (cancelBadgedSends epptr bdg)"
   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 Q'=invs'])
@@ -2728,11 +2236,16 @@ lemma cancelBadgedSends_corres:
   apply (rule corres_guard_imp)
     apply (rule corres_split_nor[OF setEndpoint_corres])
        apply (simp add: ep_relation_def)
-      apply (rule corres_split_eqr[OF _ _ _ hoare_post_add[where R="\<lambda>_. valid_objs'"]])
+      apply (rule corres_split_eqr[OF _ _ _ hoare_post_add
+                                             [where R="\<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> pspace_aligned s \<and> pspace_distinct s"
-                    and Q'="\<lambda>xs s. Invariants_H.valid_queues s \<and> valid_queues' s \<and> valid_objs' s"
+                                   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)
@@ -2743,57 +2256,53 @@ lemma cancelBadgedSends_corres:
                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])
+                 apply (rule corres_split[OF tcbSchedEnqueue_corres], simp)
                    apply (rule corres_trivial)
                    apply simp
                   apply wp+
                apply simp
-               apply (wp sts_valid_queues gts_st_tcb_at)+
+               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: is_tcb_def)
-           apply simp
+           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_queues
+            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 (wp gts_st_tcb_at hoare_vcg_imp_lift mapM_wp'
-                 sts_st_tcb' sts_valid_queues
-                 set_thread_state_runnable_weak_valid_sched_action
-                 | clarsimp simp: valid_tcb_state'_def)+
-    apply (wp hoare_vcg_const_Ball_lift weak_sch_act_wf_lift_linear set_ep_valid_objs'
-               | simp)+
+       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 (drule ko_at_valid_objs', clarsimp)
-   apply simp
-  apply (clarsimp simp: valid_obj'_def valid_ep'_def invs_weak_sch_act_wf
-                        invs'_def valid_state'_def)
+  apply (fastforce simp: valid_ep'_def)
   done
 
+crunches 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 (simp add: threadGet_def| wp getObject_tcb_wp)+
-    apply (rule hoare_strengthen_post, rule hoare_post_taut)
-    apply (fastforce simp: obj_at'_def)
-   apply (rule hoare_post_taut)
-    apply wp+
-  done
+  unfolding suspend_def
+  by (wpsimp simp: comp_def wp: tcbSchedDequeue_not_tcbQueued)
 
 crunch no_vcpu[wp]: vcpuInvalidateActive "obj_at' (P::'a:: no_vcpu \<Rightarrow> bool) t"
 
@@ -2838,7 +2347,6 @@ lemma archThreadGet_wp:
 crunch unqueued: prepareThreadDelete "obj_at' (Not \<circ> tcbQueued) t"
   (simp: o_def wp: dissociateVCPUTCB_unqueued[simplified o_def] archThreadGet_wp)
 crunch inactive: prepareThreadDelete "st_tcb_at' ((=) Inactive) t'"
-crunch nonq: prepareThreadDelete " \<lambda>s. \<forall>d p. t' \<notin> set (ksReadyQueues s (d, p))"
 
 end
 end
diff --git a/proof/refine/AARCH64/Ipc_R.thy b/proof/refine/AARCH64/Ipc_R.thy
index b79babae31..b4d1cae884 100644
--- a/proof/refine/AARCH64/Ipc_R.thy
+++ b/proof/refine/AARCH64/Ipc_R.thy
@@ -765,14 +765,6 @@ lemma tcts_sch_act[wp]:
    \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
   by (wp sch_act_wf_lift tcb_in_cur_domain'_lift transferCapsToSlots_pres1)
 
-lemma tcts_vq[wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> transferCapsToSlots ep buffer n caps slots mi \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  by (wp valid_queues_lift transferCapsToSlots_pres1)
-
-lemma tcts_vq'[wp]:
-  "\<lbrace>valid_queues'\<rbrace> transferCapsToSlots ep buffer n caps slots mi \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  by (wp valid_queues_lift' transferCapsToSlots_pres1)
-
 crunches setExtraBadge
   for state_refs_of'[wp]: "\<lambda>s. P (state_refs_of' s)"
   and state_hyp_refs_of'[wp]: "\<lambda>s. P (state_hyp_refs_of' s)"
@@ -982,6 +974,11 @@ crunch ksDomScheduleIdx[wp]: setExtraBadge "\<lambda>s. P (ksDomScheduleIdx s)"
 crunch ksDomSchedule[wp]: transferCapsToSlots "\<lambda>s. P (ksDomSchedule s)"
 crunch ksDomScheduleIdx[wp]: transferCapsToSlots "\<lambda>s. P (ksDomScheduleIdx s)"
 
+crunches transferCapsToSlots
+  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)
 
 lemma transferCapsToSlots_invs[wp]:
   "\<lbrace>\<lambda>s. invs' s \<and> distinct slots
@@ -1216,8 +1213,6 @@ lemma setMRs_invs_bits[wp]:
      setMRs t buf mrs \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
   "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
      setMRs t buf mrs \<lbrace>\<lambda>rv s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> setMRs t buf mrs \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  "\<lbrace>valid_queues'\<rbrace> setMRs t buf mrs \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
   "\<And>P. setMRs t buf mrs \<lbrace>\<lambda>s. P (state_refs_of' s)\<rbrace>"
   "\<And>P. setMRs t buf mrs \<lbrace>\<lambda>s. P (state_hyp_refs_of' s)\<rbrace>"
   "\<lbrace>if_live_then_nonz_cap'\<rbrace> setMRs t buf mrs \<lbrace>\<lambda>rv. if_live_then_nonz_cap'\<rbrace>"
@@ -1233,8 +1228,6 @@ lemma copyMRs_invs_bits[wp]:
   "\<lbrace>valid_pspace'\<rbrace> copyMRs s sb r rb n \<lbrace>\<lambda>rv. valid_pspace'\<rbrace>"
   "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace> copyMRs s sb r rb n
       \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> copyMRs s sb r rb n \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  "\<lbrace>valid_queues'\<rbrace> copyMRs s sb r rb n \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
   "\<And>P. copyMRs s sb r rb n \<lbrace>\<lambda>s. P (state_refs_of' s)\<rbrace>"
   "\<And>P. copyMRs s sb r rb n  \<lbrace>\<lambda>s. P (state_hyp_refs_of' s)\<rbrace>"
   "\<lbrace>if_live_then_nonz_cap'\<rbrace> copyMRs s sb r rb n \<lbrace>\<lambda>rv. if_live_then_nonz_cap'\<rbrace>"
@@ -1710,10 +1703,6 @@ crunch vp[wp]: doIPCTransfer "valid_pspace'"
   (wp: crunch_wps hoare_vcg_const_Ball_lift get_rs_cte_at' wp: transferCapsToSlots_vp simp:ball_conj_distrib )
 crunch sch_act_wf[wp]: doIPCTransfer "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
   (wp: crunch_wps get_rs_cte_at' ignore: transferCapsToSlots  simp: zipWithM_x_mapM)
-crunch vq[wp]: doIPCTransfer "Invariants_H.valid_queues"
-  (wp: crunch_wps get_rs_cte_at' ignore: transferCapsToSlots  simp: zipWithM_x_mapM)
-crunch vq'[wp]: doIPCTransfer "valid_queues'"
-  (wp: crunch_wps get_rs_cte_at' ignore: transferCapsToSlots  simp: zipWithM_x_mapM)
 crunch state_refs_of[wp]: doIPCTransfer "\<lambda>s. P (state_refs_of' s)"
   (wp: crunch_wps get_rs_cte_at' ignore: transferCapsToSlots  simp: zipWithM_x_mapM)
 crunch state_hyp_refs_of[wp]: doIPCTransfer "\<lambda>s. P (state_hyp_refs_of' s)"
@@ -1871,16 +1860,6 @@ lemma getThreadCallerSlot_inv:
   "\<lbrace>P\<rbrace> getThreadCallerSlot t \<lbrace>\<lambda>_. P\<rbrace>"
   by (simp add: getThreadCallerSlot_def, wp)
 
-lemma deleteCallerCap_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>
-   deleteCallerCap t
-   \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: deleteCallerCap_def getSlotCap_def getThreadCallerSlot_def locateSlot_conv)
-  apply (wp getThreadCallerSlot_inv cteDeleteOne_ct_not_ksQ getCTE_wp)
-  apply (clarsimp simp: cte_wp_at_ctes_of)
-  done
-
 lemma finaliseCapTrue_standin_tcb_at' [wp]:
   "\<lbrace>tcb_at' x\<rbrace> finaliseCapTrue_standin cap v2 \<lbrace>\<lambda>_. tcb_at' x\<rbrace>"
   apply (simp add: finaliseCapTrue_standin_def Let_def)
@@ -2034,39 +2013,11 @@ lemma cteDeleteOne_weak_sch_act[wp]:
   done
 
 crunch pred_tcb_at'[wp]: handleFaultReply "pred_tcb_at' proj P t"
-crunch valid_queues[wp]: handleFaultReply "Invariants_H.valid_queues"
-crunch valid_queues'[wp]: handleFaultReply "valid_queues'"
 crunch tcb_in_cur_domain'[wp]: handleFaultReply "tcb_in_cur_domain' t"
 
 crunch sch_act_wf[wp]: unbindNotification "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
 (wp: sbn_sch_act')
 
-crunch valid_queues'[wp]: cteDeleteOne valid_queues'
-  (simp: crunch_simps unless_def inQ_def
-     wp: crunch_wps sts_st_tcb' getObject_inv loadObject_default_inv
-         threadSet_valid_queues' rescheduleRequired_valid_queues'_weak)
-
-lemma cancelSignal_valid_queues'[wp]:
-  "\<lbrace>valid_queues'\<rbrace> cancelSignal t ntfn \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (simp add: cancelSignal_def)
-  apply (rule hoare_pre)
-   apply (wp getNotification_wp| wpc | simp)+
-  done
-
-lemma cancelIPC_valid_queues'[wp]:
-  "\<lbrace>valid_queues' and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) \<rbrace> cancelIPC t \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (simp add: cancelIPC_def Let_def getThreadReplySlot_def locateSlot_conv liftM_def)
-  apply (rule hoare_seq_ext[OF _ gts_sp'])
-  apply (case_tac state, simp_all) defer 2
-  apply (rule hoare_pre)
-   apply ((wp getEndpoint_wp getCTE_wp | wpc | simp)+)[8]
-  apply (wp cteDeleteOne_valid_queues')
-  apply (rule_tac Q="\<lambda>_. valid_queues' and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)" in hoare_post_imp)
-  apply (clarsimp simp: capHasProperty_def cte_wp_at_ctes_of)
-   apply (wp threadSet_valid_queues' threadSet_sch_act| simp)+
-  apply (clarsimp simp: inQ_def)
-  done
-
 crunch valid_objs'[wp]: handleFaultReply valid_objs'
 
 lemma cte_wp_at_is_reply_cap_toI:
@@ -2078,6 +2029,13 @@ crunches handle_fault_reply
   for pspace_alignedp[wp]: pspace_aligned
   and pspace_distinct[wp]: pspace_distinct
 
+crunches 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 doReplyTransfer_corres:
   "corres dc
      (einvs and tcb_at receiver and tcb_at sender
@@ -2123,8 +2081,12 @@ lemma doReplyTransfer_corres:
            apply (rule corres_split[OF setThreadState_corres])
               apply simp
              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_queues sts_valid_objs' delete_one_tcbDomain_obj_at'
-                   | simp add: valid_tcb_state'_def)+
+            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])
@@ -2133,7 +2095,11 @@ lemma doReplyTransfer_corres:
           apply (fastforce)
          apply (clarsimp simp:is_cap_simps)
         apply (wp weak_valid_sched_action_lift)+
-       apply (rule_tac Q="\<lambda>_. valid_queues' and valid_objs' and cur_tcb' and tcb_at' receiver and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)" in hoare_post_imp, simp add: sch_act_wf_weak)
+       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)
@@ -2165,7 +2131,9 @@ lemma doReplyTransfer_corres:
                 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 Invariants_H.valid_queues and valid_queues' and valid_objs'"
+                                      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)
@@ -2174,18 +2142,16 @@ lemma doReplyTransfer_corres:
                        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_queues
+                                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 simp: tcb_relation_def)
                    apply (wp threadSet_cur weak_sch_act_wf_lift_linear threadSet_pred_tcb_no_state
-                             thread_set_not_state_valid_sched threadSet_valid_queues threadSet_valid_queues'
+                             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 (wp threadSet_cur weak_sch_act_wf_lift_linear threadSet_pred_tcb_no_state
-                      thread_set_not_state_valid_sched threadSet_valid_queues threadSet_valid_queues'
-                 | simp add: runnable_def inQ_def valid_tcb'_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)
@@ -2452,10 +2418,12 @@ proof -
                  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 setThreadState_valid_queues' sts_valid_queues sts_weak_sch_act_wf
+               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)
+              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)
@@ -2520,11 +2488,13 @@ proof -
                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 setThreadState_valid_queues' sts_valid_queues sts_weak_sch_act_wf
+              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)+)[1]
+                     | 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)
@@ -2598,14 +2568,15 @@ lemma sendSignal_corres:
                apply (rule possibleSwitchTo_corres)
               apply wp
              apply (wp set_thread_state_runnable_weak_valid_sched_action sts_st_tcb_at'
-                       sts_valid_queues sts_st_tcb' hoare_disjI2
+                       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 (clarsimp simp: invs'_def valid_state'_def sch_act_wf_weak
-                               valid_tcb_state'_def)
+         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)+
@@ -2631,23 +2602,23 @@ lemma sendSignal_corres:
           apply (rule corres_split[OF asUser_setRegister_corres])
             apply (rule possibleSwitchTo_corres)
            apply ((wp | simp)+)[1]
-          apply (rule_tac Q="\<lambda>_. Invariants_H.valid_queues and valid_queues' and
-                                 (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and
+          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'"
+                                 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')
           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_queues setThreadState_valid_queues'
-                  setThreadState_st_tcb
+        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 (clarsimp 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 (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)
 
@@ -2665,16 +2636,14 @@ lemma sendSignal_corres:
           apply (wp cur_tcb_lift | 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_queues setThreadState_valid_queues'
-                 setThreadState_st_tcb
-            | 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 (clarsimp 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 (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]
@@ -2705,38 +2674,6 @@ lemma possibleSwitchTo_sch_act[wp]:
   apply (auto simp: obj_at'_def tcb_in_cur_domain'_def)
   done
 
-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>"
-  apply (simp add: possibleSwitchTo_def curDomain_def bitmap_fun_defs)
-  apply (wp hoare_drop_imps | wpc | simp)+
-  apply (auto simp: valid_tcb'_def weak_sch_act_wf_def
-              dest: pred_tcb_at'
-             elim!: valid_objs_valid_tcbE)
-  done
-
-lemma possibleSwitchTo_ksQ':
-  "\<lbrace>(\<lambda>s. t' \<notin> set (ksReadyQueues s p) \<and> sch_act_not t' s) and K(t' \<noteq> t)\<rbrace>
-     possibleSwitchTo t
-   \<lbrace>\<lambda>_ s. t' \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: possibleSwitchTo_def curDomain_def bitmap_fun_defs)
-  apply (wp hoare_weak_lift_imp rescheduleRequired_ksQ' tcbSchedEnqueue_ksQ threadGet_wp
-         | wpc
-         | simp split del: if_split)+
-  apply (auto simp: obj_at'_def)
-  done
-
-lemma possibleSwitchTo_valid_queues'[wp]:
-  "\<lbrace>valid_queues' and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)
-                  and st_tcb_at' runnable' t\<rbrace>
-   possibleSwitchTo t
-   \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (simp add: possibleSwitchTo_def curDomain_def bitmap_fun_defs)
-  apply (wp hoare_weak_lift_imp threadGet_wp | wpc | simp)+
-  apply (auto simp: obj_at'_def)
-  done
-
 crunch st_refs_of'[wp]: possibleSwitchTo "\<lambda>s. P (state_refs_of' s)"
   (wp: crunch_wps)
 crunch st_hyp_refs_of'[wp]: possibleSwitchTo "\<lambda>s. P (state_hyp_refs_of' s)"
@@ -2749,16 +2686,12 @@ crunch ct[wp]: possibleSwitchTo 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>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>rv. 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)+
-  apply (auto simp: obj_at'_def)
-  done
+  unfolding possibleSwitchTo_def curDomain_def
+  by (wpsimp wp: threadGet_wp)
 
 crunch ifunsafe[wp]: possibleSwitchTo if_unsafe_then_cap'
   (wp: crunch_wps)
@@ -2789,10 +2722,6 @@ crunch irqs_masked'[wp]: sendSignal "irqs_masked'"
    simp: crunch_simps unless_def o_def
    rule: irqs_masked_lift)
 
-lemma sts_running_valid_queues:
-  "runnable' st \<Longrightarrow> \<lbrace> Invariants_H.valid_queues \<rbrace> setThreadState st t \<lbrace>\<lambda>_. Invariants_H.valid_queues \<rbrace>"
-  by (wp sts_valid_queues, clarsimp)
-
 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)
@@ -2805,24 +2734,21 @@ lemma setThreadState_nonqueued_state_update:
                \<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)
-               \<and> (\<not> runnable' st \<longrightarrow> (\<forall>p. t \<notin> set (ksReadyQueues s p)))\<rbrace>
-  setThreadState st t \<lbrace>\<lambda>rv. invs'\<rbrace>"
+               \<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
-                            sts_valid_queues
-                            setThreadState_ct_not_inQ)
+  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 (drule simple_st_tcb_at_state_refs_ofD')
   apply (drule bound_tcb_at_state_refs_ofD')
-  apply (rule conjI, fastforce)
-  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 (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
 
 lemma cteDeleteOne_reply_cap_to'[wp]:
@@ -2890,16 +2816,14 @@ lemma cancelAllIPC_not_rct[wp]:
    \<lbrace>\<lambda>_ s. ksSchedulerAction s \<noteq> ResumeCurrentThread \<rbrace>"
   apply (simp add: cancelAllIPC_def)
   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 (wp)+
-     apply (rule hoare_post_imp [OF _ rescheduleRequired_notresume], simp)
-    apply simp
-    apply (rule mapM_x_wp_inv)
-    apply (wp)+
-  apply (wp hoare_vcg_all_lift hoare_drop_imp)
-    apply (simp_all)
+      apply (wpsimp wp: hoare_vcg_all_lift hoare_drop_imp)+
   done
 
 lemma cancelAllSignals_not_rct[wp]:
@@ -2908,12 +2832,10 @@ lemma cancelAllSignals_not_rct[wp]:
    \<lbrace>\<lambda>_ s. ksSchedulerAction s \<noteq> ResumeCurrentThread \<rbrace>"
   apply (simp add: cancelAllSignals_def)
   apply (wp | wpc)+
-     apply (rule hoare_post_imp [OF _ rescheduleRequired_notresume], simp)
-    apply simp
-    apply (rule mapM_x_wp_inv)
-    apply (wp)+
-  apply (wp hoare_vcg_all_lift hoare_drop_imp)
-    apply (simp_all)
+       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 not_rct[wp]: finaliseCapTrue_standin "\<lambda>s. ksSchedulerAction s \<noteq> ResumeCurrentThread"
@@ -2995,7 +2917,6 @@ lemma sai_invs'[wp]:
      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
-               sts_valid_queues [where st="Structures_H.thread_state.Running", simplified]
                set_ntfn_valid_objs' cur_tcb_lift sts_st_tcb'
                hoare_convert_imp [OF setNotification_nosch]
            | simp split del: if_split)+
@@ -3208,11 +3129,11 @@ lemma receiveIPC_corres:
                                              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 Invariants_H.valid_queues
-                                                   and valid_queues'
                                                    and valid_pspace'
                                                    and valid_objs'
-                                             and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)"
+                                             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])
@@ -3221,17 +3142,18 @@ lemma receiveIPC_corres:
                        apply (rule corres_split[OF setThreadState_corres])
                           apply simp
                          apply (rule possibleSwitchTo_corres)
-                        apply (wp sts_st_tcb_at' set_thread_state_runnable_weak_valid_sched_action
-                             | simp)+
-                       apply (wp sts_st_tcb_at'_cases sts_valid_queues setThreadState_valid_queues'
-                                 setThreadState_st_tcb
+                        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 (clarsimp simp: st_tcb_at_tcb_at st_tcb_def2 valid_sched_def
-                                            valid_sched_action_def)
+                      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"
-                         in hoare_post_imp, erule sch_act_wf_weak)
+                   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
@@ -3456,30 +3378,6 @@ lemma setupCallerCap_state_hyp_refs_of[wp]:
   apply (wp hoare_drop_imps)
   done
 
-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 vq[wp]: cteInsert "Invariants_H.valid_queues"
-  (wp: crunch_wps)
-
-crunch vq[wp]: getThreadCallerSlot "Invariants_H.valid_queues"
-  (wp: crunch_wps)
-
-crunch vq[wp]: getThreadReplySlot "Invariants_H.valid_queues"
-  (wp: crunch_wps)
-
-lemma setupCallerCap_vq[wp]:
-  "\<lbrace>Invariants_H.valid_queues and (\<lambda>s. \<forall>p. send \<notin> set (ksReadyQueues s p))\<rbrace>
-   setupCallerCap send recv grant \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: setupCallerCap_def)
-  apply (wp crunch_wps sts_valid_queues)
-  apply (fastforce simp: valid_queues_def obj_at'_def inQ_def)
-  done
-
-crunch vq'[wp]: setupCallerCap "valid_queues'"
-  (wp: crunch_wps)
-
 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)"
@@ -3521,7 +3419,7 @@ lemma setupCallerCap_vp[wp]:
 declare haskell_assert_inv[wp del]
 
 lemma setupCallerCap_iflive[wp]:
-  "\<lbrace>if_live_then_nonz_cap' and ex_nonz_cap_to' sender\<rbrace>
+  "\<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
@@ -3533,7 +3431,7 @@ lemma setupCallerCap_iflive[wp]:
 
 lemma setupCallerCap_ifunsafe[wp]:
   "\<lbrace>if_unsafe_then_cap' and valid_objs' and
-    ex_nonz_cap_to' rcvr and tcb_at' rcvr\<rbrace>
+    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
@@ -3555,13 +3453,11 @@ lemma setupCallerCap_global_refs'[wp]:
    \<lbrace>\<lambda>rv. valid_global_refs'\<rbrace>"
   unfolding setupCallerCap_def getThreadCallerSlot_def
             getThreadReplySlot_def locateSlot_conv
-  apply (wp getSlotCap_cte_wp_at
-    | simp add: o_def unique_master_reply_cap'
-    | strengthen eq_imp_strg
-    | wp (once) getCTE_wp | clarsimp simp: cte_wp_at_ctes_of)+
-  (* at setThreadState *)
-  apply (rule_tac Q="\<lambda>_. valid_global_refs'" in hoare_post_imp, wpsimp+)
-  done
+  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 valid_arch'[wp]: setupCallerCap "valid_arch_state'"
   (wp: hoare_drop_imps)
@@ -3736,12 +3632,21 @@ crunches possibleSwitchTo
   for ksArch[wp]: "\<lambda>s. P (ksArchState s)"
   (wp: possibleSwitchTo_ctes_of crunch_wps ignore: constOnFailure)
 
+crunches asUser
+  for valid_bitmaps[wp]: valid_bitmaps
+  (rule: valid_bitmaps_lift wp: crunch_wps)
+
+crunches 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)
+
 (* 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 (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))
           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
@@ -3759,7 +3664,7 @@ lemma ri_invs' [wp]:
      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
-                sts_valid_queues setThreadState_ct_not_inQ
+                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)
@@ -3786,7 +3691,7 @@ lemma ri_invs' [wp]:
     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
-               sts_valid_queues setThreadState_ct_not_inQ
+               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)
@@ -3810,9 +3715,8 @@ lemma ri_invs' [wp]:
    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' sts_valid_queues
-              setThreadState_ct_not_inQ possibleSwitchTo_valid_queues
-              possibleSwitchTo_valid_queues'
+              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
@@ -3829,8 +3733,6 @@ lemma ri_invs' [wp]:
    apply (clarsimp simp: valid_obj'_def valid_ep'_def st_tcb_at_refs_of_rev' conj_ac
               split del: if_split
                    cong: if_cong)
-   apply (frule_tac t=sender in valid_queues_not_runnable'_not_ksQ)
-    apply (erule pred_tcb'_weakenE, clarsimp)
    apply (subgoal_tac "sch_act_not sender s")
     prefer 2
     apply (clarsimp simp: pred_tcb_at'_def obj_at'_def)
@@ -3864,7 +3766,6 @@ lemma ri_invs' [wp]:
 lemma rai_invs'[wp]:
   "\<lbrace>invs' and sch_act_not t
           and st_tcb_at' simple' t
-          and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))
           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
@@ -3881,7 +3782,7 @@ lemma rai_invs'[wp]:
     apply (simp add: invs'_def valid_state'_def)
     apply (rule hoare_pre)
      apply (wp valid_irq_node_lift sts_sch_act' typ_at_lifts
-               sts_valid_queues setThreadState_ct_not_inQ
+               setThreadState_ct_not_inQ
                asUser_urz
             | simp add: valid_ntfn'_def doNBRecvFailedTransfer_def live'_def | wpc)+
     apply (clarsimp simp: pred_tcb_at' valid_tcb_state'_def)
@@ -3899,7 +3800,7 @@ lemma rai_invs'[wp]:
        apply (clarsimp split: if_split_asm)
       apply (fastforce simp: tcb_bound_refs'_def symreftype_inverse'
                       split: if_split_asm)
-     apply (clarsimp dest!: global'_no_ex_cap)
+     apply (fastforce dest!: global'_no_ex_cap)
     apply (clarsimp simp: pred_tcb_at'_def obj_at'_def)
    \<comment> \<open>ep = ActiveNtfn\<close>
    apply (simp add: invs'_def valid_state'_def)
@@ -3919,7 +3820,7 @@ lemma rai_invs'[wp]:
   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'
-             sts_valid_queues setThreadState_ct_not_inQ typ_at_lifts
+             setThreadState_ct_not_inQ typ_at_lifts
              asUser_urz
         | simp add: valid_ntfn'_def doNBRecvFailedTransfer_def live'_def | wpc)+
   apply (clarsimp simp: valid_tcb_state'_def)
@@ -3947,7 +3848,7 @@ lemma rai_invs'[wp]:
         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 (clarsimp dest!: global'_no_ex_cap)
+  apply (fastforce dest!: global'_no_ex_cap)
   done
 
 lemma getCTE_cap_to_refs[wp]:
@@ -3986,9 +3887,12 @@ crunch urz[wp]: possibleSwitchTo "untyped_ranges_zero'"
 
 declare zipWithM_x_mapM[simp] (* FIXME AARCH64: remove? *)
 
+crunches possibleSwitchTo
+  for pspace_aligned'[wp]: pspace_aligned'
+  and pspace_distinct'[wp]: pspace_distinct'
+
 lemma si_invs'[wp]:
   "\<lbrace>invs' and st_tcb_at' simple' t
-          and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))
           and sch_act_not t
           and ex_nonz_cap_to' ep and ex_nonz_cap_to' t\<rbrace>
   sendIPC bl call ba cg cgr t ep
@@ -4007,8 +3911,8 @@ lemma si_invs'[wp]:
      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 sts_valid_queues setThreadState_ct_not_inQ
-               possibleSwitchTo_ksQ' possibleSwitchTo_ct_not_inQ hoare_vcg_all_lift sts_ksQ'
+               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"]
@@ -4059,8 +3963,7 @@ lemma si_invs'[wp]:
     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' sts_valid_queues
-               setThreadState_ct_not_inQ)
+     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")
@@ -4079,8 +3982,7 @@ lemma si_invs'[wp]:
    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'
-              sts_valid_queues setThreadState_ct_not_inQ)
+    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)
@@ -4106,19 +4008,15 @@ lemma si_invs'[wp]:
 lemma sfi_invs_plus':
   "\<lbrace>invs' and st_tcb_at' simple' t
           and sch_act_not t
-          and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))
           and ex_nonz_cap_to' t\<rbrace>
-      sendFaultIPC t f
-   \<lbrace>\<lambda>rv. invs'\<rbrace>, \<lbrace>\<lambda>rv. invs' and st_tcb_at' simple' t
-                      and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))
-                      and sch_act_not t and (\<lambda>s. ksIdleThread s \<noteq> 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'
            | wpc | simp)+
    apply (rule_tac Q'="\<lambda>rv s. invs' s \<and> sch_act_not t s
                              \<and> st_tcb_at' simple' t s
-                             \<and> (\<forall>p. t \<notin> set (ksReadyQueues s p))
                              \<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)"
@@ -4140,7 +4038,6 @@ lemma handleFault_corres:
    corres dc (einvs and st_tcb_at active thread and ex_nonz_cap_to thread
                    and (\<lambda>_. valid_fault f))
              (invs' and sch_act_not thread
-                    and (\<lambda>s. \<forall>p. thread \<notin> set(ksReadyQueues s p))
                     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)
@@ -4164,17 +4061,13 @@ lemma sts_invs_minor'':
                    \<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. (\<exists>p. t \<in> set (ksReadyQueues s p)) \<longrightarrow> runnable' st)
-      and (\<lambda>s. runnable' st \<and> obj_at' tcbQueued t s
-                                      \<longrightarrow> st_tcb_at' runnable' t s)
       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' sts_valid_queues
-             setThreadState_ct_not_inQ)
+   apply (wp valid_irq_node_lift sts_sch_act' setThreadState_ct_not_inQ)
   apply clarsimp
   apply (rule conjI)
    apply fastforce
@@ -4189,12 +4082,11 @@ lemma sts_invs_minor'':
    apply (clarsimp dest!: st_tcb_at_state_refs_ofD'
                    elim!: rsubst[where P=sym_refs]
                   intro!: ext)
-  apply (clarsimp elim!: st_tcb_ex_cap'')
+  apply (fastforce elim!: st_tcb_ex_cap'')
   done
 
 lemma hf_invs' [wp]:
   "\<lbrace>invs' and sch_act_not t
-          and (\<lambda>s. \<forall>p. t \<notin> set(ksReadyQueues s p))
           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>"
diff --git a/proof/refine/AARCH64/KHeap_R.thy b/proof/refine/AARCH64/KHeap_R.thy
index 0f62064b1a..67059315ff 100644
--- a/proof/refine/AARCH64/KHeap_R.thy
+++ b/proof/refine/AARCH64/KHeap_R.thy
@@ -14,8 +14,45 @@ lemma lookupAround2_known1:
   "m x = Some y \<Longrightarrow> fst (lookupAround2 x m) = Some (x, y)"
   by (fastforce simp: lookupAround2_char1)
 
+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
+
 context begin interpretation Arch . (*FIXME: arch_split*)
 
+lemma setObject_modify_variable_size:
+  fixes v :: "'a :: pspace_storable" shows
+  "\<lbrakk>obj_at' (P :: 'a \<Rightarrow> bool) p s; updateObject v = updateObject_default v;
+    (1 :: machine_word) < 2 ^ objBits v; obj_at' (\<lambda>obj. objBits v = objBits obj) p s\<rbrakk>
+   \<Longrightarrow> setObject p v s = modify (ksPSpace_update (\<lambda>ps. ps (p \<mapsto> injectKO v))) s"
+  apply (clarsimp simp: setObject_def split_def exec_gets obj_at'_def lookupAround2_known1
+                        assert_opt_def updateObject_default_def bind_assoc)
+  apply (simp add: projectKO_def alignCheck_assert)
+  apply (simp add: project_inject objBits_def)
+  apply (clarsimp simp only: koTypeOf_injectKO)
+  apply (frule in_magnitude_check[where s'=s])
+    apply blast
+   apply fastforce
+  apply (simp add: magnitudeCheck_assert in_monad bind_def gets_def oassert_opt_def
+                   get_def return_def)
+  apply (simp add: simpler_modify_def)
+  done
+
+lemma setObject_modify:
+  fixes v :: "'a :: pspace_storable" shows
+  "\<lbrakk>obj_at' (P :: 'a \<Rightarrow> bool) p s; updateObject v = updateObject_default v;
+    (1 :: machine_word) < 2 ^ objBits v; \<And>ko. P ko \<Longrightarrow> objBits ko = objBits v \<rbrakk>
+   \<Longrightarrow> setObject p v s = modify (ksPSpace_update (\<lambda>ps. ps (p \<mapsto> injectKO v))) s"
+  apply (rule setObject_modify_variable_size)
+     apply fastforce
+    apply fastforce
+  apply fastforce
+  unfolding obj_at'_def
+  by fastforce
+
 lemma obj_at_getObject:
   assumes R:
   "\<And>a b n ko s obj::'a::pspace_storable.
@@ -137,8 +174,7 @@ lemma corres_get_tcb:
   apply (drule bspec)
    apply clarsimp
    apply blast
-  apply (clarsimp simp add: other_obj_relation_def
-                            lookupAround2_known1)
+  apply (clarsimp simp: tcb_relation_cut_def lookupAround2_known1)
   done
 
 lemma lookupAround2_same1[simp]:
@@ -436,6 +472,40 @@ lemma setObject_tcb_strongest:
                         updateObject_default_def ps_clear_upd)
   done
 
+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 opt_pred_def projectKO_opts_defs
+          split: if_split_asm
+                 Structures_H.kernel_object.split_asm
+
+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_tcbs_of'[wp]:
+  "setObject c (notification :: notification) \<lbrace>\<lambda>s. P' (tcbs_of' s)\<rbrace>"
+  by setObject_easy_cases
+
+lemma setObject_cte_tcbSchedNexts_of[wp]:
+  "setObject c (cte :: cte) \<lbrace>\<lambda>s. P' (tcbSchedNexts_of s)\<rbrace>"
+  by setObject_easy_cases
+
+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_tcbQueued[wp]:
+  "setObject c (cte :: cte) \<lbrace>\<lambda>s. P' (tcbQueued |< tcbs_of' s)\<rbrace>"
+  supply inQ_def[simp]
+  by setObject_easy_cases
+
+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 getObject_obj_at':
   assumes x: "\<And>q n ko. loadObject p q n ko =
                 (loadObject_default p q n ko :: ('a :: pspace_storable) kernel)"
@@ -939,7 +1009,7 @@ lemma obj_relation_cut_same_type:
          \<or> (\<exists>pt_t pt_t'. a_type ko = AArch (APageTable pt_t) \<and> a_type ko' = AArch (APageTable pt_t'))"
   apply (rule ccontr)
   apply (simp add: obj_relation_cuts_def2 a_type_def)
-  apply (auto simp: other_obj_relation_def cte_relation_def pte_relation_def
+  apply (auto simp: other_obj_relation_def tcb_relation_cut_def cte_relation_def pte_relation_def
              split: Structures_A.kernel_object.split_asm if_split_asm
                     Structures_H.kernel_object.split_asm
                     arch_kernel_obj.split_asm arch_kernel_object.split_asm)
@@ -956,6 +1026,16 @@ where
   "exst_same' (KOTCB tcb) (KOTCB tcb') = exst_same tcb tcb'" |
   "exst_same' _ _ = True"
 
+lemma tcbs_of'_non_tcb_update:
+  "\<lbrakk>typ_at' (koTypeOf ko) ptr s'; koTypeOf ko \<noteq> TCBT\<rbrakk>
+   \<Longrightarrow> tcbs_of' (s'\<lparr>ksPSpace := (ksPSpace s')(ptr \<mapsto> ko)\<rparr>) = tcbs_of' s'"
+  by (fastforce simp: typ_at'_def ko_wp_at'_def opt_map_def projectKO_opts_defs
+               split: kernel_object.splits)
+
+lemma typ_at'_koTypeOf:
+  "ko_at' ob' ptr b \<Longrightarrow> typ_at' (koTypeOf (injectKO ob')) ptr b"
+  by (auto simp: typ_at'_def ko_wp_at'_def obj_at'_def project_inject)
+
 lemma setObject_other_corres:
   fixes ob' :: "'a :: pspace_storable"
   assumes x: "updateObject ob' = updateObject_default ob'"
@@ -985,7 +1065,7 @@ lemma setObject_other_corres:
   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 (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 simp: obj_at_def a_type_def
@@ -995,6 +1075,14 @@ lemma setObject_other_corres:
   apply (simp only: pspace_relation_def pspace_dom_update dom_fun_upd2 simp_thms)
   apply (elim conjE)
   apply (frule bspec, erule domI)
+  apply (prop_tac "typ_at' (koTypeOf (injectKO ob')) ptr b")
+   subgoal
+     by (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 clarsimp
   apply (rule conjI)
    apply (rule ballI, drule(1) bspec)
    apply (drule domD)
@@ -1003,31 +1091,30 @@ lemma setObject_other_corres:
    apply clarsimp
    apply (frule_tac ko'=ko and x'=ptr in obj_relation_cut_same_type,
            (fastforce simp add: is_other_obj_relation_type t)+)
-   apply (erule disjE)
-    apply (simp add: is_other_obj_relation_type t)
-   apply (erule disjE)
-    apply (insert t, clarsimp simp: is_other_obj_relation_type_CapTable a_type_def)
-   apply (erule disjE)
-    apply (insert t, clarsimp simp: is_other_obj_relation_type_UserData a_type_def)
-   apply (erule disjE)
-    apply (insert t, clarsimp simp: is_other_obj_relation_type_DeviceData a_type_def)
-   apply (insert t, clarsimp simp: is_other_obj_relation_type_PageTable a_type_def)
-  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)
-  (* FIXME AARCH64: slow due to multiple (too many?) splits *)
-  apply (case_tac ob;
-         simp 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)+
-  done
+   apply (insert t)
+   apply ((erule disjE
+          | clarsimp simp: is_other_obj_relation_type is_other_obj_relation_type_def a_type_def)+)[1]
+  apply (extract_conjunct \<open>match conclusion in "ekheap_relation _ _" \<Rightarrow> -\<close>)
+   apply (simp only: ekheap_relation_def)
+   apply (rule ballI, drule(1) bspec)
+   apply (drule domD)
+   apply (insert e)
+   apply atomize
+   apply (clarsimp simp: obj_at'_def)
+   apply (erule_tac x=obj in allE)
+   apply (clarsimp simp: projectKO_eq project_inject)
+   apply (case_tac ob;
+          simp_all add: a_type_def other_obj_relation_def etcb_relation_def
+                        is_other_obj_relation_type t exst_same_def)[1]
+     apply (clarsimp simp: is_other_obj_relation_type t exst_same_def
+                    split: Structures_A.kernel_object.splits Structures_H.kernel_object.splits
+                           arch_kernel_obj.splits)+
+  \<comment> \<open>ready_queues_relation\<close>
+  apply (prop_tac "koTypeOf (injectKO ob') \<noteq> TCBT")
+   subgoal
+     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 map_to_ctes_upd_other
                       is_other_obj_relation_type_def
@@ -1117,13 +1204,14 @@ lemma typ_at'_valid_obj'_lift:
       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,
+            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 valid_bound_ntfn'_def
-              split: option.splits,
-           wpsimp)
+           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 wp
   done
@@ -1404,32 +1492,6 @@ lemma set_ep_bitmapQ_no_L2_orphans[wp]:
   apply (wp hoare_Ball_helper hoare_vcg_all_lift updateObject_default_inv | simp add: bitmapQ_def)+
   done
 
-lemma set_ep_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> setEndpoint epptr ep \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: Invariants_H.valid_queues_def)
-  apply (wp hoare_vcg_conj_lift)
-    apply (simp add: setEndpoint_def valid_queues_no_bitmap_def)
-    apply (wp hoare_Ball_helper hoare_vcg_all_lift)
-      apply (rule obj_at_setObject2)
-      apply (clarsimp simp: updateObject_default_def in_monad)
-     apply (wp updateObject_default_inv set_ep_valid_bitmapQ[unfolded setEndpoint_def]
-            | simp add: valid_queues_no_bitmap_def)+
-  done
-
-lemma set_ep_valid_queues'[wp]:
-  "\<lbrace>valid_queues'\<rbrace> setEndpoint epptr ep \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (unfold setEndpoint_def)
-  apply (simp only: valid_queues'_def imp_conv_disj
-                    obj_at'_real_def)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-    apply (rule setObject_ko_wp_at)
-      apply simp
-     apply (simp add: objBits_simps')
-    apply simp
-   apply (wp updateObject_default_inv | simp)+
-  apply (clarsimp simp: ko_wp_at'_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>"
@@ -1687,34 +1749,6 @@ lemma set_ntfn_bitmapQ_no_L2_orphans[wp]:
   apply (wp hoare_Ball_helper hoare_vcg_all_lift updateObject_default_inv | simp)+
   done
 
-lemma set_ntfn_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> setNotification p ntfn \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: Invariants_H.valid_queues_def)
-  apply (rule hoare_pre)
-   apply (wp hoare_vcg_conj_lift)
-    apply (simp add: setNotification_def valid_queues_no_bitmap_def)
-    apply (wp hoare_Ball_helper hoare_vcg_all_lift)
-      apply (rule obj_at_setObject2)
-      apply (clarsimp simp: updateObject_default_def in_monad)
-     apply (wp updateObject_default_inv set_ep_valid_bitmapQ[unfolded setEndpoint_def]
-            | simp add: valid_queues_no_bitmap_def)+
-  done
-
-lemma set_ntfn_valid_queues'[wp]:
-  "\<lbrace>valid_queues'\<rbrace> setNotification p ntfn \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (unfold setNotification_def)
-  apply (rule setObject_ntfn_pre)
-  apply (simp only: valid_queues'_def imp_conv_disj
-                    obj_at'_real_def)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-    apply (rule setObject_ko_wp_at)
-      apply simp
-     apply (simp add: objBits_simps')
-    apply simp
-   apply (wp updateObject_default_inv | simp)+
-  apply (clarsimp simp: ko_wp_at'_def)
-  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>
@@ -2127,6 +2161,21 @@ lemma setNotification_ct_idle_or_in_cur_domain'[wp]:
 crunch gsUntypedZeroRanges[wp]: setNotification "\<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>"
+  assumes nexts: "\<And>P. f \<lbrace>\<lambda>s. P (tcbSchedNexts_of s)\<rbrace>"
+  shows "f \<lbrace>sym_heap_sched_pointers\<rbrace>"
+  by (rule_tac f=tcbSchedPrevs_of in hoare_lift_Pf2; wpsimp wp: assms)
+
+crunches setNotification
+  for tcbSchedNexts_of[wp]: "\<lambda>s. P (tcbSchedNexts_of s)"
+  and tcbSchedPrevs_of[wp]: "\<lambda>s. P (tcbSchedPrevs_of s)"
+  and valid_sched_pointers[wp]: valid_sched_pointers
+  and ksReadyQueues[wp]: "\<lambda>s. P (ksReadyQueues s)"
+  and ksReadyQueuesL1Bitmap[wp]: "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
+  and ksReadyQueuesL2Bitmap[wp]: "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
+  (simp: updateObject_default_def)
+
 lemma set_ntfn_minor_invs':
   "\<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))
@@ -2136,9 +2185,10 @@ lemma set_ntfn_minor_invs':
          and (\<lambda>s. ptr \<noteq> ksIdleThread s) \<rbrace>
      setNotification ptr val
    \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (clarsimp simp add: invs'_def valid_state'_def cteCaps_of_def)
-  apply (wp irqs_masked_lift valid_irq_node_lift untyped_ranges_zero_lift,
-    simp_all add: o_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')+
@@ -2180,6 +2230,29 @@ lemma idle_is_global [intro!]:
   "ksIdleThread s \<in> global_refs' s"
   by (simp add: global_refs'_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 project_inject pspace_distinct'_def pspace_aligned'_def)
+  apply (drule bspec, erule domI)+
+  apply (clarsimp simp: objBits_simps' word_bits_def
+                 split: kernel_object.splits arch_kernel_object.splits)
+  done
+
+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
+
+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)
+
 lemma valid_globals_cte_wpD':
   "\<lbrakk> valid_global_refs' s; cte_wp_at' P p s \<rbrakk>
        \<Longrightarrow> \<exists>cte. P cte \<and> ksIdleThread s \<notin> capRange (cteCap cte)"
@@ -2223,19 +2296,17 @@ crunch typ_at'[wp]: doMachineOp "\<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>\<lambda>s. P (state_hyp_refs_of' s)\<rbrace>  doMachineOp m \<lbrace>\<lambda>rv s. P (state_hyp_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>"
-  by (simp add: doMachineOp_def split_def
-                valid_pspace'_def valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs
-       | wp cur_tcb_lift sch_act_wf_lift tcb_in_cur_domain'_lift
+  "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>\<lambda>s. P (state_hyp_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 obj_at'[wp]: doMachineOp "\<lambda>s. P (obj_at' P' p s)"
diff --git a/proof/refine/AARCH64/Refine.thy b/proof/refine/AARCH64/Refine.thy
index 3c6a30033a..798816a7ed 100644
--- a/proof/refine/AARCH64/Refine.thy
+++ b/proof/refine/AARCH64/Refine.thy
@@ -78,7 +78,7 @@ lemma typ_at_UserDataI:
   apply clarsimp
   apply (subst mask_lower_twice [where n = pageBits, OF pbfs_atleast_pageBits, symmetric])
   apply (clarsimp simp: obj_relation_cuts_def2 pte_relation_def
-                        cte_relation_def other_obj_relation_def
+                        cte_relation_def other_obj_relation_def tcb_relation_cut_def
               split: Structures_A.kernel_object.split_asm
                      Structures_H.kernel_object.split_asm
                      if_split_asm arch_kernel_obj.split_asm)
@@ -107,7 +107,7 @@ lemma typ_at_DeviceDataI:
   apply clarsimp
   apply (subst mask_lower_twice [where n = pageBits, OF pbfs_atleast_pageBits, symmetric])
   apply (clarsimp simp: obj_relation_cuts_def2 pte_relation_def
-                        cte_relation_def other_obj_relation_def
+                        cte_relation_def other_obj_relation_def tcb_relation_cut_def
               split: Structures_A.kernel_object.split_asm
                      Structures_H.kernel_object.split_asm
                      if_split_asm arch_kernel_obj.split_asm)
@@ -589,7 +589,7 @@ lemma kernel_corres':
            apply simp
            apply (rule handleInterrupt_corres[simplified dc_def])
           apply simp
-          apply (wp hoare_drop_imps hoare_vcg_all_lift)[1]
+          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>
@@ -668,7 +668,7 @@ lemma entry_corres:
     apply (rule corres_split[OF getCurThread_corres])
       apply (rule corres_split)
          apply simp
-         apply (rule threadset_corresT)
+         apply (rule threadset_corresT; simp?)
             apply (simp add: tcb_relation_def arch_tcb_relation_def
                              arch_tcb_context_set_def atcbContextSet_def)
            apply (clarsimp simp: tcb_cap_cases_def cteSizeBits_def)
diff --git a/proof/refine/AARCH64/Retype_R.thy b/proof/refine/AARCH64/Retype_R.thy
index a0e7b99a12..990910c38f 100644
--- a/proof/refine/AARCH64/Retype_R.thy
+++ b/proof/refine/AARCH64/Retype_R.thy
@@ -309,7 +309,7 @@ lemma state_relation_null_filterE:
      null_filter (caps_of_state t) = null_filter (caps_of_state s);
      null_filter' (ctes_of t') = null_filter' (ctes_of s');
      pspace_relation (kheap t) (ksPSpace t');
-     ekheap_relation (ekheap t) (ksPSpace t');
+     ekheap_relation (ekheap t) (ksPSpace t'); ready_queues_relation t t';
      ghost_relation (kheap t) (gsUserPages t') (gsCNodes t') (gsPTTypes (ksArchState t'));
      valid_list s;
      pspace_aligned' s'; pspace_distinct' s'; valid_objs s; valid_mdb s;
@@ -997,7 +997,7 @@ lemma retype_ekheap_relation:
      apply (intro impI conjI)
       apply clarsimp
       apply (drule_tac x=a in bspec,force)
-      apply (clarsimp simp add: other_obj_relation_def split: if_split_asm)
+      apply (clarsimp simp: tcb_relation_cut_def split: if_split_asm)
        apply (case_tac ko,simp_all)
        apply (clarsimp simp add: makeObjectKO_def cong: if_cong split: sum.splits Structures_H.kernel_object.splits
                                  arch_kernel_object.splits AARCH64_H.object_type.splits
@@ -1179,6 +1179,11 @@ lemma ksMachineState_update_gs[simp]:
   by (simp add: update_gs_def
          split: aobject_type.splits Structures_A.apiobject_type.splits)
 
+lemma ksReadyQueues_update_gs[simp]:
+  "ksReadyQueues (update_gs tp us addrs s) = ksReadyQueues s"
+  by (simp add: update_gs_def
+         split: aobject_type.splits Structures_A.apiobject_type.splits)
+
 lemma update_gs_ksMachineState_update_swap:
   "update_gs tp us addrs (ksMachineState_update f s) =
    ksMachineState_update f (update_gs tp us addrs s)"
@@ -1205,6 +1210,144 @@ lemma update_gs_simps[simp]:
       (\<lambda>as. gsPTTypes_update (\<lambda>pt_types x. if x \<in> ptrs then Some VSRootPT_T else pt_types x) as)"
   by (simp_all add: update_gs_def)
 
+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 -
+  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_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>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 (fastforce simp: ptr_add_def p_assoc_help)
+    done
+qed
+
+lemma retype_tcbSchedPrevs_of:
+  assumes   vs': "pspace_aligned' s'" "pspace_distinct' s'"
+  assumes   pn': "pspace_no_overlap' ptr sz s'"
+  assumes    ko: "makeObjectKO dev ty = Some ko"
+  assumes 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
+    "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 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
+           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_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
+    "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 -
+  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
+           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
+    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
+    by (cases ty;
+        fastforce simp  add: makeObjectKO_def makeObject_tcb
+           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"
@@ -1233,7 +1376,7 @@ lemma retype_state_relation:
           \<in> state_relation"
   (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)
+  proof (rule state_relation_null_filterE[OF sr refl _ _ _ _ _ _ _ _ vs'], simp_all add: trans_state_update[symmetric] del: trans_state_update)
 
   have cover':"range_cover ptr sz (objBitsKO ko) m"
     by (rule range_cover_rel[OF cover objBits_le_obj_bits_api[OF ko] num_r])
@@ -1472,6 +1615,16 @@ lemma retype_state_relation:
       apply fastforce
      apply (rule_tac x=id in exI, simp)+
     done
+
+  have rdyqrel: "ready_queues_relation s s'"
+    using sr by (simp add: state_relation_def)
+
+  thus "ready_queues_relation_2 (ready_queues s) (ksReadyQueues s')
+                                (?ps' |> tcb_of' |> tcbSchedNext) (?ps' |> tcb_of' |> tcbSchedPrev)
+                                (\<lambda>d p. inQ d p |< (?ps' |> tcb_of'))"
+    using retype_ready_queues_relation[OF _ vs' pn' ko cover num_r]
+    by (clarsimp simp: ready_queues_relation_def Let_def)
+
 qed
 
 lemma new_cap_addrs_fold':
@@ -2491,7 +2644,6 @@ 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 :: Structures_H.notification)
-             | Structures_A.TCBObject \<Rightarrow> ko = injectKO (makeObject :: tcb)
              | _ \<Rightarrow> False \<rbrakk> \<Longrightarrow>
     obj_relation_retype (default_object ty dev n) ko"
   apply (rule obj_relation_retype_other_obj)
@@ -2512,6 +2664,14 @@ lemma other_objs_default_relation:
                  split: Structures_A.apiobject_type.split_asm)
   done
 
+lemma tcb_relation_retype:
+  "obj_relation_retype (default_object Structures_A.TCBObject dev n) (KOTCB makeObject)"
+  by (clarsimp simp: tcb_relation_cut_def default_object_def obj_relation_retype_def
+                     tcb_relation_def default_tcb_def
+                     makeObject_tcb makeObject_cte new_context_def newContext_def newFPUState_def
+                     fault_rel_optionation_def initContext_def default_priority_def
+                     default_arch_tcb_def newArchTCB_def arch_tcb_relation_def objBits_simps')
+
 lemma captable_relation_retype:
   "n < word_bits \<Longrightarrow>
    obj_relation_retype (default_object Structures_A.CapTableObject dev n) (KOCTE makeObject)"
@@ -3189,10 +3349,10 @@ proof (intro conjI impI)
        apply (rule_tac ptr="x + xa" in cte_wp_at_tcbI', assumption+)
         apply fastforce
        apply simp
-      apply (rename_tac thread_state mcp priority bool option nat cptr vptr bound user_context)
-      apply (case_tac thread_state, simp_all add: valid_tcb_state'_def
-                                                  valid_bound_ntfn'_def obj_at_disj'
-                                           split: option.splits)[2]
+      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 (clarsimp simp add: valid_arch_tcb'_def typ_at_to_obj_at_arches obj_at_disj')
     apply (simp add: valid_cte'_def)
     apply (frule pspace_alignedD' [OF _ ad(1)])
@@ -3458,12 +3618,12 @@ lemma createNewCaps_cte_wp_at2:
    \<lbrace>\<lambda>rv s. P (cte_wp_at' P' p s)\<rbrace>"
   including classic_wp_pre
   apply (simp add: createNewCaps_def createObjects_def AARCH64_H.toAPIType_def
-           split del: if_split)
+              split del: if_split)
   apply (case_tac ty; simp add: createNewCaps_def createObjects_def Arch_createNewCaps_def
                            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)
+            apply (wp, simp add:createObjects_def)
            apply ((wp createObjects_orig_cte_wp_at2'[where sz = sz]
                      mapM_x_wp' threadSet_cte_wp_at2')+
                    | assumption
@@ -3925,16 +4085,6 @@ lemma sch_act_wf_lift_asm:
   apply auto
   done
 
-lemma valid_queues_lift_asm':
-  assumes tat: "\<And>d p t. \<lbrace>\<lambda>s. \<not> obj_at' (inQ d p) t s \<and> Q d p s\<rbrace> f \<lbrace>\<lambda>_ s. \<not> obj_at' (inQ d p) t s\<rbrace>"
-  and     prq: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueues s)\<rbrace>"
-  shows   "\<lbrace>\<lambda>s. valid_queues' s \<and> (\<forall>d p. Q d p s)\<rbrace> f \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp only: valid_queues'_def imp_conv_disj)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift
-            tat prq)
-  apply simp
-  done
-
 lemma createObjects'_ct[wp]:
   "\<lbrace>\<lambda>s. P (ksCurThread s)\<rbrace> createObjects' p n v us \<lbrace>\<lambda>rv s. P (ksCurThread s)\<rbrace>"
   by (rule createObjects_pspace_only, simp)
@@ -4240,34 +4390,146 @@ crunch irq_states' [wp]: createNewCaps valid_irq_states'
 crunch ksMachine[wp]: createObjects "\<lambda>s. P (ksMachineState s)"
   (simp: crunch_simps unless_def)
 
-lemma createNewCaps_valid_queues':
-  "\<lbrace>valid_queues' and pspace_no_overlap' ptr sz
-       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_queues'\<rbrace>"
-  apply (wp valid_queues_lift_asm' [OF createNewCaps_obj_at2])
-  apply (clarsimp)
-  apply (simp add: makeObjectKO_def
-            split: object_type.split_asm
-                   apiobject_type.split_asm)
-  apply (clarsimp simp: inQ_def)
-  apply (auto simp: makeObject_tcb
-             split: object_type.splits apiobject_type.splits)
-  done
-
-lemma createNewCaps_valid_queues:
-  "\<lbrace>valid_queues and pspace_no_overlap' ptr sz
-       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_queues\<rbrace>"
-  apply (rule hoare_gen_asm)
-  apply (wpsimp wp: valid_queues_lift_asm createNewCaps_obj_at2[where sz=sz])
-       apply (simp add: inQ_def)
-      apply (wp createNewCaps_pred_tcb_at'[where sz=sz] | simp)+
+lemma createObjects_valid_bitmaps:
+  "createObjects' ptr n val gbits \<lbrace>valid_bitmaps\<rbrace>"
+  apply (clarsimp simp: createObjects'_def alignError_def split_def)
+  apply (wp case_option_wp[where P="\<lambda>_. P" and P'=P for P, simplified] assert_inv
+         | clarsimp simp del: fun_upd_apply)+
+  apply (clarsimp simp: valid_bitmaps_def valid_bitmapQ_def bitmapQ_def bitmapQ_no_L2_orphans_def
+                        bitmapQ_no_L1_orphans_def)
+  done
+
+lemma valid_bitmaps_gsCNodes_update[simp]:
+  "valid_bitmaps (gsCNodes_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
+
+lemma valid_bitmaps_gsUserPages_update[simp]:
+  "valid_bitmaps (gsUserPages_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
+
+crunches curDomain
+  for valid_bitmaps[wp]: valid_bitmaps
+  and sched_pointers[wp]: "\<lambda>s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)"
+  and valid_sched_pointers[wp]: valid_sched_pointers
+
+lemma createNewCaps_valid_bitmaps:
+  "\<lbrace>\<lambda>s. valid_pspace' s \<and> pspace_no_overlap' ptr sz s \<and> valid_bitmaps s\<rbrace>
+   createNewCaps ty ptr n us dev
+   \<lbrace>\<lambda>_. valid_bitmaps\<rbrace>"
+  unfolding createNewCaps_def
+  apply (clarsimp simp: 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 (wpsimp wp: createObjects_valid_bitmaps)
+           by (wpsimp wp: createObjects_valid_bitmaps[simplified o_def] mapM_x_wp
+               | simp add: makeObject_tcb objBits_def createObjects_def
+               | intro conjI impI)+
+
+lemma createObjects_sched_queues:
+  "\<lbrace>\<lambda>s. n \<noteq> 0
+        \<and> range_cover ptr sz (objBitsKO val + gbits) n
+        \<and> P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)
+        \<and> (case val of KOTCB tcb \<Rightarrow> tcbSchedNext tcb = None \<and> tcbSchedPrev tcb = None
+                     | _ \<Rightarrow> True)
+        \<and> pspace_aligned' s \<and> pspace_distinct' s
+        \<and> pspace_no_overlap' ptr sz s\<rbrace>
+   createObjects' ptr n val gbits
+   \<lbrace>\<lambda>_ s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)\<rbrace>"
+  (is "\<lbrace> \<lambda>s. _ \<and> _ \<and> ?Pre s \<rbrace> _ \<lbrace>\<lambda>_. _\<rbrace>")
+proof (rule hoare_grab_asm)+
+  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>_ s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)\<rbrace>"
+  proof -
+    have shiftr_not_zero:" 1 \<le> ((of_nat n)::machine_word) << gbits"
+      using range_cover_not_zero_shift[OF not_0 cover,where gbits = gbits]
+      by (simp add:word_le_sub1)
+    show ?thesis
+      apply (clarsimp simp: createObjects'_def unless_def alignError_def split_def)
+      apply (wp | clarsimp simp del: fun_upd_apply)+
+      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 (clarsimp simp: foldr_upd_app_if)
+      apply (rule_tac a="tcbSchedNexts_of s" and b="tcbSchedPrevs_of s"
+                   in rsubst2[rotated, OF sym sym, where P=P])
+        apply (rule ext)
+        apply (clarsimp simp: opt_map_def)
+        apply (frule (3) retype_ksPSpace_None[simplified mult.commute])
+          apply (fastforce intro: cover)
+         apply fastforce
+        apply (clarsimp split: kernel_object.splits option.splits)
+       apply (rule ext)
+       apply (clarsimp simp: opt_map_def)
+       apply (frule (3) retype_ksPSpace_None[simplified mult.commute])
+         apply (fastforce intro: cover)
+        apply fastforce
+       apply (clarsimp split: kernel_object.splits option.splits)
+      apply simp
+      done
+  qed
+qed
+
+lemma createNewCaps_sched_queues:
+  assumes cover: "range_cover ptr sz (APIType_capBits ty us) n"
+  assumes not_0: "n \<noteq> 0"
+  shows
+    "\<lbrace>\<lambda>s. valid_pspace' s \<and> pspace_no_overlap' ptr sz s
+          \<and> P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)\<rbrace>
+     createNewCaps ty ptr n us dev
+     \<lbrace>\<lambda>_ s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)\<rbrace>"
+  unfolding createNewCaps_def
+  apply (clarsimp simp: AARCH64_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 (wp, simp)
+           apply (insert cover not_0)
+           apply (wpsimp wp: mapM_x_wp' createObjects_sched_queues threadSet_sched_pointers
+                         simp: curDomain_def createObjects_def)
+           apply (simp add: valid_pspace'_def objBits_simps APIType_capBits_def makeObject_tcb)
+          by (wpsimp wp: mapM_x_wp' createObjects_sched_queues threadSet_sched_pointers
+                     simp: createObjects_def valid_pspace'_def objBits_simps APIType_capBits_def
+                     split_del: if_split,
+              fastforce simp add: mult_2 add_ac)+
+
+lemma createObjects_valid_sched_pointers:
+  "\<lbrace>\<lambda>s. valid_sched_pointers s
+        \<and> (case val of KOTCB tcb \<Rightarrow> tcbSchedNext tcb = None \<and> tcbSchedPrev tcb = None
+                     | _ \<Rightarrow> True)\<rbrace>
+   createObjects' ptr n val gbits
+   \<lbrace>\<lambda>_. valid_sched_pointers\<rbrace>"
+  apply (clarsimp simp: createObjects'_def unless_def alignError_def split_def)
+  apply (wp case_option_wp[where P="\<lambda>_. P" and P'=P for P, simplified] assert_inv
+         | clarsimp simp del: fun_upd_apply)+
+  apply (clarsimp simp: valid_sched_pointers_def foldr_upd_app_if opt_pred_def opt_map_def comp_def)
+  apply (cases "tcb_of' val"; clarsimp)
   done
 
+lemma createNewCaps_valid_sched_pointers:
+  "\<lbrace>\<lambda>s. valid_pspace' s \<and> pspace_no_overlap' ptr sz s \<and> valid_sched_pointers s\<rbrace>
+   createNewCaps ty ptr n us dev
+   \<lbrace>\<lambda>_. valid_sched_pointers\<rbrace>"
+  unfolding createNewCaps_def
+  apply (clarsimp simp: 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 (wpsimp wp: createObjects_valid_sched_pointers)
+           by (wpsimp wp: createObjects_valid_sched_pointers[simplified o_def] mapM_x_wp
+                          threadSet_valid_sched_pointers
+               | simp add: makeObject_tcb objBits_def createObjects_def
+               | intro conjI impI)+
+
 lemma mapM_x_threadSet_valid_pspace:
   "\<lbrace>valid_pspace' and K (curdom \<le> maxDomain)\<rbrace>
       mapM_x (threadSet (tcbDomain_update (\<lambda>_. curdom))) addrs \<lbrace>\<lambda>y. valid_pspace'\<rbrace>"
@@ -4635,12 +4897,13 @@ proof (rule hoare_gen_asm, elim conjE)
                createNewCaps_valid_arch_state
                valid_irq_node_lift_asm [unfolded pred_conj_def, OF _ createNewCaps_obj_at']
                createNewCaps_irq_handlers' createNewCaps_vms
-               createNewCaps_valid_queues
-               createNewCaps_valid_queues'
                createNewCaps_pred_tcb_at' cnc_ct_not_inQ
                createNewCaps_ct_idle_or_in_cur_domain'
                createNewCaps_sch_act_wf
                createNewCaps_urz[where sz=sz]
+               createNewCaps_sched_queues[OF cover not_0]
+               createNewCaps_valid_sched_pointers
+               createNewCaps_valid_bitmaps
            | simp)+
   using not_0
   apply (clarsimp simp: valid_pspace'_def)
@@ -4713,35 +4976,6 @@ lemma createObjects_sch:
   apply (wp sch_act_wf_lift_asm createObjects_pred_tcb_at' createObjects_orig_obj_at3 | force)+
   done
 
-lemma createObjects_queues:
-  "\<lbrace>\<lambda>s. valid_queues 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. valid_queues\<rbrace>"
-  apply (wpsimp wp: valid_queues_lift_asm [unfolded pred_conj_def, OF createObjects_orig_obj_at3]
-                    createObjects_pred_tcb_at' [unfolded pred_conj_def])
-      apply fastforce
-     apply wp+
-  apply fastforce
-  done
-
-lemma createObjects_queues':
-  assumes no_tcb: "\<And>t. projectKO_opt val \<noteq> Some (t::tcb)"
-  shows
-  "\<lbrace>\<lambda>s. valid_queues' 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. valid_queues'\<rbrace>"
-  apply (simp add: createObjects_def)
-  apply (wp valid_queues_lift_asm')
-    apply (wp createObjects_orig_obj_at2')
-    apply clarsimp
-    apply assumption
-   apply wp
-  using no_tcb
-  apply fastforce
-  done
-
 lemma createObjects_no_cte_ifunsafe':
   assumes no_cte: "\<And>c. projectKO_opt val \<noteq> Some (c::cte)"
   assumes no_tcb: "\<And>t. projectKO_opt val \<noteq> Some (t::tcb)"
@@ -4972,50 +5206,61 @@ proof -
     apply (rule hoare_weaken_pre)
      apply (wps createObjects_ct)
      apply (wp createObjects_obj_at_other)
-      apply (simp)+
+     apply (simp)+
     done
   show ?thesis
-  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 createObjects_queues)
-   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_state_hyp_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'
-             createObjects_queues' [OF no_tcb]
-             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'
-             createObjects_queues' [OF no_tcb] 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
-  using no_cte no_tcb
-  apply ((intro conjI; assumption?); simp add: valid_pspace'_def objBits_def)
-  apply (fastforce simp add: split_def split: option.splits)
-  apply (clarsimp simp: invs'_def no_tcb valid_state'_def no_cte  split: option.splits)
-  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_state_hyp_refs_of'')
+      apply (rule hoare_vcg_conj_lift)
+       apply (simp add: createObjects_def)
+       apply (wp createObjects_iflive')
+      apply (wp createObjects_no_cte_ifunsafe' assms)
+      apply (rule hoare_vcg_conj_lift)
+       apply (simp add: createObjects_def)
+       apply (wp createObjects_idle')
+      apply (wpsimp wp: irqs_masked_lift createObjects_no_cte_valid_global
+                        createObjects_valid_arch createObjects_irq_state
+                        createObjects_no_cte_irq_handlers assms)
+      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 (wp createObjects_idle')
+       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'
+                createObjects_pspace_domain_valid co_ct_not_inQ
+                createObjects_ct_idle_or_in_cur_domain'
+                createObjects_untyped_ranges_zero'[OF moKO]
+                assms
+                createObjects_sched_queues
+             | simp)+
+    using no_cte no_tcb
+    apply (clarsimp simp: valid_pspace'_def)
+    apply (extract_conjunct \<open>match conclusion in "pspace_no_overlap' ptr ?x _" \<Rightarrow> -\<close>, assumption)+
+    apply (extract_conjunct \<open>match conclusion in "range_cover ptr ?x ?y _" \<Rightarrow> -\<close>, assumption)
+    apply simp
+    apply (rule conjI, fastforce simp add: split_def split: option.splits)
+    by (auto simp: invs'_def no_tcb valid_state'_def no_cte
+             split: option.splits kernel_object.splits)
 qed
 
 lemma corres_retype_update_gsI:
@@ -5051,7 +5296,7 @@ lemma gcd_corres: "corres (=) \<top> \<top> (gets cur_domain) curDomain"
 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. 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
@@ -5062,7 +5307,7 @@ lemma retype_region2_extra_ext_mapM_x_corres:
     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. tcb_at' t 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)
@@ -5070,8 +5315,10 @@ lemma retype_region2_extra_ext_mapM_x_corres:
             apply (case_tac tcb')
             apply simp
            apply fastforce
-          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
@@ -5104,10 +5351,11 @@ lemma retype_region2_obj_at:
   apply (auto simp: obj_at_def default_object_def is_tcb_def)
   done
 
-lemma createObjects_tcb_at':
+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\<rbrace>
-   createObjects ptr n (KOTCB makeObject) 0 \<lbrace>\<lambda>ptrs s. \<forall>addr\<in>set ptrs. tcb_at' addr 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 project_inject objBitsKO_def objBits_def makeObject_tcb)
   done
@@ -5172,8 +5420,9 @@ lemma corres_retype_region_createNewCaps:
                 apply (rule corres_retype[where 'a = tcb],
                        simp_all add: obj_bits_api_def objBits_simps' pageBits_def
                                      APIType_map2_def makeObjectKO_def
-                                     other_objs_default_relation)[1]
+                                     tcb_relation_retype)[1]
                 apply (fastforce simp: range_cover_def)
+               apply (simp add: tcb_relation_retype)
                apply (rule corres_split_nor)
                   apply (simp add: APIType_map2_def)
                   apply (rule retype_region2_extra_ext_mapM_x_corres)
@@ -5183,7 +5432,7 @@ lemma corres_retype_region_createNewCaps:
                 apply wp
                apply wp
               apply ((wp retype_region2_obj_at | simp add: APIType_map2_def)+)[1]
-             apply ((wp createObjects_tcb_at'[where sz=sz]
+             apply ((wp createObjects_Not_tcbQueued[where sz=sz]
                      | simp add: APIType_map2_def objBits_simps' obj_bits_api_def)+)[1]
             apply simp
            apply simp
diff --git a/proof/refine/AARCH64/Schedule_R.thy b/proof/refine/AARCH64/Schedule_R.thy
index b8e0b34b28..8be19706b7 100644
--- a/proof/refine/AARCH64/Schedule_R.thy
+++ b/proof/refine/AARCH64/Schedule_R.thy
@@ -16,11 +16,6 @@ declare hoare_weak_lift_imp[wp_split del]
 (* Levity: added (20090713 10:04:12) *)
 declare sts_rel_idle [simp]
 
-lemma invs_no_cicd'_queues:
-  "invs_no_cicd' s \<Longrightarrow> valid_queues s"
-  unfolding invs_no_cicd'_def
-  by simp
-
 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)"
@@ -131,7 +126,7 @@ lemma ko_tcb_cross:
   apply normalise_obj_at'
   apply (clarsimp simp: state_relation_def pspace_relation_def obj_at_def)
   apply (drule bspec, fastforce)
-  apply (clarsimp simp: other_obj_relation_def obj_at'_def)
+  apply (clarsimp simp: tcb_relation_cut_def obj_at'_def)
   done
 
 (* FIXME AARCH64: move *)
@@ -195,275 +190,259 @@ lemma schedule_choose_new_thread_sched_act_rct[wp]:
   unfolding schedule_choose_new_thread_def
   by wp
 
+\<comment> \<open>This proof shares many similarities with the proof of @{thm tcbSchedEnqueue_corres}\<close>
 lemma tcbSchedAppend_corres:
-  notes trans_state_update'[symmetric, simp del]
-  shows
-  "corres dc (is_etcb_at t and tcb_at t and pspace_aligned and pspace_distinct)
-             (Invariants_H.valid_queues and valid_queues')
-             (tcb_sched_action (tcb_sched_append) t) (tcbSchedAppend t)"
-  apply (rule corres_cross_over_guard[where P'=Q and Q="tcb_at' t and Q" for Q])
-   apply (fastforce simp: tcb_at_cross state_relation_def)
-  apply (simp only: tcbSchedAppend_def tcb_sched_action_def)
-  apply (rule corres_symb_exec_r [OF _ _ threadGet_inv, 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, simp)
-   apply (rule no_fail_pre, wp, simp)
-  apply (case_tac queued)
-   apply (simp add: unless_def when_def)
-   apply (rule corres_no_failI)
-    apply wp+
-   apply (clarsimp simp: in_monad ethread_get_def gets_the_def bind_assoc
-                         assert_opt_def exec_gets is_etcb_at_def get_etcb_def get_tcb_queue_def
-                         set_tcb_queue_def simpler_modify_def)
-
-   apply (subgoal_tac "tcb_sched_append t (ready_queues a (tcb_domain y) (tcb_priority y))
-                       = (ready_queues a (tcb_domain y) (tcb_priority y))")
-    apply (simp add: state_relation_def ready_queues_relation_def)
-   apply (clarsimp simp: tcb_sched_append_def state_relation_def
-                         valid_queues'_def ready_queues_relation_def
-                         ekheap_relation_def etcb_relation_def
-                         obj_at'_def inQ_def project_inject)
-   apply (drule_tac x=t in bspec,clarsimp)
+  "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_append tcb_ptr) (tcbSchedAppend 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_append_def get_tcb_queue_def
+                        tcbSchedAppend_def getQueue_def unless_def when_def)
+  apply (rule corres_symb_exec_l[OF _ _ ethread_get_sp]; (solves wpsimp)?)
+  apply (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]; 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)
+   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 (clarsimp simp: unless_def when_def cong: if_cong)
-  apply (rule stronger_corres_guard_imp)
-    apply (rule corres_split[where r'="(=)"])
-       apply (rule ethreadget_corres)
-       apply (simp add: etcb_relation_def)
-      apply (rule corres_split[where r'="(=)"])
-         apply (rule ethreadget_corres)
-         apply (simp add: etcb_relation_def)
-        apply (rule corres_split[where r'="(=)"])
-           apply simp
-           apply (rule getQueue_corres)
-          apply (rule corres_split_noop_rhs2)
-             apply (simp add: tcb_sched_append_def)
-             apply (intro conjI impI)
-              apply (rule corres_guard_imp)
-                apply (rule setQueue_corres)
-               prefer 3
-               apply (rule_tac P=\<top> and Q="K (t \<notin> set queuea)" in corres_assume_pre)
-               apply simp
-              apply simp
-             apply simp
-            apply (rule corres_split_noop_rhs2)
-               apply (rule addToBitmap_if_null_noop_corres)
-              apply (rule threadSet_corres_noop, simp_all add: tcb_relation_def exst_same_def)[1]
-             apply wp+
-          apply (wp getObject_tcb_wp | simp add: threadGet_def)+
-  apply (fastforce simp: valid_queues_def valid_queues_no_bitmap_def obj_at'_def inQ_def
-                         project_inject)
-  done
+  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)?)
 
+  \<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'])
 
-crunches tcbSchedEnqueue, tcbSchedAppend, tcbSchedDequeue
-  for valid_pspace'[wp]: valid_pspace'
-  and valid_arch_state'[wp]: valid_arch_state'
-  (simp: unless_def)
+     apply wpsimp
+    apply (wpsimp wp: hoare_vcg_if_lift hoare_vcg_ex_lift)
+   apply (corres corres: addToBitmap_if_null_noop_corres)
+
+  apply (rule corres_from_valid_det)
+    apply (fastforce intro: det_wp_modify det_wp_pre simp: set_tcb_queue_def)
+   apply (wpsimp simp: tcbQueueAppend_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'_tcbQueueEnd_ksReadyQueues simp: obj_at'_def)
+
+  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 simp: setQueue_def tcbQueueAppend_def)
+  apply normalise_obj_at'
+  apply (frule (1) tcb_at_is_etcb_at)
+  apply (clarsimp simp: obj_at_def is_etcb_at_def etcb_at_def)
+  apply (rename_tac s d p s' tcb' tcb etcb)
+  apply (frule_tac t=tcbPtr in ekheap_relation_tcb_domain_priority)
+    apply (force simp: obj_at_def)
+   apply (force simp: obj_at'_def)
+  apply (clarsimp split: if_splits)
+  apply (cut_tac ts="ready_queues s d p" in list_queue_relation_nil)
+   apply (force dest!: spec simp: list_queue_relation_def)
+  apply (cut_tac ts="ready_queues s (tcb_domain etcb) (tcb_priority etcb)"
+              in obj_at'_tcbQueueEnd_ksReadyQueues)
+      apply fast
+     apply fast
+    apply fastforce
+   apply fastforce
+  apply (cut_tac xs="ready_queues s d p" in heap_path_head')
+   apply (force dest!: spec simp: list_queue_relation_def)
+  apply (clarsimp simp: list_queue_relation_def)
+
+  apply (case_tac "d \<noteq> tcb_domain etcb \<or> p \<noteq> tcb_priority etcb")
+   apply (cut_tac d=d and d'="tcb_domain etcb" and p=p and p'="tcb_priority etcb"
+               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)
+    apply (metis inQ_def option.simps(5) tcb_of'_TCB)
+   apply (intro conjI impI; clarsimp)
+
+    \<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 (tcbQueueEnd (ksReadyQueues s' (tcb_domain etcb, tcb_priority etcb)))
+                    \<notin> set (ready_queues s d p)")
+    apply (erule orthD2)
+    apply (drule_tac x="tcb_domain etcb" in spec)
+    apply (drule_tac x="tcb_priority etcb" in spec)
+    apply clarsimp
+    apply (drule_tac x="the (tcbQueueEnd (ksReadyQueues s' (tcb_domain etcb, tcb_priority etcb)))"
+                 in spec)
+    subgoal by (auto simp: in_opt_pred opt_map_red)
+   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";
+              clarsimp 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 split: if_splits)
+     apply (case_tac "t = the (tcbQueueEnd (ksReadyQueues s' (tcb_domain etcb, tcb_priority etcb)))")
+      apply (clarsimp simp: inQ_def opt_pred_def fun_upd_apply)
+     apply (clarsimp simp: inQ_def in_opt_pred opt_map_def fun_upd_apply)
+    apply (clarsimp simp: fun_upd_apply split: if_splits)
+   apply (clarsimp simp: fun_upd_apply split: if_splits)
+
+  \<comment> \<open>d = tcb_domain tcb \<and> p = tcb_priority tcb\<close>
+  apply clarsimp
+  apply (drule_tac x="tcb_domain etcb" in spec)
+  apply (drule_tac x="tcb_priority etcb" in spec)
+  apply (cut_tac ts="ready_queues s (tcb_domain etcb) (tcb_priority etcb)"
+              in tcbQueueHead_iff_tcbQueueEnd)
+   apply (force simp: list_queue_relation_def)
+  apply (frule valid_tcbs'_maxDomain[where t=tcbPtr], simp add: obj_at'_def)
+  apply (frule valid_tcbs'_maxPriority[where t=tcbPtr], simp add: obj_at'_def)
+  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)
+  apply (intro conjI; clarsimp)
+
+   \<comment> \<open>the ready queue was originally empty\<close>
+   apply (force simp: inQ_def in_opt_pred fun_upd_apply opt_map_def obj_at'_def
+                      queue_end_valid_def prev_queue_head_def
+               split: if_splits option.splits)
+
+   \<comment> \<open>the ready queue was not originally empty\<close>
+  apply (drule (2) heap_ls_append[where new=tcbPtr])
+  apply (rule conjI)
+   apply (clarsimp simp: fun_upd_apply queue_end_valid_def opt_map_def split: if_splits)
+  apply (rule conjI)
+   apply (clarsimp simp: fun_upd_apply queue_end_valid_def)
+  apply (rule conjI)
+   apply (subst opt_map_upd_triv)
+    apply (clarsimp simp: opt_map_def fun_upd_apply queue_end_valid_def split: if_splits)
+   apply (clarsimp simp: prev_queue_head_def fun_upd_apply split: if_splits)
+  by (clarsimp simp: inQ_def in_opt_pred fun_upd_apply queue_end_valid_def split: if_splits)
+
+lemma tcbQueueAppend_valid_objs'[wp]:
+  "\<lbrace>\<lambda>s. valid_objs' s \<and> tcb_at' tcbPtr s \<and> (\<forall>end. tcbQueueEnd queue = Some end \<longrightarrow> tcb_at' end s)\<rbrace>
+   tcbQueueAppend queue tcbPtr
+   \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
+  unfolding tcbQueueAppend_def
+  apply (wpsimp wp: hoare_vcg_if_lift2 hoare_vcg_imp_lift')
+  apply (clarsimp simp: tcbQueueEmpty_def valid_bound_tcb'_def split: option.splits)
+  done
+
+lemma tcbSchedAppend_valid_objs'[wp]:
+  "\<lbrace>valid_objs' and pspace_aligned' and pspace_distinct'\<rbrace>
+   tcbSchedAppend tcbPtr
+   \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
+  apply (clarsimp simp: tcbSchedAppend_def setQueue_def)
+  apply (wpsimp wp: threadSet_valid_objs' threadGet_wp hoare_vcg_all_lift)
+  apply (normalise_obj_at', rename_tac tcb "end")
+  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
+  apply (frule tcbQueueHead_iff_tcbQueueEnd)
+  apply (force dest!: obj_at'_tcbQueueEnd_ksReadyQueues simp: tcbQueueEmpty_def obj_at'_def)
+  done
 
 crunches tcbSchedAppend, tcbSchedDequeue
   for pred_tcb_at'[wp]: "pred_tcb_at' proj P t"
   (wp: threadSet_pred_tcb_no_state simp: unless_def tcb_to_itcb'_def)
 
-lemma removeFromBitmap_valid_queues_no_bitmap_except[wp]:
-  "\<lbrace> valid_queues_no_bitmap_except t \<rbrace>
-   removeFromBitmap d p
-   \<lbrace>\<lambda>_. valid_queues_no_bitmap_except t \<rbrace>"
-  unfolding bitmapQ_defs valid_queues_no_bitmap_except_def
-  by (wp| clarsimp simp: bitmap_fun_defs)+
-
-lemma removeFromBitmap_bitmapQ:
-  "\<lbrace> \<lambda>s. True \<rbrace> removeFromBitmap d p \<lbrace>\<lambda>_ s. \<not> bitmapQ d p s \<rbrace>"
-  unfolding bitmapQ_defs bitmap_fun_defs
-  by (wp| clarsimp simp: bitmap_fun_defs)+
-
-lemma removeFromBitmap_valid_bitmapQ[wp]:
-" \<lbrace> valid_bitmapQ_except d p and bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans and
-    (\<lambda>s. ksReadyQueues s (d,p) = []) \<rbrace>
-     removeFromBitmap d p
-  \<lbrace>\<lambda>_. valid_bitmapQ \<rbrace>"
-proof -
-  have "\<lbrace> valid_bitmapQ_except d p and bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans and
-            (\<lambda>s. ksReadyQueues s (d,p) = []) \<rbrace>
-         removeFromBitmap d p
-         \<lbrace>\<lambda>_. valid_bitmapQ_except d p and  bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans and
-              (\<lambda>s. \<not> bitmapQ d p s \<and> ksReadyQueues s (d,p) = []) \<rbrace>"
-    by (rule hoare_pre)
-       (wp removeFromBitmap_valid_queues_no_bitmap_except removeFromBitmap_valid_bitmapQ_except
-           removeFromBitmap_bitmapQ, simp)
-  thus ?thesis
-    by - (erule hoare_strengthen_post; fastforce elim: valid_bitmap_valid_bitmapQ_exceptE)
-qed
-
-(* this should be the actual weakest precondition to establish valid_queues
-   under tagging a thread as not queued *)
-lemma threadSet_valid_queues_dequeue_wp:
- "\<lbrace> valid_queues_no_bitmap_except t and
-        valid_bitmapQ and bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans and
-        (\<lambda>s. \<forall>d p. t \<notin> set (ksReadyQueues s (d,p))) \<rbrace>
-          threadSet (tcbQueued_update (\<lambda>_. False)) t
-       \<lbrace>\<lambda>rv. valid_queues \<rbrace>"
-  unfolding threadSet_def
-  apply (rule hoare_seq_ext[OF _ getObject_tcb_sp])
-  apply (rule hoare_pre)
-   apply (simp add: valid_queues_def valid_queues_no_bitmap_except_def valid_queues_no_bitmap_def)
-   apply (wp setObject_queues_unchanged_tcb hoare_Ball_helper hoare_vcg_all_lift
-             setObject_tcb_strongest)
-  apply (clarsimp simp: valid_queues_no_bitmap_except_def obj_at'_def valid_queues_no_bitmap_def)
-  done
-
 (* FIXME move *)
 lemmas obj_at'_conjI = obj_at_conj'
 
-lemma setQueue_valid_queues_no_bitmap_except_dequeue_wp:
-  "\<And>d p ts t.
-   \<lbrace> \<lambda>s. valid_queues_no_bitmap_except t s \<and>
-         (\<forall>t' \<in> set ts. obj_at' (inQ d p and runnable' \<circ> tcbState) t' s) \<and>
-         t \<notin> set ts \<and> distinct ts \<and> p \<le> maxPriority \<and> d \<le> maxDomain \<rbrace>
-       setQueue d p ts
-   \<lbrace>\<lambda>rv. valid_queues_no_bitmap_except t \<rbrace>"
-  unfolding setQueue_def valid_queues_no_bitmap_except_def null_def
-  by wp force
-
-definition (* if t is in a queue, it should be tagged with right priority and domain *)
-  "correct_queue t s \<equiv> \<forall>d p. t \<in> set(ksReadyQueues s (d, p)) \<longrightarrow>
-             (obj_at' (\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d \<and> tcbPriority tcb = p) t s)"
-
-lemma valid_queues_no_bitmap_correct_queueI[intro]:
-  "valid_queues_no_bitmap s \<Longrightarrow> correct_queue t s"
-  unfolding correct_queue_def valid_queues_no_bitmap_def
-  by (fastforce simp: obj_at'_def inQ_def)
-
-
-lemma tcbSchedDequeue_valid_queues_weak:
-  "\<lbrace> valid_queues_no_bitmap_except t and valid_bitmapQ and
-     bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans and
-     correct_queue t and
-     obj_at' (\<lambda>tcb. tcbDomain tcb \<le> maxDomain \<and> tcbPriority tcb \<le> maxPriority) t \<rbrace>
-   tcbSchedDequeue t
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-proof -
-  show ?thesis
-  unfolding tcbSchedDequeue_def null_def valid_queues_def
-  apply wp (* stops on threadSet *)
-          apply (rule hoare_post_eq[OF _ threadSet_valid_queues_dequeue_wp],
-                 simp add: valid_queues_def)
-         apply (wp hoare_vcg_if_lift hoare_vcg_conj_lift hoare_vcg_imp_lift)+
-             apply (wp hoare_vcg_imp_lift setQueue_valid_queues_no_bitmap_except_dequeue_wp
-                       setQueue_valid_bitmapQ threadGet_const_tcb_at hoare_vcg_if_lift)+
-  (* wp done *)
-  apply (normalise_obj_at')
-  apply (clarsimp simp: correct_queue_def)
-  apply (normalise_obj_at')
-  apply (fastforce simp add: valid_queues_no_bitmap_except_def valid_queues_no_bitmap_def elim: obj_at'_weaken)+
-  done
-qed
-
-lemma tcbSchedDequeue_valid_queues:
-  "\<lbrace>Invariants_H.valid_queues
-    and obj_at' (\<lambda>tcb. tcbDomain tcb \<le> maxDomain) t
-    and obj_at' (\<lambda>tcb. tcbPriority tcb \<le> maxPriority) t\<rbrace>
-     tcbSchedDequeue t
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (rule hoare_pre, rule tcbSchedDequeue_valid_queues_weak)
-  apply (fastforce simp: valid_queues_def valid_queues_no_bitmap_def obj_at'_def inQ_def)
-  done
-
-lemma tcbSchedAppend_valid_queues'[wp]:
-  (* most of this is identical to tcbSchedEnqueue_valid_queues' in TcbAcc_R *)
-  "\<lbrace>valid_queues' and tcb_at' t\<rbrace> tcbSchedAppend t \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp add: tcbSchedAppend_def)
-  apply (rule hoare_pre)
-   apply (rule_tac B="\<lambda>rv. valid_queues' and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"
-           in hoare_seq_ext)
-    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 inQ_def)
-       apply (wp setQueue_valid_queues' | simp | simp add: setQueue_def)+
-     apply (wp getObject_tcb_wp | simp add: threadGet_def)+
-     apply (clarsimp simp: obj_at'_def inQ_def valid_queues'_def)
-    apply (wp getObject_tcb_wp | simp add: threadGet_def)+
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-lemma threadSet_valid_queues'_dequeue: (* threadSet_valid_queues' is too weak for dequeue *)
-  "\<lbrace>\<lambda>s. (\<forall>d p t'. obj_at' (inQ d p) t' s \<and> t' \<noteq> t \<longrightarrow> t' \<in> set (ksReadyQueues s (d, p))) \<and>
-        obj_at' (inQ d p) t s \<rbrace>
-   threadSet (tcbQueued_update (\<lambda>_. False)) t
-   \<lbrace>\<lambda>rv. valid_queues' \<rbrace>"
-   unfolding valid_queues'_def
-   apply (rule hoare_pre)
-    apply (wp hoare_vcg_all_lift)
-    apply (simp only: imp_conv_disj not_obj_at')
-   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-   apply (simp add: not_obj_at')
-   apply (clarsimp simp: typ_at_tcb')
-   apply normalise_obj_at'
-   apply (fastforce elim: obj_at'_weaken simp: inQ_def)
-   done
-
-lemma setQueue_ksReadyQueues_lift:
-  "\<lbrace> \<lambda>s. P (s\<lparr>ksReadyQueues := (ksReadyQueues s)((d, p) := ts)\<rparr>) ts \<rbrace>
-   setQueue d p ts
-   \<lbrace> \<lambda>_ s. P s (ksReadyQueues s (d,p))\<rbrace>"
-  unfolding setQueue_def
-  by (wp, clarsimp simp: fun_upd_def cong: if_cong)
-
-lemma tcbSchedDequeue_valid_queues'[wp]:
-  "\<lbrace>valid_queues' and tcb_at' t\<rbrace>
-    tcbSchedDequeue t \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  unfolding tcbSchedDequeue_def
-  apply (rule_tac B="\<lambda>rv. valid_queues' and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"
-                in hoare_seq_ext)
-   prefer 2
-   apply (wp threadGet_const_tcb_at)
-   apply (fastforce simp: obj_at'_def)
-  apply clarsimp
-  apply (rename_tac queued)
-  apply (case_tac queued, simp_all)
-   apply wp
-        apply (rule_tac d=tdom and p=prio in threadSet_valid_queues'_dequeue)
-       apply (rule hoare_pre_post, assumption)
-       apply (wp | clarsimp simp: bitmap_fun_defs)+
-      apply (wp hoare_vcg_all_lift setQueue_ksReadyQueues_lift)
-     apply clarsimp
-     apply (wp threadGet_obj_at' threadGet_const_tcb_at)+
-   apply clarsimp
-   apply (rule context_conjI, clarsimp simp: obj_at'_def)
-   apply (clarsimp simp: valid_queues'_def obj_at'_def inQ_def|wp)+
-  done
+crunches tcbSchedAppend, tcbSchedDequeue, tcbSchedEnqueue
+  for tcb_at'[wp]: "tcb_at' t"
+  and cap_to'[wp]: "ex_nonz_cap_to' p"
+  and ifunsafe'[wp]: if_unsafe_then_cap'
+  (wp: crunch_wps simp: crunch_simps)
 
 lemma tcbSchedAppend_iflive'[wp]:
-  "\<lbrace>if_live_then_nonz_cap' and ex_nonz_cap_to' tcb\<rbrace>
-    tcbSchedAppend tcb \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
-  apply (simp add: tcbSchedAppend_def unless_def)
-  apply (wp threadSet_iflive' hoare_drop_imps | simp add: crunch_simps)+
+  "\<lbrace>if_live_then_nonz_cap' and pspace_aligned' and pspace_distinct'\<rbrace>
+   tcbSchedAppend tcbPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  unfolding tcbSchedAppend_def
+  apply (wpsimp wp: tcbQueueAppend_if_live_then_nonz_cap' threadGet_wp simp: bitmap_fun_defs)
+  apply (frule_tac p=tcbPtr in if_live_then_nonz_capE')
+   apply (fastforce simp: ko_wp_at'_def st_tcb_at'_def obj_at'_def runnable_eq_active' live'_def)
+  apply (clarsimp simp: tcbQueueEmpty_def)
+  apply (erule if_live_then_nonz_capE')
+  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 (fastforce dest!: obj_at'_tcbQueueEnd_ksReadyQueues
+                    simp: ko_wp_at'_def inQ_def obj_at'_def tcbQueueEmpty_def live'_def)
   done
 
 lemma tcbSchedDequeue_iflive'[wp]:
-  "\<lbrace>if_live_then_nonz_cap'\<rbrace> tcbSchedDequeue tcb \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  "\<lbrace>if_live_then_nonz_cap' and valid_objs' and sym_heap_sched_pointers\<rbrace>
+   tcbSchedDequeue tcbPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
   apply (simp add: tcbSchedDequeue_def)
-  apply (wp threadSet_iflive' hoare_when_weak_wp | simp add: crunch_simps)+
-       apply ((wp | clarsimp simp: bitmap_fun_defs)+)[1] (* deal with removeFromBitmap *)
-      apply (wp threadSet_iflive' hoare_when_weak_wp | simp add: crunch_simps)+
-      apply (rule_tac Q="\<lambda>rv. \<top>" in hoare_post_imp, fastforce)
-      apply (wp | simp add: crunch_simps)+
+  apply (wpsimp wp: tcbQueueRemove_if_live_then_nonz_cap' threadGet_wp)
+  apply (fastforce elim: if_live_then_nonz_capE' simp: obj_at'_def ko_wp_at'_def live'_def)
   done
 
 crunches tcbSchedAppend, tcbSchedDequeue, tcbSchedEnqueue
@@ -480,7 +459,7 @@ crunches tcbSchedAppend, tcbSchedDequeue, tcbSchedEnqueue
   and state_refs_of'[wp]: "\<lambda>s. P (state_refs_of' s)"
   and state_hyp_refs_of'[wp]: "\<lambda>s. P (state_hyp_refs_of' s)"
   and idle'[wp]: valid_idle'
-  (simp: unless_def crunch_simps)
+  (simp: unless_def crunch_simps obj_at'_def wp: getObject_tcb_wp)
 
 lemma tcbSchedEnqueue_vms'[wp]:
   "\<lbrace>valid_machine_state'\<rbrace> tcbSchedEnqueue t \<lbrace>\<lambda>_. valid_machine_state'\<rbrace>"
@@ -510,19 +489,87 @@ lemma ct_idle_or_in_cur_domain'_lift2:
   apply simp+
   done
 
+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>"
+  apply (wpsimp wp: setObject_tcb_mdb' getTCB_wp simp: threadSet_def obj_at'_def)
+  apply fastforce
+  done
+
+lemma tcbSchedNext_update_valid_mdb'[wp]:
+  "\<lbrace>valid_mdb' and tcb_at' tcbPtr\<rbrace> threadSet (tcbSchedNext_update f) tcbPtr \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  apply (wpsimp wp: threadSet_mdb')
+  apply (fastforce simp: obj_at'_def valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)
+  done
+
+lemma tcbSchedPrev_update_valid_mdb'[wp]:
+  "\<lbrace>valid_mdb' and tcb_at' tcbPtr\<rbrace> threadSet (tcbSchedPrev_update f) tcbPtr \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  apply (wpsimp wp: threadSet_mdb')
+  apply (fastforce simp: obj_at'_def valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)
+  done
+
+lemma tcbQueueRemove_valid_mdb':
+  "\<lbrace>\<lambda>s. valid_mdb' s \<and> valid_objs' s\<rbrace> tcbQueueRemove q tcbPtr \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  unfolding tcbQueueRemove_def
+  apply (wpsimp wp: getTCB_wp)
+  apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+  apply (fastforce simp: valid_tcb'_def obj_at'_def)
+  done
+
+lemma tcbQueuePrepend_valid_mdb':
+  "\<lbrace>valid_mdb' and tcb_at' tcbPtr
+    and (\<lambda>s. \<not> tcbQueueEmpty queue \<longrightarrow> tcb_at' (the (tcbQueueHead queue)) s)\<rbrace>
+   tcbQueuePrepend queue tcbPtr
+   \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  unfolding tcbQueuePrepend_def
+  by (wpsimp wp: hoare_vcg_if_lift2 hoare_vcg_imp_lift')
+
+lemma tcbQueueAppend_valid_mdb':
+  "\<lbrace>\<lambda>s. valid_mdb' s \<and> tcb_at' tcbPtr s
+        \<and> (\<not> tcbQueueEmpty queue \<longrightarrow> tcb_at' (the (tcbQueueEnd queue)) s)\<rbrace>
+   tcbQueueAppend queue tcbPtr
+   \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  unfolding tcbQueueAppend_def
+  by (wpsimp wp: hoare_vcg_if_lift2 hoare_vcg_imp_lift')
+
+lemma tcbQueued_update_valid_mdb'[wp]:
+  "\<lbrace>valid_mdb' and tcb_at' tcbPtr\<rbrace> threadSet (tcbQueued_update f) tcbPtr \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  apply (wpsimp wp: threadSet_mdb')
+  apply (fastforce simp: obj_at'_def valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)
+  done
+
+lemma valid_mdb'_ksReadyQueuesL1Bitmap_update[simp]:
+  "valid_mdb' (ksReadyQueuesL1Bitmap_update f s) = valid_mdb' s"
+  by (simp add: valid_mdb'_def)
+
+lemma valid_mdb'_ksReadyQueuesL2Bitmap_update[simp]:
+  "valid_mdb' (ksReadyQueuesL2Bitmap_update f s) = valid_mdb' s"
+  by (simp add: valid_mdb'_def)
+
+lemma tcbSchedEnqueue_valid_mdb'[wp]:
+  "\<lbrace>valid_mdb' and valid_objs' and pspace_aligned' and pspace_distinct'\<rbrace>
+   tcbSchedEnqueue tcbPtr
+   \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  apply (clarsimp simp: tcbSchedEnqueue_def setQueue_def)
+  apply (wpsimp wp: tcbQueuePrepend_valid_mdb' threadGet_wp simp: bitmap_fun_defs)
+  apply normalise_obj_at'
+  apply (fastforce dest!: obj_at'_tcbQueueHead_ksReadyQueues
+                    simp: ready_queue_relation_def ksReadyQueues_asrt_def obj_at'_def)
+  done
+
+crunches tcbSchedEnqueue
+  for cur_tcb'[wp]: cur_tcb'
+  (wp: threadSet_cur)
+
 lemma tcbSchedEnqueue_invs'[wp]:
-  "\<lbrace>invs'
-    and st_tcb_at' runnable' t
-    and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t)\<rbrace>
-     tcbSchedEnqueue t
+  "\<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_state'_def)
-  apply (rule hoare_pre)
-   apply (wp tcbSchedEnqueue_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 tcbSchedEnqueue_ct_not_inQ
+              simp: cteCaps_of_def o_def)
   done
 
 crunch ksMachine[wp]: tcbSchedAppend "\<lambda>s. P (ksMachineState s)"
@@ -531,7 +578,7 @@ crunch ksMachine[wp]: tcbSchedAppend "\<lambda>s. P (ksMachineState s)"
 lemma tcbSchedAppend_vms'[wp]:
   "\<lbrace>valid_machine_state'\<rbrace> tcbSchedAppend t \<lbrace>\<lambda>_. valid_machine_state'\<rbrace>"
   apply (simp add: valid_machine_state'_def pointerInUserData_def pointerInDeviceData_def)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift tcbSchedAppend_ksMachine)
+  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
   done
 
 crunch pspace_domain_valid[wp]: tcbSchedAppend "pspace_domain_valid"
@@ -546,21 +593,27 @@ crunch ksIdleThread[wp]: tcbSchedAppend "\<lambda>s. P (ksIdleThread s)"
 crunch ksDomSchedule[wp]: tcbSchedAppend "\<lambda>s. P (ksDomSchedule s)"
 (simp: unless_def)
 
+lemma tcbQueueAppend_tcbPriority_obj_at'[wp]:
+  "tcbQueueAppend queue tptr \<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
+  unfolding tcbQueueAppend_def
+  apply (wpsimp wp: threadSet_wp)
+  by (auto simp: obj_at'_def objBits_simps ps_clear_def split: if_splits)
+
+lemma tcbQueueAppend_tcbDomain_obj_at'[wp]:
+  "tcbQueueAppend queue tptr \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  unfolding tcbQueueAppend_def
+  apply (wpsimp wp: threadSet_wp)
+  by (auto simp: obj_at'_def objBits_simps ps_clear_def split: if_splits)
+
 lemma tcbSchedAppend_tcbDomain[wp]:
-  "\<lbrace> obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t' \<rbrace>
-     tcbSchedAppend t
-   \<lbrace> \<lambda>_. obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t' \<rbrace>"
+  "tcbSchedAppend t \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
   apply (clarsimp simp: tcbSchedAppend_def)
-  apply (wpsimp simp: unless_def)+
-  done
+  by wpsimp
 
 lemma tcbSchedAppend_tcbPriority[wp]:
-  "\<lbrace> obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t' \<rbrace>
-     tcbSchedAppend t
-   \<lbrace> \<lambda>_. obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t' \<rbrace>"
+  "tcbSchedAppend t \<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
   apply (clarsimp simp: tcbSchedAppend_def)
-  apply (wpsimp simp: unless_def)+
-  done
+  by wpsimp
 
 lemma tcbSchedAppend_tcb_in_cur_domain'[wp]:
   "\<lbrace>tcb_in_cur_domain' t'\<rbrace> tcbSchedAppend t \<lbrace>\<lambda>_. tcb_in_cur_domain' t' \<rbrace>"
@@ -579,28 +632,59 @@ crunches tcbSchedDequeue, tcbSchedAppend
   for arch'[wp]: "\<lambda>s. P (ksArchState s)"
 
 lemma tcbSchedAppend_sch_act_wf[wp]:
-  "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace> tcbSchedAppend thread
-  \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  apply (simp add:tcbSchedAppend_def bitmap_fun_defs)
-  apply (wp unless_wp setQueue_sch_act threadGet_wp|simp)+
-  apply (fastforce simp:typ_at'_def obj_at'_def)
+  "tcbSchedAppend thread \<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
+  by (wpsimp wp: sch_act_wf_lift)
+
+lemma tcbSchedAppend_valid_bitmapQ[wp]:
+  "\<lbrace>valid_bitmaps\<rbrace> tcbSchedAppend tcbPtr \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
+  supply if_split[split del]
+  unfolding tcbSchedAppend_def
+  apply (wpsimp simp: tcbQueueAppend_def
+                  wp: setQueue_valid_bitmapQ' addToBitmap_valid_bitmapQ_except addToBitmap_bitmapQ
+                      threadGet_wp hoare_vcg_if_lift2)
+  apply (clarsimp simp: ksReadyQueues_asrt_def split: if_splits)
+  apply normalise_obj_at'
+  apply (force dest: tcbQueueHead_iff_tcbQueueEnd
+               simp: valid_bitmaps_def valid_bitmapQ_def tcbQueueEmpty_def)
+  done
+
+lemma tcbSchedAppend_valid_mdb'[wp]:
+  "\<lbrace>valid_mdb' and valid_tcbs' and pspace_aligned' and pspace_distinct'\<rbrace>
+   tcbSchedAppend tcbPtr
+   \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  apply (clarsimp simp: tcbSchedAppend_def setQueue_def)
+  apply (wpsimp wp: tcbQueueAppend_valid_mdb' threadGet_wp simp: bitmap_fun_defs)
+  apply (fastforce dest: obj_at'_tcbQueueEnd_ksReadyQueues
+                   simp: ready_queue_relation_def ksReadyQueues_asrt_def obj_at'_def)
+  done
+
+lemma tcbSchedAppend_valid_bitmaps[wp]:
+  "tcbSchedAppend tcbPtr \<lbrace>valid_bitmaps\<rbrace>"
+  unfolding valid_bitmaps_def
+  apply wpsimp
+  apply (clarsimp simp: valid_bitmaps_def)
   done
 
 lemma tcbSchedAppend_invs'[wp]:
-  "\<lbrace>invs'
-    and st_tcb_at' runnable' t
-    and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t)\<rbrace>
-     tcbSchedAppend t
+  "\<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_state'_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:
@@ -629,7 +713,7 @@ crunch ksMachine[wp]: tcbSchedDequeue "\<lambda>s. P (ksMachineState s)"
 lemma tcbSchedDequeue_vms'[wp]:
   "\<lbrace>valid_machine_state'\<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>_. valid_machine_state'\<rbrace>"
   apply (simp add: valid_machine_state'_def pointerInUserData_def pointerInDeviceData_def)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift tcbSchedDequeue_ksMachine)
+  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
   done
 
 crunch pspace_domain_valid[wp]: tcbSchedDequeue "pspace_domain_valid"
@@ -647,46 +731,89 @@ lemma tcbSchedDequeue_tcb_in_cur_domain'[wp]:
   "\<lbrace>tcb_in_cur_domain' t'\<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>_. tcb_in_cur_domain' t' \<rbrace>"
   apply (rule tcb_in_cur_domain'_lift)
    apply wp
-  apply (clarsimp simp: tcbSchedDequeue_def)
-  apply (wp hoare_when_weak_wp | simp)+
-  done
-
-lemma tcbSchedDequeue_tcbDomain[wp]:
-  "\<lbrace> obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t' \<rbrace>
-     tcbSchedDequeue t
-   \<lbrace> \<lambda>_. obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t' \<rbrace>"
-  apply (clarsimp simp: tcbSchedDequeue_def)
-  apply (wp hoare_when_weak_wp | simp)+
-  done
-
-lemma tcbSchedDequeue_tcbPriority[wp]:
-  "\<lbrace> obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t' \<rbrace>
-     tcbSchedDequeue t
-   \<lbrace> \<lambda>_. obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t' \<rbrace>"
-  apply (clarsimp simp: tcbSchedDequeue_def)
-  apply (wp hoare_when_weak_wp | simp)+
+  apply (clarsimp simp: tcbSchedDequeue_def tcbQueueRemove_def)
+  apply (wpsimp wp: hoare_when_weak_wp getObject_tcb_wp threadGet_wp)
   done
 
 crunch ksDomScheduleIdx[wp]: tcbSchedDequeue "\<lambda>s. P (ksDomScheduleIdx s)"
   (simp: unless_def)
 
+lemma tcbSchedDequeue_valid_mdb'[wp]:
+  "\<lbrace>valid_mdb' and valid_objs'\<rbrace> tcbSchedDequeue tcbPtr \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  unfolding tcbSchedDequeue_def
+  apply (wpsimp simp: bitmap_fun_defs setQueue_def wp: threadSet_mdb' tcbQueueRemove_valid_mdb')
+      apply (rule_tac Q="\<lambda>_. tcb_at' tcbPtr" in hoare_post_imp)
+       apply (fastforce simp: tcb_cte_cases_def cteSizeBits_def)
+      apply (wpsimp wp: threadGet_wp)+
+  apply (fastforce simp: obj_at'_def)
+  done
+
 lemma tcbSchedDequeue_invs'[wp]:
-  "\<lbrace>invs' and tcb_at' t\<rbrace>
-     tcbSchedDequeue t
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  unfolding invs'_def valid_state'_def
-  apply (rule hoare_pre)
-   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
-             tcbSchedDequeue_valid_queues
-             untyped_ranges_zero_lift
-        | simp add: cteCaps_of_def o_def)+
-  apply (fastforce elim: valid_objs'_maxDomain valid_objs'_maxPriority simp: valid_pspace'_def)+
+  "tcbSchedDequeue t \<lbrace>invs'\<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 ct_idle_or_in_cur_domain'_lift2 cur_tcb_lift
+              simp: cteCaps_of_def o_def)
+  done
+
+lemma ready_qs_runnable_cross:
+  "\<lbrakk>(s, s') \<in> state_relation; pspace_aligned s; pspace_distinct s; valid_queues s\<rbrakk>
+   \<Longrightarrow> ready_qs_runnable s'"
+  apply (clarsimp simp: ready_qs_runnable_def)
+  apply normalise_obj_at'
+  apply (frule state_relation_ready_queues_relation)
+  apply (clarsimp simp: ready_queues_relation_def ready_queue_relation_def Let_def
+                        list_queue_relation_def)
+  apply (drule_tac x="tcbDomain ko" in spec)
+  apply (drule_tac x="tcbPriority ko" in spec)
+  apply (clarsimp simp: valid_queues_def)
+  apply (drule_tac x="tcbDomain ko" in spec)
+  apply (drule_tac x="tcbPriority ko" in spec)
+  apply clarsimp
+  apply (drule_tac x=t in bspec)
+   apply (fastforce simp: inQ_def in_opt_pred obj_at'_def opt_map_red)
+  apply (fastforce dest: st_tcb_at_runnable_cross simp: obj_at'_def st_tcb_at'_def)
+  done
+
+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_queues)?, (frule invs_psp_aligned)?, (frule invs_distinct)?,
+  fastforce dest: ready_qs_runnable_cross
+
+defs idleThreadNotQueued_def:
+  "idleThreadNotQueued s \<equiv> obj_at' (Not \<circ> tcbQueued) (ksIdleThread s) s"
+
+lemma idle_thread_not_queued:
+  "\<lbrakk>valid_idle s; valid_queues s; valid_etcbs s\<rbrakk>
+   \<Longrightarrow> \<not> (\<exists>d p. idle_thread s \<in> set (ready_queues s d p))"
+  apply (clarsimp simp: valid_queues_def)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply clarsimp
+  apply (drule_tac x="idle_thread s" in bspec)
+   apply fastforce
+  apply (clarsimp simp: valid_idle_def pred_tcb_at_def obj_at_def valid_etcbs_def)
   done
 
+lemma valid_idle_tcb_at:
+  "valid_idle s \<Longrightarrow> tcb_at (idle_thread s) s"
+  by (clarsimp simp: valid_idle_def pred_tcb_at_def obj_at_def is_tcb_def)
+
 lemma setCurThread_corres:
-  "corres dc \<top> \<top> (modify (cur_thread_update (\<lambda>_. t))) (setCurThread t)"
-  apply (unfold setCurThread_def)
+  "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 opt_pred_def opt_map_def)
   apply (rule corres_modify)
   apply (simp add: state_relation_def swp_def)
   done
@@ -709,10 +836,9 @@ lemma updateASIDPoolEntry_pred_tcb_at'[wp]:
   unfolding updateASIDPoolEntry_def getPoolPtr_def
   by (wpsimp wp: setASIDPool_pred_tcb_at' getASID_wp)
 
-lemma updateASIDPoolEntry_valid_queues[wp]:
-  "updateASIDPoolEntry g asid \<lbrace>Invariants_H.valid_queues\<rbrace>"
-  unfolding updateASIDPoolEntry_def getPoolPtr_def
-  by (wpsimp wp: getASID_wp)
+crunches updateASIDPoolEntry
+  for tcbs_of'[wp]: "\<lambda>s. P (tcbs_of' s)"
+  (wp: getASID_wp crunch_wps)
 
 crunches setVMRoot
   for pred_tcb_at'[wp]: "pred_tcb_at' proj P t'"
@@ -738,49 +864,60 @@ qed
 crunches storeWordUser, setVMRoot, asUser, storeWordUser, Arch.switchToThread
   for ksQ[wp]: "\<lambda>s. P (ksReadyQueues s p)"
   and ksIdleThread[wp]: "\<lambda>s. P (ksIdleThread s)"
-  and valid_queues[wp]: "Invariants_H.valid_queues"
-  (wp: crunch_wps simp: crunch_simps)
+  and sym_heap_sched_pointers[wp]: sym_heap_sched_pointers
+  and valid_objs'[wp]: valid_objs'
+  (wp: crunch_wps threadSet_sched_pointers getObject_tcb_wp getASID_wp
+   simp: crunch_simps obj_at'_def)
 
-crunches arch_switch_to_thread
+crunches arch_switch_to_thread, arch_switch_to_idle_thread
   for pspace_aligned[wp]: pspace_aligned
   and pspace_distinct[wp]: pspace_distinct
+  and ready_qs_distinct[wp]: ready_qs_distinct
+  and valid_idle[wp]: valid_idle
+  (wp: ready_qs_distinct_lift simp: crunch_simps)
+
+lemma valid_queues_in_correct_ready_q[elim!]:
+  "valid_queues s \<Longrightarrow> in_correct_ready_q s"
+  by (clarsimp simp: valid_queues_def in_correct_ready_q_def)
+
+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)
 
 lemma switchToThread_corres:
   "corres dc (valid_arch_state and valid_objs
                 and valid_vspace_objs and pspace_aligned and pspace_distinct
                 and valid_vs_lookup and valid_global_objs and pspace_in_kernel_window
                 and unique_table_refs
-                and st_tcb_at runnable t and valid_etcbs and (\<lambda>s. sym_refs (state_hyp_refs_of s)))
-             (no_0_obj' and Invariants_H.valid_queues)
+                and st_tcb_at runnable t and valid_etcbs and (\<lambda>s. sym_refs (state_hyp_refs_of s))
+                and valid_queues and valid_idle)
+             (no_0_obj' and sym_heap_sched_pointers and valid_objs')
              (switch_to_thread t) (switchToThread t)"
-  (is "corres _ ?PA ?PH _ _")
-proof -
-  have mainpart: "corres dc (?PA) (?PH)
-     (do y \<leftarrow> arch_switch_to_thread t;
-         y \<leftarrow> (tcb_sched_action tcb_sched_dequeue t);
-         modify (cur_thread_update (\<lambda>_. t))
-      od)
-     (do y \<leftarrow> Arch.switchToThread t;
-         y \<leftarrow> tcbSchedDequeue t;
-         setCurThread 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)
+  apply add_ready_qs_runnable
+  apply (simp add: switch_to_thread_def Thread_H.switchToThread_def)
+  apply (rule corres_symb_exec_l[OF _ _ get_sp]; (solves wpsimp)?)
+  apply (rule corres_symb_exec_l[OF _ _ assert_sp]; (solves wpsimp)?)
+    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_stateAssert_ignore)
+     apply (fastforce dest!: state_relation_ready_queues_relation intro: ksReadyQueues_asrt_cross)
+    apply (rule corres_stateAssert_add_assertion[rotated])
+     apply fastforce
     apply (rule corres_guard_imp)
       apply (rule corres_split[OF arch_switchToThread_corres])
         apply (rule corres_split[OF tcbSchedDequeue_corres setCurThread_corres])
-         apply (wp|clarsimp simp: tcb_at_is_etcb_at st_tcb_at_tcb_at)+
-    done
-
-  show ?thesis
-    apply -
-    apply (simp add: switch_to_thread_def Thread_H.switchToThread_def)
-    apply (rule corres_symb_exec_l [where Q = "\<lambda> s rv. (?PA and (=) rv) s",
-                                    OF corres_symb_exec_l [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 tcb_at_idle_thread_lift:
   assumes T: "\<And>T' t. \<lbrace>typ_at T' t\<rbrace> f \<lbrace>\<lambda>rv. typ_at T' t\<rbrace>"
@@ -824,15 +961,21 @@ lemma arch_switchToIdleThread_corres:
   done
 
 lemma switchToIdleThread_corres:
-  "corres dc invs invs_no_cicd' switch_to_idle_thread switchToIdleThread"
+  "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 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_trivial, rule corres_modify)
-        apply (simp add: state_relation_def cdt_relation_def)
-       apply (wp+, simp+)
+        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)
@@ -867,11 +1010,9 @@ proof -
     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 Invariants_H.valid_queues_def
-                              sch_act_wf ct_in_state'_def state_refs_of'_def
-                              ps_clear_def valid_irq_node'_def valid_queues'_def ct_not_inQ_ct
-                              ct_idle_or_in_cur_domain'_def
-                              bitmapQ_defs valid_queues_no_bitmap_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
@@ -885,100 +1026,20 @@ lemma setCurThread_invs:
   by (rule hoare_pre, rule setCurThread_invs_no_cicd')
      (simp add: invs'_to_invs_no_cicd'_def)
 
-lemma valid_queues_not_runnable_not_queued:
-  fixes s
-  assumes vq:  "Invariants_H.valid_queues 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
-
-  with vq have "st_tcb_at' runnable' t s"
-    unfolding Invariants_H.valid_queues_def valid_queues_no_bitmap_def
-    apply -
-    apply clarsimp
-    apply (drule_tac x=d in spec)
-    apply (drule_tac x=p in spec)
-    apply (clarsimp simp add: st_tcb_at'_def)
-    apply (drule(1) bspec)
-    apply (erule obj_at'_weakenE)
-    apply (clarsimp)
-    done
-
-  with st show False
-    apply -
-    apply (drule(1) pred_tcb_at_conj')
-    apply (clarsimp)
-    done
-qed
-
-(*
- * The idle thread is not part of any ready queues.
- *)
-lemma idle'_not_tcbQueued':
- assumes vq:   "Invariants_H.valid_queues 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 add: valid_idle'_def pred_tcb_at'_def obj_at'_def idle_tcb'_def)
-  with vq vq' show ?thesis
-    by (rule valid_queues_not_runnable_not_queued)
-qed
-
 lemma setCurThread_invs_no_cicd'_idle_thread:
-  "\<lbrace>invs_no_cicd' and (\<lambda>s. t = ksIdleThread s) \<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
-  have idle'_activatable': "\<And> s t. st_tcb_at' idle' t s \<Longrightarrow> st_tcb_at' activatable' t s"
-    apply (clarsimp simp: st_tcb_at'_def o_def obj_at'_def)
+  "\<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 st_tcb_at'_def
+                        idleThreadNotQueued_def)
   done
-  show ?thesis
-    apply (simp add: setCurThread_def)
-    apply wp
-    apply (clarsimp simp: all_invs_but_ct_idle_or_in_cur_domain'_def)
-    apply (frule (2) idle'_not_tcbQueued'[simplified o_def])
-    apply (clarsimp simp add: ct_not_inQ_ct idle'_activatable'
-                              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_queues_no_bitmap_def valid_queues'_def
-                              pred_tcb_at'_def
-                        cong: option.case_cong)
-    apply (clarsimp simp: obj_at'_def idle_tcb'_def )
-    done
-qed
 
 lemma setCurThread_invs_idle_thread:
   "\<lbrace>invs' and (\<lambda>s. t = ksIdleThread s) \<rbrace> setCurThread t \<lbrace>\<lambda>rv. invs'\<rbrace>"
@@ -1001,13 +1062,13 @@ lemma Arch_switchToThread_tcb_in_cur_domain'[wp]:
   by (wp tcb_in_cur_domain'_lift)
 
 lemma tcbSchedDequeue_not_tcbQueued:
-  "\<lbrace> tcb_at' t \<rbrace> tcbSchedDequeue t \<lbrace> \<lambda>_. obj_at' (\<lambda>x. \<not> tcbQueued x) t \<rbrace>"
+  "\<lbrace>\<top>\<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>_. obj_at' (\<lambda>x. \<not> tcbQueued x) t\<rbrace>"
   apply (simp add: tcbSchedDequeue_def)
   apply (wp|clarsimp)+
   apply (rule_tac Q="\<lambda>queued. obj_at' (\<lambda>x. tcbQueued x = queued) t" in hoare_post_imp)
-   apply (clarsimp simp: obj_at'_def)
-  apply (wp threadGet_obj_at')
-  apply (simp)
+     apply (clarsimp simp: obj_at'_def)
+    apply (wpsimp wp: threadGet_wp)+
+  apply (clarsimp simp: obj_at'_def)
   done
 
 lemma asUser_obj_at[wp]:
@@ -1027,10 +1088,6 @@ crunch valid_irq_states'[wp]: asUser "valid_irq_states'"
 crunch valid_machine_state'[wp]: asUser "valid_machine_state'"
 (wp: crunch_wps simp: crunch_simps)
 
-crunch valid_queues'[wp]: asUser "valid_queues'"
-(wp: crunch_wps simp: crunch_simps)
-
-
 lemma asUser_valid_irq_node'[wp]:
   "asUser t (setRegister f r) \<lbrace>\<lambda>s. valid_irq_node' (irq_node' s) s\<rbrace>"
   apply (rule_tac valid_irq_node_lift)
@@ -1089,57 +1146,39 @@ lemma asUser_utr[wp]:
   done
 
 lemma threadSet_invs_no_cicd'_trivialT:
-  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 \<and> tcbDomain (F tcb) = tcbDomain tcb"
-  assumes w: "\<forall>tcb. is_aligned (tcbIPCBuffer tcb) msg_align_bits \<longrightarrow> is_aligned (tcbIPCBuffer (F tcb)) msg_align_bits"
-  assumes a: "\<forall>tcb. tcbBoundNotification (F tcb) = tcbBoundNotification tcb"
-  assumes w: "\<forall>tcb. is_aligned (tcbIPCBuffer tcb) msg_align_bits \<longrightarrow> is_aligned (tcbIPCBuffer (F tcb)) msg_align_bits"
-  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 v: "\<forall>tcb. atcbVCPUPtr (tcbArch (F tcb)) = atcbVCPUPtr (tcbArch tcb)"
-  shows
-  "\<lbrace>\<lambda>s. invs_no_cicd' 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. \<not> tcbQueued tcb \<and> tcbQueued (F tcb)) \<longrightarrow> ex_nonz_cap_to' t s \<and> t \<noteq> ksCurThread s) \<and>
-       (\<forall>tcb. tcbQueued (F tcb) \<and> ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> tcbQueued tcb \<or> t \<noteq> ksCurThread s)\<rbrace>
-   threadSet F t
-   \<lbrace>\<lambda>rv. invs_no_cicd'\<rbrace>"
-proof -
-  from z have domains: "\<And>tcb. tcbDomain (F tcb) = tcbDomain tcb" by blast
-  note threadSet_sch_actT_P[where P=False, simplified]
-  have y: "\<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_no_cicd'_def valid_state'_def split del: if_split)
-    apply (rule hoare_pre)
-     apply (wp x w v u b
-              threadSet_valid_pspace'T
-              threadSet_sch_actT_P[where P=False, simplified]
-              threadSet_valid_queues
-              threadSet_state_refs_of'T[where f'=id]
-              threadSet_state_hyp_refs_of'
-              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_cur
-              untyped_ranges_zero_lift
-           |clarsimp simp: y z a v domains cteCaps_of_def valid_arch_tcb'_def |rule refl)+
-   apply (clarsimp simp: obj_at'_def pred_tcb_at'_def)
-   apply (clarsimp simp: cur_tcb'_def valid_irq_node'_def valid_queues'_def o_def)
-   by (fastforce simp: domains ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def z a)
-qed
+  assumes
+    "\<forall>tcb. \<forall>(getF,setF) \<in> ran tcb_cte_cases. getF (F tcb) = getF tcb"
+    "\<forall>tcb. tcbState (F tcb) = tcbState tcb \<and> tcbDomain (F tcb) = tcbDomain tcb"
+    "\<forall>tcb. is_aligned (tcbIPCBuffer tcb) msg_align_bits \<longrightarrow> is_aligned (tcbIPCBuffer (F tcb)) msg_align_bits"
+    "\<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 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"
+    "\<forall>tcb. atcbVCPUPtr (tcbArch (F tcb)) = atcbVCPUPtr (tcbArch tcb)"
+  shows "threadSet F t \<lbrace>invs_no_cicd'\<rbrace>"
+  apply (simp add: invs_no_cicd'_def valid_state'_def)
+  apply (wp threadSet_valid_pspace'T
+            threadSet_sch_actT_P[where P=False, simplified]
+            threadSet_state_refs_of'T[where f'=id]
+            threadSet_state_hyp_refs_of'
+            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_sched_pointers threadSet_valid_sched_pointers
+            threadSet_cur
+            untyped_ranges_zero_lift
+         | clarsimp simp: assms cteCaps_of_def valid_arch_tcb'_def | rule refl)+
+  by (auto simp: o_def)
 
 lemmas threadSet_invs_no_cicd'_trivial =
     threadSet_invs_no_cicd'_trivialT [OF all_tcbI all_tcbI all_tcbI all_tcbI, OF ball_tcb_cte_casesI]
@@ -1158,22 +1197,17 @@ lemma Arch_switchToThread_invs_no_cicd':
   by (clarsimp simp: all_invs_but_ct_idle_or_in_cur_domain'_def)
 
 lemma tcbSchedDequeue_invs_no_cicd'[wp]:
-  "\<lbrace>invs_no_cicd' and tcb_at' t\<rbrace>
-     tcbSchedDequeue t
-   \<lbrace>\<lambda>_. invs_no_cicd'\<rbrace>"
-  unfolding all_invs_but_ct_idle_or_in_cur_domain'_def valid_state'_def
+  "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
-            tcbSchedDequeue_valid_queues_weak
             untyped_ranges_zero_lift
         | simp add: cteCaps_of_def o_def)+
   apply clarsimp
-  apply (fastforce simp: valid_pspace'_def valid_queues_def
-                   elim: valid_objs'_maxDomain valid_objs'_maxPriority intro: obj_at'_conjI)
   done
 
 lemma switchToThread_invs_no_cicd':
-  "\<lbrace>invs_no_cicd' and st_tcb_at' runnable' t and tcb_in_cur_domain' t \<rbrace> ThreadDecls_H.switchToThread t \<lbrace>\<lambda>rv. invs' \<rbrace>"
+  "\<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')
@@ -1181,7 +1215,7 @@ lemma switchToThread_invs_no_cicd':
   done
 
 lemma switchToThread_invs[wp]:
-  "\<lbrace>invs' and st_tcb_at' runnable' t and tcb_in_cur_domain' t \<rbrace> switchToThread t \<lbrace>\<lambda>rv. invs' \<rbrace>"
+  "\<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 threadSet_timeslice_invs setCurThread_invs
              Arch_switchToThread_invs dmo_invs'
@@ -1268,61 +1302,6 @@ 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 invs'_not_runnable_not_queued:
-  fixes s
-  assumes inv: "invs' s"
-      and st: "st_tcb_at' (Not \<circ> runnable') t s"
-  shows "obj_at' (Not \<circ> tcbQueued) t s"
-  apply (insert assms)
-  apply (rule valid_queues_not_runnable_not_queued)
-    apply (clarsimp simp add: invs'_def valid_state'_def)+
-  done
-
-lemma valid_queues_not_tcbQueued_not_ksQ:
-  fixes s
-  assumes   vq: "Invariants_H.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"
-    unfolding Invariants_H.valid_queues_def valid_queues_no_bitmap_def
-    apply clarify
-    apply (drule_tac x=d in spec)
-    apply (drule_tac x=p in spec)
-    apply (clarsimp)
-    apply (drule(1) bspec)
-    apply (erule obj_at'_weakenE)
-    apply (simp)
-    done
-  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 valid_state'_def)
-  apply (drule(1) valid_queues_not_tcbQueued_not_ksQ)
-  apply (clarsimp)
-  done
-
-lemma ct_not_ksQ:
-  "\<lbrakk> invs' s; ksSchedulerAction s = ResumeCurrentThread \<rbrakk>
-   \<Longrightarrow> \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)"
-  apply (clarsimp simp: invs'_def valid_state'_def ct_not_inQ_def)
-  apply (frule(1) valid_queues_not_tcbQueued_not_ksQ)
-  apply (fastforce)
-  done
-
 lemma setThreadState_rct:
   "\<lbrace>\<lambda>s. (runnable' st \<or> ksCurThread s \<noteq> t)
         \<and> ksSchedulerAction s = ResumeCurrentThread\<rbrace>
@@ -1394,21 +1373,24 @@ lemma bitmapQ_from_bitmap_lookup:
   done
 
 lemma lookupBitmapPriority_obj_at':
-  "\<lbrakk>ksReadyQueuesL1Bitmap s (ksCurDomain s) \<noteq> 0; valid_queues_no_bitmap s; valid_bitmapQ s;
-         bitmapQ_no_L1_orphans s\<rbrakk>
-        \<Longrightarrow> obj_at' (inQ (ksCurDomain s) (lookupBitmapPriority (ksCurDomain s) s) and runnable' \<circ> tcbState)
-             (hd (ksReadyQueues s (ksCurDomain s, lookupBitmapPriority (ksCurDomain s) s))) s"
+  "\<lbrakk>ksReadyQueuesL1Bitmap s d \<noteq> 0; valid_bitmapQ s; bitmapQ_no_L1_orphans s;
+    ksReadyQueues_asrt s; ready_qs_runnable s; pspace_aligned' s; pspace_distinct' s\<rbrakk>
+   \<Longrightarrow> obj_at' (inQ d (lookupBitmapPriority d s) and runnable' \<circ> tcbState)
+               (the (tcbQueueHead (ksReadyQueues s (d, lookupBitmapPriority d s)))) s"
   apply (drule (2) bitmapQ_from_bitmap_lookup)
   apply (simp add: valid_bitmapQ_bitmapQ_simp)
-  apply (case_tac "ksReadyQueues s (ksCurDomain s, lookupBitmapPriority (ksCurDomain s) s)", simp)
-  apply (clarsimp, rename_tac t ts)
-  apply (drule cons_set_intro)
-  apply (drule (2) valid_queues_no_bitmap_objD)
+  apply (clarsimp simp: ready_queue_relation_def ksReadyQueues_asrt_def tcbQueueEmpty_def)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x="lookupBitmapPriority d s" in spec)
+  apply clarsimp
+  apply (frule (3) obj_at'_tcbQueueHead_ksReadyQueues)
+  apply (fastforce simp: obj_at'_and ready_qs_runnable_def obj_at'_def st_tcb_at'_def inQ_def
+                         tcbQueueEmpty_def)
   done
 
 lemma bitmapL1_zero_ksReadyQueues:
   "\<lbrakk> valid_bitmapQ s ; bitmapQ_no_L1_orphans s \<rbrakk>
-   \<Longrightarrow> (ksReadyQueuesL1Bitmap s d = 0) = (\<forall>p. ksReadyQueues s (d,p) = [])"
+   \<Longrightarrow> (ksReadyQueuesL1Bitmap s d = 0) = (\<forall>p. tcbQueueEmpty (ksReadyQueues s (d, p)))"
   apply (cases "ksReadyQueuesL1Bitmap s d = 0")
    apply (force simp add: bitmapQ_def valid_bitmapQ_def)
   apply (fastforce dest: bitmapQ_from_bitmap_lookup simp: valid_bitmapQ_bitmapQ_simp)
@@ -1479,7 +1461,7 @@ lemma bitmapL1_highest_lookup:
   done
 
 lemma bitmapQ_ksReadyQueuesI:
-  "\<lbrakk> bitmapQ d p s ; valid_bitmapQ s \<rbrakk> \<Longrightarrow> ksReadyQueues s (d, p) \<noteq> []"
+  "\<lbrakk> bitmapQ d p s ; valid_bitmapQ s \<rbrakk> \<Longrightarrow> \<not> tcbQueueEmpty (ksReadyQueues s (d, p))"
   unfolding valid_bitmapQ_def by simp
 
 lemma getReadyQueuesL2Bitmap_inv[wp]:
@@ -1488,24 +1470,22 @@ lemma getReadyQueuesL2Bitmap_inv[wp]:
 
 lemma switchToThread_lookupBitmapPriority_wp:
   "\<lbrace>\<lambda>s. invs_no_cicd' s \<and> bitmapQ (ksCurDomain s) (lookupBitmapPriority (ksCurDomain s) s) s \<and>
-        t = hd (ksReadyQueues s (ksCurDomain s, lookupBitmapPriority (ksCurDomain s) s)) \<rbrace>
+        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 ; 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 elim: obj_at'_weaken simp: inQ_def tcb_in_cur_domain'_def st_tcb_at'_def)
-    done
-  thus ?thesis
-    by (wp switchToThread_invs_no_cicd') (fastforce dest: invs_no_cicd'_queues)
-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_no_cicd':
   "\<lbrace>invs_no_cicd'\<rbrace> switchToIdleThread \<lbrace>\<lambda>rv. invs'\<rbrace>"
@@ -1604,8 +1584,9 @@ lemma guarded_switch_to_corres:
                 and valid_vspace_objs and pspace_aligned and pspace_distinct
                 and valid_vs_lookup and valid_global_objs and pspace_in_kernel_window
                 and unique_table_refs
-                and st_tcb_at runnable t and valid_etcbs and (\<lambda>s. sym_refs (state_hyp_refs_of s)))
-             (no_0_obj' and Invariants_H.valid_queues)
+                and st_tcb_at runnable t and valid_etcbs and (\<lambda>s. sym_refs (state_hyp_refs_of s))
+                and valid_queues and valid_idle)
+             (no_0_obj' and sym_heap_sched_pointers and valid_objs')
              (guarded_switch_to t) (switchToThread t)"
   apply (simp add: guarded_switch_to_def)
   apply (rule corres_guard_imp)
@@ -1650,7 +1631,7 @@ lemma curDomain_corres: "corres (=) \<top> \<top> (gets cur_domain) (curDomain)"
 
 lemma curDomain_corres':
   "corres (=) \<top> (\<lambda>s. ksCurDomain s \<le> maxDomain)
-    (gets cur_domain) (if 1 < numDomains then curDomain else return 0)"
+    (gets cur_domain) (if Suc 0 < numDomains then curDomain else return 0)"
   apply (case_tac "1 < numDomains"; simp)
    apply (rule corres_guard_imp[OF curDomain_corres]; solves simp)
   (* if we have only one domain, then we are in it *)
@@ -1660,27 +1641,32 @@ lemma curDomain_corres':
 
 lemma lookupBitmapPriority_Max_eqI:
   "\<lbrakk> valid_bitmapQ s ; bitmapQ_no_L1_orphans s ; ksReadyQueuesL1Bitmap s d \<noteq> 0 \<rbrakk>
-   \<Longrightarrow> lookupBitmapPriority d s = (Max {prio. ksReadyQueues s (d, prio) \<noteq> []})"
+   \<Longrightarrow> lookupBitmapPriority d s = (Max {prio. \<not> tcbQueueEmpty (ksReadyQueues s (d, prio))})"
   apply (rule Max_eqI[simplified eq_commute]; simp)
    apply (fastforce simp: bitmapL1_highest_lookup valid_bitmapQ_bitmapQ_simp)
   apply (metis valid_bitmapQ_bitmapQ_simp bitmapQ_from_bitmap_lookup)
   done
 
 lemma corres_gets_queues_getReadyQueuesL1Bitmap:
-  "corres (\<lambda>qs l1. ((l1 = 0) = (\<forall>p. qs p = []))) \<top> valid_queues
+  "corres (\<lambda>qs l1. (l1 = 0) = (\<forall>p. qs p = [])) \<top> valid_bitmaps
     (gets (\<lambda>s. ready_queues s d)) (getReadyQueuesL1Bitmap d)"
-  unfolding state_relation_def valid_queues_def getReadyQueuesL1Bitmap_def
-  by (clarsimp simp: bitmapL1_zero_ksReadyQueues ready_queues_relation_def)
+  unfolding state_relation_def valid_bitmaps_def getReadyQueuesL1Bitmap_def
+  apply (clarsimp simp: ready_queues_relation_def ready_queue_relation_def Let_def)
+  apply (drule_tac x=d in spec)
+  apply (fastforce simp: bitmapL1_zero_ksReadyQueues list_queue_relation_def tcbQueueEmpty_def)
+  done
 
 lemma guarded_switch_to_chooseThread_fragment_corres:
   "corres dc
     (P and st_tcb_at runnable t and invs and valid_sched)
-    (P' and st_tcb_at' runnable' t and invs_no_cicd')
-          (guarded_switch_to t)
-          (do runnable \<leftarrow> isRunnable t;
-              y \<leftarrow> assert runnable;
-              ThreadDecls_H.switchToThread t
-           od)"
+    (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)
@@ -1695,35 +1681,50 @@ lemma guarded_switch_to_chooseThread_fragment_corres:
               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'
+   \<Longrightarrow> Max {prio. ready_queues s d prio \<noteq> []}
+       = Max {prio. \<not> tcbQueueEmpty (ksReadyQueues s' (d, prio))}"
+  apply (clarsimp simp: ready_queues_relation_def ready_queue_relation_def Let_def
+                        list_queue_relation_def tcbQueueEmpty_def)
+  apply (rule Max_eq_if)
+     apply fastforce
+    apply fastforce
+   apply (fastforce dest: heap_path_head)
+  apply clarsimp
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=b in spec)
+  apply force
+  done
+
 lemma bitmap_lookup_queue_is_max_non_empty:
-  "\<lbrakk> valid_queues s'; (s, s') \<in> state_relation; invs s;
+  "\<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 all_invs_but_ct_idle_or_in_cur_domain'_def 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 \<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 (simp add: valid_queues_no_bitmap_def)
-   apply (erule_tac x="ksCurDomain s" in allE)
-   apply (erule_tac x="lookupBitmapPriority (ksCurDomain s) s" in allE)
-   apply (clarsimp simp: st_tcb_at'_def)
-   apply (erule obj_at'_weaken)
-   apply simp
-   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>"
@@ -1735,52 +1736,72 @@ lemma invs_no_cicd_ksCurDomain_maxDomain':
   "invs_no_cicd' s \<Longrightarrow> ksCurDomain s \<le> maxDomain"
   unfolding invs_no_cicd'_def by simp
 
+crunches curDomain
+  for valid_bitmaps[wp]: valid_bitmaps
+
 lemma chooseThread_corres:
-  "corres dc (invs and valid_sched) (invs_no_cicd')
-     choose_thread chooseThread" (is "corres _ ?PREI ?PREH _ _")
+  "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
-  unfolding choose_thread_def chooseThread_def
-  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> 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 dest!: invs_no_cicd'_queues simp: bitmap_lookup_queue_is_max_non_empty)
-              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 (clarsimp simp: if_apply_def2)
-      apply (wp hoare_vcg_conj_lift hoare_vcg_imp_lift ksReadyQueuesL1Bitmap_return_wp)
-     apply (wpsimp wp: curDomain_or_return_0 simp: curDomain_def)+
-    apply (fastforce simp: invs_no_cicd'_def)
-   apply (clarsimp simp: valid_sched_def DetSchedInvs_AI.valid_queues_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 (simp add: invs_no_cicd_ksCurDomain_maxDomain')
-  apply (clarsimp dest!: invs_no_cicd'_queues)
-  apply (fastforce intro: ksReadyQueuesL1Bitmap_st_tcb_at')
-  done
+    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 (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 =
@@ -1869,7 +1890,7 @@ lemma isHighestPrio_corres:
   assumes "d' = d"
   assumes "p' = p"
   shows
-    "corres ((=)) \<top> valid_queues
+    "corres ((=)) \<top> valid_bitmaps
       (gets (is_highest_prio d p))
       (isHighestPrio d' p')"
   using assms
@@ -1879,18 +1900,16 @@ lemma isHighestPrio_corres:
     apply (rule corres_split[OF corres_gets_queues_getReadyQueuesL1Bitmap])
       apply (rule corres_if_r'[where P'="\<lambda>_. True",rotated])
        apply (rule_tac corres_symb_exec_r)
-              apply (rule_tac
-                       P="\<lambda>s. q = ready_queues s d
-                              " and
-                       P'="\<lambda>s. valid_queues s \<and>
-                               l1 = ksReadyQueuesL1Bitmap s d \<and>
-                               l1 \<noteq> 0 \<and> hprio = lookupBitmapPriority d s" and
-                       F="hprio = Max {prio. q prio \<noteq> []}" in corres_req)
-              apply (elim conjE)
-              apply (clarsimp simp: valid_queues_def)
-              apply (subst lookupBitmapPriority_Max_eqI; blast?)
-              apply (fastforce simp: ready_queues_relation_def dest!: state_relationD)
-             apply fastforce
+          apply (rule_tac P="\<lambda>s. q = ready_queues s d"
+                      and P'="\<lambda>s. valid_bitmaps s \<and> l1 = ksReadyQueuesL1Bitmap s d \<and>
+                                  l1 \<noteq> 0 \<and> hprio = lookupBitmapPriority d s"
+                      and F="hprio = Max {prio. q prio \<noteq> []}" in corres_req)
+           apply (elim conjE)
+           apply (clarsimp simp: valid_bitmaps_def)
+           apply (subst lookupBitmapPriority_Max_eqI; blast?)
+           apply (fastforce dest: state_relation_ready_queues_relation Max_prio_helper[where d=d]
+                            simp: tcbQueueEmpty_def)
+          apply fastforce
          apply (wpsimp simp: if_apply_def2 wp: hoare_drop_imps ksReadyQueuesL1Bitmap_return_wp)+
   done
 
@@ -1901,9 +1920,8 @@ crunch inv[wp]: curDomain P
 crunch inv[wp]: scheduleSwitchThreadFastfail P
 
 lemma setSchedulerAction_invs': (* not in wp set, clobbered by ssa_wp *)
-  "\<lbrace>\<lambda>s. invs' s \<rbrace> setSchedulerAction ChooseNewThread \<lbrace>\<lambda>_. invs' \<rbrace>"
+  "setSchedulerAction ChooseNewThread \<lbrace>invs' \<rbrace>"
   by (wpsimp simp: invs'_def cur_tcb'_def valid_state'_def valid_irq_node'_def ct_not_inQ_def
-                   valid_queues_def valid_queues_no_bitmap_def valid_queues'_def
                    ct_idle_or_in_cur_domain'_def)
 
 lemma scheduleChooseNewThread_corres:
@@ -1933,6 +1951,46 @@ lemma ethread_get_when_corres:
   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
+
+crunches 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)
+
+crunches 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)
+
 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]
@@ -1961,7 +2019,7 @@ lemma schedule_corres:
          apply (rule corres_split[OF thread_get_isRunnable_corres])
            apply (rule corres_split)
               apply (rule corres_when, simp)
-              apply (rule tcbSchedEnqueue_corres)
+              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)+
@@ -1970,7 +2028,7 @@ lemma schedule_corres:
                 rename_tac was_running wasRunning)
           apply (rule corres_split)
              apply (rule corres_when, simp)
-             apply (rule tcbSchedEnqueue_corres)
+             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)
@@ -1986,7 +2044,7 @@ lemma schedule_corres:
                     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])
+                         apply (rule corres_split[OF tcbSchedEnqueue_corres], simp)
                            apply (simp, fold dc_def)
                            apply (rule corres_split)
                               apply (rule setSchedulerAction_corres; simp)
@@ -2000,7 +2058,7 @@ lemma schedule_corres:
                           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])
+                         apply (rule corres_split[OF tcbSchedAppend_corres], simp)
                            apply (simp, fold dc_def)
                            apply (rule corres_split)
                               apply (rule setSchedulerAction_corres; simp)
@@ -2032,7 +2090,8 @@ lemma schedule_corres:
                     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)+
+                     del: gets_wp
+                  | strengthen valid_objs'_valid_tcbs')+
        apply (clarsimp simp: conj_ac if_apply_def2 cong: imp_cong conj_cong del: hoare_gets)
        apply (wp gets_wp)+
 
@@ -2055,14 +2114,13 @@ lemma schedule_corres:
                                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 invs_hyp_sym_refs)
-        apply (clarsimp simp add: pred_tcb_at_def obj_at_def is_tcb valid_idle_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)+
-     apply (simp add: valid_sched_def valid_blocked_def valid_blocked_except_def)
      done
 
   (* haskell final subgoal *)
@@ -2080,11 +2138,8 @@ proof -
     apply (simp add: setSchedulerAction_def)
     apply wp
     apply (clarsimp simp add: invs'_def valid_state'_def cur_tcb'_def
-                              Invariants_H.valid_queues_def
-                              state_refs_of'_def ps_clear_def
-                              valid_irq_node'_def valid_queues'_def
-                              tcb_in_cur_domain'_def ct_idle_or_in_cur_domain'_def
-                              bitmapQ_defs valid_queues_no_bitmap_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
@@ -2124,7 +2179,7 @@ lemma switchToThread_ct_not_queued_2:
   apply (simp add: Thread_H.switchToThread_def)
   apply (wp)
     apply (simp add: AARCH64_H.switchToThread_def setCurThread_def)
-    apply (wp tcbSchedDequeue_not_tcbQueued | simp )+
+    apply (wp tcbSchedDequeue_not_tcbQueued hoare_drop_imp | simp)+
   done
 
 lemma setCurThread_obj_at':
@@ -2138,11 +2193,12 @@ proof -
 qed
 
 lemma switchToIdleThread_ct_not_queued_no_cicd':
-  "\<lbrace> invs_no_cicd' \<rbrace> switchToIdleThread \<lbrace>\<lambda>rv s. obj_at' (Not \<circ> tcbQueued) (ksCurThread s) s \<rbrace>"
+  "\<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 (rule idle'_not_tcbQueued')
-  apply (simp add: invs_no_cicd'_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]:
@@ -2159,7 +2215,7 @@ lemma switchToThread_tcb_in_cur_domain':
    ThreadDecls_H.switchToThread thread
    \<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)
+  apply (wpsimp wp: tcbSchedDequeue_not_tcbQueued hoare_drop_imps)
   done
 
 lemma chooseThread_invs_no_cicd'_posts: (* generic version *)
@@ -2181,11 +2237,14 @@ proof -
     by (simp add: all_invs_but_ct_idle_or_in_cur_domain'_def maxDomain_def)
 
   show ?thesis
-    unfolding chooseThread_def Let_def curDomain_def
+    apply (clarsimp simp: chooseThread_def Let_def curDomain_def)
+    apply (rule hoare_seq_ext[OF _ stateAssert_sp])+
     apply (simp only: return_bind, simp)
-    apply (rule hoare_seq_ext[where B="\<lambda>rv s. invs_no_cicd' s \<and> rv = ksCurDomain s"])
+    apply (rule hoare_seq_ext[where B="\<lambda>rv s. invs_no_cicd' s \<and> rv = ksCurDomain s
+                                              \<and> ksReadyQueues_asrt s \<and> ready_qs_runnable s"])
      apply (rule_tac B="\<lambda>rv s. invs_no_cicd' s \<and> curdom = ksCurDomain s \<and>
-                               rv = ksReadyQueuesL1Bitmap s curdom" in hoare_seq_ext)
+                               rv = ksReadyQueuesL1Bitmap s curdom \<and>
+                               ksReadyQueues_asrt s \<and> ready_qs_runnable s" in hoare_seq_ext)
       apply (rename_tac l1)
       apply (case_tac "l1 = 0")
        (* switch to idle thread *)
@@ -2199,12 +2258,10 @@ proof -
       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
-      apply (clarsimp dest!: invs_no_cicd'_queues
-                      simp: valid_queues_def lookupBitmapPriority_def[symmetric])
-      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 (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
@@ -2243,11 +2300,14 @@ proof -
 
   (* FIXME this is almost identical to the chooseThread_invs_no_cicd'_posts proof, can generalise? *)
   show ?thesis
-    unfolding chooseThread_def Let_def curDomain_def
+    apply (clarsimp simp: chooseThread_def Let_def curDomain_def)
+    apply (rule hoare_seq_ext[OF _ stateAssert_sp])+
     apply (simp only: return_bind, simp)
-    apply (rule hoare_seq_ext[where B="\<lambda>rv s. invs_no_cicd' s \<and> rv = ksCurDomain s"])
+    apply (rule hoare_seq_ext[where B="\<lambda>rv s. invs_no_cicd' s \<and> rv = ksCurDomain s
+                                              \<and> ksReadyQueues_asrt s \<and> ready_qs_runnable s"])
      apply (rule_tac B="\<lambda>rv s. invs_no_cicd' s \<and> curdom = ksCurDomain s \<and>
-                               rv = ksReadyQueuesL1Bitmap s curdom" in hoare_seq_ext)
+                               rv = ksReadyQueuesL1Bitmap s curdom \<and>
+                               ksReadyQueues_asrt s \<and> ready_qs_runnable s" in hoare_seq_ext)
       apply (rename_tac l1)
       apply (case_tac "l1 = 0")
        (* switch to idle thread *)
@@ -2255,7 +2315,10 @@ proof -
       (* we have a thread to switch to *)
       apply (clarsimp simp: bitmap_fun_defs)
       apply (wp assert_inv)
-      apply (clarsimp dest!: invs_no_cicd'_queues simp: valid_queues_def)
+      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
@@ -2405,12 +2468,15 @@ lemma sbn_sch_act_sane:
 
 lemma possibleSwitchTo_corres:
   "corres dc
-          (valid_etcbs and weak_valid_sched_action and cur_tcb and st_tcb_at runnable t
-            and pspace_aligned and pspace_distinct)
-          (valid_queues and valid_queues' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
-            and valid_objs')
-          (possible_switch_to t)
-          (possibleSwitchTo t)"
+     (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)
@@ -2423,12 +2489,12 @@ lemma possibleSwitchTo_corres:
          apply (clarsimp simp: etcb_relation_def)
         apply (rule corres_split[OF getSchedulerAction_corres])
           apply (rule corres_if, simp)
-           apply (rule tcbSchedEnqueue_corres)
+           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)
-            apply (wp rescheduleRequired_valid_queues'_weak)+
+             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])+
@@ -2437,7 +2503,7 @@ lemma possibleSwitchTo_corres:
    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 (simp add: tcb_at_is_etcb_at)
+  apply (fastforce simp: tcb_at_is_etcb_at)
   done
 
 end
diff --git a/proof/refine/AARCH64/StateRelation.thy b/proof/refine/AARCH64/StateRelation.thy
index 43a6fce143..e8f13fae54 100644
--- a/proof/refine/AARCH64/StateRelation.thy
+++ b/proof/refine/AARCH64/StateRelation.thy
@@ -184,13 +184,20 @@ definition tcb_relation :: "Structures_A.tcb \<Rightarrow> Structures_H.tcb \<Ri
    \<and> tcb_bound_notification tcb = tcbBoundNotification tcb'
    \<and> tcb_mcpriority tcb = tcbMCP tcb'"
 
+\<comment> \<open>
+  A pair of objects @{term "(obj, obj')"} should satisfy the following relation when, under further
+  mild assumptions, a @{term corres_underlying} lemma for @{term "set_object obj"}
+  and @{term "setObject obj'"} can be stated: see setObject_other_corres in KHeap_R.
+
+  TCBs do not satisfy this relation because the tcbSchedPrev and tcbSchedNext fields of a TCB are
+  used to model the ready queues, and so an update to such a field would correspond to an update
+  to a ready queue (see ready_queues_relation below).\<close>
 definition
   other_obj_relation :: "Structures_A.kernel_object \<Rightarrow> Structures_H.kernel_object \<Rightarrow> bool"
 where
   "other_obj_relation obj obj' \<equiv>
    (case (obj, obj') of
-      (TCB tcb, KOTCB tcb') \<Rightarrow> tcb_relation tcb tcb'
-    | (Endpoint ep, KOEndpoint ep') \<Rightarrow> ep_relation ep ep'
+      (Endpoint ep, KOEndpoint ep') \<Rightarrow> ep_relation ep ep'
     | (Notification ntfn, KONotification ntfn') \<Rightarrow> ntfn_relation ntfn ntfn'
     | (ArchObj (AARCH64_A.ASIDPool ap), KOArch (KOASIDPool ap')) \<Rightarrow> asid_pool_relation ap ap'
     | (ArchObj (AARCH64_A.VCPU vcpu), KOArch (KOVCPU vcpu')) \<Rightarrow> vcpu_relation vcpu vcpu'
@@ -221,22 +228,28 @@ primrec aobj_relation_cuts :: "AARCH64_A.arch_kernel_obj \<Rightarrow> machine_w
 | "aobj_relation_cuts (AARCH64_A.VCPU v) x =
      {(x, other_obj_relation)}"
 
+definition tcb_relation_cut :: "Structures_A.kernel_object \<Rightarrow> kernel_object \<Rightarrow> bool" where
+  "tcb_relation_cut obj obj' \<equiv>
+   case (obj, obj') of
+       (TCB t, KOTCB t') \<Rightarrow> tcb_relation t t'
+     | _ \<Rightarrow> False"
+
 primrec obj_relation_cuts :: "Structures_A.kernel_object \<Rightarrow> machine_word \<Rightarrow> obj_relation_cuts" where
   "obj_relation_cuts (CNode sz cs) x =
      (if well_formed_cnode_n sz cs
       then {(cte_map (x, y), cte_relation y) | y. y \<in> dom cs}
       else {(x, \<bottom>\<bottom>)})"
-| "obj_relation_cuts (TCB tcb) x = {(x, other_obj_relation)}"
+| "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 (ArchObj ao) x = aobj_relation_cuts ao x"
 
-
 lemma obj_relation_cuts_def2:
   "obj_relation_cuts ko x =
    (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>)}
+             | TCB tcb \<Rightarrow> {(x, tcb_relation_cut)}
              | ArchObj (PageTable pt) \<Rightarrow> (\<lambda>y. (x + (y << pteBits), pte_relation y)) `
                                          {0..mask (ptTranslationBits (pt_type pt))}
              | ArchObj (DataPage dev sz) \<Rightarrow>
@@ -250,6 +263,7 @@ lemma obj_relation_cuts_def3:
   "obj_relation_cuts ko x =
    (case a_type ko of
       ACapTable n \<Rightarrow> {(cte_map (x, y), cte_relation y) | y. length y = n}
+    | ATCB \<Rightarrow> {(x, tcb_relation_cut)}
     | AArch (APageTable pt_t) \<Rightarrow> (\<lambda>y. (x + (y << pteBits), pte_relation y)) `
                                       {0..mask (ptTranslationBits pt_t)}
     | AArch (AUserData sz) \<Rightarrow> {(x + (n << pageBits), \<lambda>_ obj. obj = KOUserData)
@@ -265,6 +279,7 @@ definition is_other_obj_relation_type :: "a_type \<Rightarrow> bool" where
  "is_other_obj_relation_type tp \<equiv>
     case tp of
       ACapTable n \<Rightarrow> False
+    | ATCB \<Rightarrow> False
     | AArch (APageTable _) \<Rightarrow> False
     | AArch (AUserData _) \<Rightarrow> False
     | AArch (ADeviceData _) \<Rightarrow> False
@@ -279,6 +294,10 @@ lemma is_other_obj_relation_type_PageTable:
   "\<not> is_other_obj_relation_type (AArch (APageTable pt_t))"
   unfolding is_other_obj_relation_type_def by simp
 
+lemma is_other_obj_relation_type_TCB:
+  "\<not> is_other_obj_relation_type ATCB"
+  by (simp add: is_other_obj_relation_type_def)
+
 lemma is_other_obj_relation_type_UserData:
   "\<not> is_other_obj_relation_type (AArch (AUserData sz))"
   unfolding is_other_obj_relation_type_def by simp
@@ -318,10 +337,55 @@ primrec sched_act_relation :: "Deterministic_A.scheduler_action \<Rightarrow> sc
   "sched_act_relation choose_new_thread a' = (a' = ChooseNewThread)" |
   "sched_act_relation (switch_thread x) a' = (a' = SwitchToThread x)"
 
-definition ready_queues_relation ::
-  "(Deterministic_A.domain \<Rightarrow> Structures_A.priority \<Rightarrow> Deterministic_A.ready_queue) \<Rightarrow>
-   (domain \<times> priority \<Rightarrow> KernelStateData_H.ready_queue) \<Rightarrow> bool" where
-  "ready_queues_relation qs qs' \<equiv> \<forall>d p. (qs d p = qs' (d, p))"
+definition queue_end_valid :: "obj_ref list \<Rightarrow> tcb_queue \<Rightarrow> bool" where
+  "queue_end_valid ts q \<equiv>
+     (ts = [] \<longrightarrow> tcbQueueEnd q = None) \<and> (ts \<noteq> [] \<longrightarrow> tcbQueueEnd q = Some (last ts))"
+
+definition prev_queue_head :: "tcb_queue \<Rightarrow> (obj_ref \<rightharpoonup> 'a) \<Rightarrow> bool" where
+  "prev_queue_head q prevs \<equiv> \<forall>head. tcbQueueHead q = Some head \<longrightarrow> prevs head = None"
+
+lemma prev_queue_head_heap_upd:
+  "\<lbrakk>prev_queue_head q prevs; Some r \<noteq> tcbQueueHead q\<rbrakk> \<Longrightarrow> prev_queue_head q (prevs(r := x))"
+  by (clarsimp simp: prev_queue_head_def)
+
+definition list_queue_relation ::
+  "obj_ref list \<Rightarrow> tcb_queue \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> bool"
+  where
+  "list_queue_relation ts q nexts prevs \<equiv>
+     heap_ls nexts (tcbQueueHead q) ts \<and> queue_end_valid ts q \<and> prev_queue_head q prevs"
+
+lemma list_queue_relation_nil:
+  "list_queue_relation ts q nexts prevs \<Longrightarrow> ts = [] \<longleftrightarrow> tcbQueueEmpty q"
+  by (fastforce dest: heap_path_head simp: tcbQueueEmpty_def list_queue_relation_def)
+
+definition ready_queue_relation ::
+  "Deterministic_A.domain \<Rightarrow> Structures_A.priority
+   \<Rightarrow> Deterministic_A.ready_queue \<Rightarrow> ready_queue
+   \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref)
+   \<Rightarrow> (obj_ref \<Rightarrow> bool) \<Rightarrow> bool"
+  where
+  "ready_queue_relation d p q q' nexts prevs flag \<equiv>
+     list_queue_relation q q' nexts prevs
+     \<and> (\<forall>t. flag t \<longleftrightarrow> t \<in> set q)
+     \<and> (d > maxDomain \<or> p > maxPriority \<longrightarrow> tcbQueueEmpty q')"
+
+definition ready_queues_relation_2 ::
+  "(Deterministic_A.domain \<Rightarrow> Structures_A.priority \<Rightarrow> Deterministic_A.ready_queue)
+   \<Rightarrow> (domain \<times> priority \<Rightarrow> ready_queue)
+   \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref)
+   \<Rightarrow> (domain \<Rightarrow> priority \<Rightarrow> obj_ref \<Rightarrow> bool) \<Rightarrow> bool"
+  where
+  "ready_queues_relation_2 qs qs' nexts prevs inQs \<equiv>
+     \<forall>d p. let q = qs d p; q' = qs' (d, p); flag = inQs d p in
+           ready_queue_relation d p q q' nexts prevs flag"
+
+abbreviation ready_queues_relation :: "det_state \<Rightarrow> kernel_state \<Rightarrow> bool" where
+  "ready_queues_relation s s' \<equiv>
+     ready_queues_relation_2
+      (ready_queues s) (ksReadyQueues s') (tcbSchedNexts_of s') (tcbSchedPrevs_of s')
+      (\<lambda>d p. inQ d p |< tcbs_of' s')"
+
+lemmas ready_queues_relation_def = ready_queues_relation_2_def
 
 definition ghost_relation ::
   "Structures_A.kheap \<Rightarrow> (machine_word \<rightharpoonup> vmpage_size) \<Rightarrow> (machine_word \<rightharpoonup> nat) \<Rightarrow> (machine_word \<rightharpoonup> pt_type) \<Rightarrow> bool" where
@@ -381,6 +445,8 @@ lemma obj_relation_cutsE:
      \<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>tcb tcb'. \<lbrakk> y = x; ko = TCB tcb; ko' = KOTCB tcb'; tcb_relation tcb tcb' \<rbrakk>
+               \<Longrightarrow> R;
      \<And>pt z pte'. \<lbrakk> ko = ArchObj (PageTable pt); y = x + (z << pteBits);
                    z \<le> mask (ptTranslationBits (pt_type pt)); ko' = KOArch (KOPTE pte');
                    pte_relation' (pt_apply pt z) pte' \<rbrakk>
@@ -391,8 +457,9 @@ lemma obj_relation_cutsE:
             \<lbrakk> y = x; other_obj_relation ko ko'; is_other_obj_relation_type (a_type ko) \<rbrakk> \<Longrightarrow> R
     \<rbrakk> \<Longrightarrow> R"
   by (force simp: obj_relation_cuts_def2 is_other_obj_relation_type_def a_type_def
-                  cte_relation_def pte_relation_def
-            split: Structures_A.kernel_object.splits if_splits AARCH64_A.arch_kernel_obj.splits)
+                  cte_relation_def pte_relation_def tcb_relation_cut_def
+            split: Structures_A.kernel_object.splits kernel_object.splits if_splits
+                   AARCH64_A.arch_kernel_obj.splits)
 
 lemma eq_trans_helper:
   "\<lbrakk> x = y; P y = Q \<rbrakk> \<Longrightarrow> P x = Q"
@@ -460,7 +527,7 @@ definition state_relation :: "(det_state \<times> kernel_state) set" where
          pspace_relation (kheap s) (ksPSpace s')
        \<and> ekheap_relation (ekheap s) (ksPSpace s')
        \<and> sched_act_relation (scheduler_action s) (ksSchedulerAction s')
-       \<and> ready_queues_relation (ready_queues s) (ksReadyQueues s')
+       \<and> ready_queues_relation s s'
        \<and> ghost_relation (kheap s) (gsUserPages s') (gsCNodes s') (gsPTTypes (ksArchState 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')
@@ -482,6 +549,10 @@ lemma curthread_relation:
   "(a, b) \<in> state_relation \<Longrightarrow> ksCurThread b = cur_thread a"
   by (simp add: state_relation_def)
 
+lemma curdomain_relation[elim!]:
+  "(s, s') \<in> state_relation \<Longrightarrow> cur_domain s = ksCurDomain s'"
+  by (clarsimp simp: state_relation_def)
+
 lemma state_relation_pspace_relation[elim!]:
   "(s,s') \<in> state_relation \<Longrightarrow> pspace_relation (kheap s) (ksPSpace s')"
   by (simp add: state_relation_def)
@@ -490,12 +561,24 @@ lemma state_relation_ekheap_relation[elim!]:
   "(s,s') \<in> state_relation \<Longrightarrow> ekheap_relation (ekheap s) (ksPSpace s')"
   by (simp add: state_relation_def)
 
+lemma state_relation_sched_act_relation[elim!]:
+  "(s,s') \<in> state_relation \<Longrightarrow> sched_act_relation (scheduler_action s) (ksSchedulerAction s')"
+  by (clarsimp simp: state_relation_def)
+
+lemma state_relation_ready_queues_relation[elim!]:
+  "(s, s') \<in> state_relation \<Longrightarrow> ready_queues_relation s s'"
+  by (simp add: state_relation_def)
+
+lemma state_relation_idle_thread[elim!]:
+  "(s, s') \<in> state_relation \<Longrightarrow> idle_thread s = ksIdleThread s'"
+  by (clarsimp simp: state_relation_def)
+
 lemma state_relationD:
   "(s, s') \<in> state_relation \<Longrightarrow>
    pspace_relation (kheap s) (ksPSpace s') \<and>
    ekheap_relation (ekheap s) (ksPSpace s') \<and>
    sched_act_relation (scheduler_action s) (ksSchedulerAction s') \<and>
-   ready_queues_relation (ready_queues s) (ksReadyQueues s') \<and>
+   ready_queues_relation s s' \<and>
    ghost_relation (kheap s) (gsUserPages s') (gsCNodes s') (gsPTTypes (ksArchState 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>
@@ -517,7 +600,7 @@ lemma state_relationE [elim?]:
   and rl: "\<lbrakk> pspace_relation (kheap s) (ksPSpace s');
              ekheap_relation (ekheap s) (ksPSpace s');
              sched_act_relation (scheduler_action s) (ksSchedulerAction s');
-             ready_queues_relation (ready_queues s) (ksReadyQueues s');
+             ready_queues_relation s s';
              ghost_relation (kheap s) (gsUserPages s') (gsCNodes s') (gsPTTypes (ksArchState 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');
diff --git a/proof/refine/AARCH64/Syscall_R.thy b/proof/refine/AARCH64/Syscall_R.thy
index f64f361d95..3fa35533cd 100644
--- a/proof/refine/AARCH64/Syscall_R.thy
+++ b/proof/refine/AARCH64/Syscall_R.thy
@@ -352,15 +352,13 @@ lemma threadSet_tcbDomain_update_sch_act_wf[wp]:
 lemma setDomain_corres:
   "corres dc
      (valid_etcbs and valid_sched and tcb_at tptr and pspace_aligned and pspace_distinct)
-     (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)"
+     (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 corres_guard_imp)
     apply (rule corres_split[OF getCurThread_corres])
-      apply (rule corres_split[OF tcbSchedDequeue_corres])
+      apply (rule corres_split[OF tcbSchedDequeue_corres], simp)
         apply (rule corres_split)
            apply (rule ethread_set_corres; simp)
            apply (clarsimp simp: etcb_relation_def)
@@ -369,26 +367,38 @@ lemma setDomain_corres:
             apply (rule corres_split)
                apply clarsimp
                apply (rule corres_when[OF refl])
-               apply (rule tcbSchedEnqueue_corres)
+               apply (rule tcbSchedEnqueue_corres, simp)
               apply (rule corres_when[OF refl])
               apply (rule rescheduleRequired_corres)
-             apply ((wp hoare_drop_imps hoare_vcg_conj_lift | clarsimp| assumption)+)[5]
-        apply clarsimp
-        apply (rule_tac Q="\<lambda>_. valid_objs' and valid_queues' and valid_queues and
-          (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and tcb_at' tptr"
-          in hoare_strengthen_post[rotated])
-         apply (auto simp: invs'_def valid_state'_def sch_act_wf_weak st_tcb_at'_def o_def)[1]
-        apply (wp threadSet_valid_objs' threadSet_valid_queues'_no_state
-          threadSet_valid_queues_no_state
-          threadSet_pred_tcb_no_state | simp)+
-      apply (rule_tac Q = "\<lambda>r s. invs' s \<and> (\<forall>p. tptr \<notin> set (ksReadyQueues s p)) \<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)
-       apply (drule(1) bspec)
-       apply (clarsimp simp:tcb_cte_cases_def cteSizeBits_def)
+             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 Tcb_R.tcbSchedDequeue_not_in_queue)+
+      apply (wp hoare_vcg_all_lift tcbSchedDequeue_not_queued)+
    apply clarsimp
    apply (frule tcb_at_is_etcb_at)
     apply simp+
@@ -396,7 +406,6 @@ lemma setDomain_corres:
                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> (=))
@@ -761,90 +770,71 @@ 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>rv. invs'\<rbrace>"
+   doReplyTransfer t' t slot grant
+   \<lbrace>\<lambda>_. invs'\<rbrace>"
   apply (simp add: doReplyTransfer_def liftM_def)
   apply (rule hoare_seq_ext [OF _ gts_sp'])
   apply (rule hoare_seq_ext [OF _ assert_sp])
   apply (rule hoare_seq_ext [OF _ getCTE_sp])
   apply (wp, wpc)
-        apply (wp)
+        apply wp
           apply (wp (once) sts_invs_minor'')
-          apply (simp)
+          apply simp
           apply (wp (once) sts_st_tcb')
-          apply (wp)[1]
-         apply (rule_tac Q="\<lambda>rv s. invs' s
-                                   \<and> t \<noteq> ksIdleThread s
-                                   \<and> st_tcb_at' awaiting_reply' t s"
+          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 (frule_tac t=t in invs'_not_runnable_not_queued)
-           apply (erule pred_tcb'_weakenE, case_tac st, clarsimp+)
+          apply clarsimp
           apply (rule conjI, erule pred_tcb'_weakenE, case_tac st, clarsimp+)
-          apply (rule conjI, rule impI, erule pred_tcb'_weakenE, case_tac st)
-                  apply (clarsimp | drule(1) obj_at_conj')+
           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 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 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])
+                               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 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>rv 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 (frule_tac t=t in invs'_not_runnable_not_queued)
-               apply (erule pred_tcb'_weakenE, case_tac st, clarsimp+)
+             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 (rule conjI, rule impI, erule pred_tcb'_weakenE, case_tac st)
-                      apply (clarsimp | drule(1) obj_at_conj')+
               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 clarsimp
               apply (erule_tac P="\<lambda>st. awaiting_reply' st \<and> activatable' st"
-                      in pred_tcb'_weakenE)
+                            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 clarsimp
             apply (rule conjI)
-             apply (clarsimp simp: invs'_def valid_state'_def valid_idle'_def)
-             apply (rule conjI)
-              apply clarsimp
-             apply (clarsimp simp: obj_at'_def idle_tcb'_def pred_tcb_at'_def)
+             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 (rule conjI)
              apply (clarsimp simp : invs'_def valid_state'_def valid_idle'_def pred_tcb_at'_def
                                     obj_at'_def idle_tcb'_def)
-            apply (rule conjI)
-             apply clarsimp
-             apply (frule invs'_not_runnable_not_queued)
-              apply (erule pred_tcb'_weakenE, clarsimp)
-             apply (frule (1) not_tcbQueued_not_ksQ)
-             apply simp
-            apply clarsimp
            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)
@@ -854,35 +844,9 @@ lemma ct_active_runnable' [simp]:
   "ct_active' s \<Longrightarrow> ct_in_state' runnable' s"
   by (fastforce simp: ct_in_state'_def elim!: pred_tcb'_weakenE)
 
-lemma valid_irq_node_tcbSchedEnqueue[wp]:
-  "\<lbrace>\<lambda>s. valid_irq_node' (irq_node' s) s \<rbrace> tcbSchedEnqueue ptr
-  \<lbrace>\<lambda>rv s'. valid_irq_node' (irq_node' s') s'\<rbrace>"
-  apply (rule hoare_pre)
-  apply (simp add:valid_irq_node'_def )
-  apply (wp unless_wp hoare_vcg_all_lift | wps)+
-  apply (simp add:tcbSchedEnqueue_def)
-  apply (wp unless_wp| simp)+
-  apply (simp add:valid_irq_node'_def)
-  done
-
-lemma rescheduleRequired_valid_queues_but_ct_domain:
-  "\<lbrace>\<lambda>s. Invariants_H.valid_queues s \<and> valid_objs' s
-     \<and> (\<forall>x. ksSchedulerAction s = SwitchToThread x \<longrightarrow> st_tcb_at' runnable' x s) \<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | wpc | simp)+
-  done
-
-lemma rescheduleRequired_valid_queues'_but_ct_domain:
-  "\<lbrace>\<lambda>s. valid_queues' s
-     \<and> (\<forall>x. ksSchedulerAction s = SwitchToThread x \<longrightarrow> st_tcb_at' runnable' x s)
-   \<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | wpc | simp | fastforce simp: valid_queues'_def)+
-  done
+crunches tcbSchedEnqueue
+  for valid_irq_node[wp]: "\<lambda>s. valid_irq_node' (irq_node' s) s"
+  (rule: valid_irq_node_lift)
 
 lemma tcbSchedEnqueue_valid_action:
   "\<lbrace>\<lambda>s. \<forall>x. ksSchedulerAction s = SwitchToThread x \<longrightarrow> st_tcb_at' runnable' x s\<rbrace>
@@ -893,10 +857,11 @@ lemma tcbSchedEnqueue_valid_action:
   done
 
 abbreviation (input) "all_invs_but_sch_extra \<equiv>
-    \<lambda>s. valid_pspace' s \<and> Invariants_H.valid_queues s \<and>
+    \<lambda>s. valid_pspace' s \<and>
     sym_refs (state_refs_of' s) \<and>
     sym_refs (state_hyp_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>
@@ -908,7 +873,7 @@ abbreviation (input) "all_invs_but_sch_extra \<equiv>
     valid_machine_state' s \<and>
     cur_tcb' s \<and>
     untyped_ranges_zero' s \<and>
-    valid_queues' s \<and> pspace_domain_valid 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)"
 
@@ -919,15 +884,13 @@ lemma rescheduleRequired_all_invs_but_extra:
   apply (simp add: invs'_def valid_state'_def)
   apply (wp add: rescheduleRequired_ct_not_inQ
                  rescheduleRequired_sch_act'
-                 rescheduleRequired_valid_queues_but_ct_domain
-                 rescheduleRequired_valid_queues'_but_ct_domain
                  valid_irq_node_lift valid_irq_handlers_lift''
                  irqs_masked_lift cur_tcb_lift)
   apply auto
   done
 
 lemma threadSet_all_invs_but_sch_extra:
-  shows      "\<lbrace> tcb_at' t and (\<lambda>s. (\<forall>p. t \<notin> set (ksReadyQueues s p))) and
+  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
@@ -948,13 +911,11 @@ lemma threadSet_all_invs_but_sch_extra:
      valid_irq_handlers_lift''
      threadSet_ctes_ofT
      threadSet_not_inQ
-     threadSet_valid_queues'_no_state
      threadSet_tcbDomain_update_ct_idle_or_in_cur_domain'
-     threadSet_valid_queues
      threadSet_valid_dom_schedule'
      threadSet_iflive'T
      threadSet_ifunsafe'T
-     untyped_ranges_zero_lift
+     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)
@@ -982,9 +943,7 @@ lemma setDomain_invs':
       \<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 (erule st_tcb_ex_cap'')
        apply simp
-      apply (case_tac st,simp_all)[1]
      apply (rule hoare_strengthen_post[OF hoare_vcg_conj_lift])
        apply (rule threadSet_all_invs_but_sch_extra)
       prefer 2
@@ -1002,17 +961,14 @@ lemma setDomain_invs':
   done
 
 lemma performInv_invs'[wp]:
-  "\<lbrace>invs' and sch_act_simple
-          and (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))
-          and ct_active' and valid_invocation' i\<rbrace>
-     RetypeDecls_H.performInvocation block call i \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  "\<lbrace>invs' and sch_act_simple and ct_active' and valid_invocation' i\<rbrace>
+   RetypeDecls_H.performInvocation block call i
+   \<lbrace>\<lambda>_. invs'\<rbrace>"
   unfolding performInvocation_def
   apply (cases i)
-  apply ((clarsimp simp: simple_sane_strg sch_act_simple_def
-                         ct_not_ksQ sch_act_sane_def
-                  | wp tcbinv_invs' arch_performInvocation_invs'
-                       setDomain_invs'
-                  | rule conjI | erule active_ex_cap')+)
+  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]:
@@ -1240,7 +1196,6 @@ lemma handleInvocation_corres:
                                       and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)"
                          in hoare_post_imp)
                apply (clarsimp simp: ct_in_state'_def)
-               apply (frule(1) ct_not_ksQ)
                apply (clarsimp)
               apply (wp setThreadState_nonqueued_state_update
                         setThreadState_st_tcb setThreadState_rct)[1]
@@ -1252,14 +1207,13 @@ lemma handleInvocation_corres:
                          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)
+   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)
   apply (frule tcb_at_invs')
   apply (clarsimp simp: invs'_def valid_state'_def
                         ct_in_state'_def ct_not_inQ_def)
-  apply (frule(1) valid_queues_not_tcbQueued_not_ksQ)
   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)
@@ -1319,11 +1273,8 @@ lemma hinv_invs'[wp]:
                                 and st_tcb_at' active' thread"
                   in hoare_post_imp)
         apply (clarsimp simp: ct_in_state'_def)
-        apply (frule(1) ct_not_ksQ)
-        apply (clarsimp)
        apply (wp sts_invs_minor' setThreadState_st_tcb setThreadState_rct | simp)+
     apply (clarsimp)
-    apply (frule(1) ct_not_ksQ)
     apply (fastforce simp add: tcb_at_invs' ct_in_state'_def
                               simple_sane_strg
                               sch_act_simple_def
@@ -1467,7 +1418,6 @@ lemma handleRecv_isBlocking_corres':
                     and (\<lambda>s. ex_nonz_cap_to (cur_thread s) s))
               (invs' and ct_in_state' simple'
                      and sch_act_sane
-                     and (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))
                      and (\<lambda>s. ex_nonz_cap_to' (ksCurThread s) s))
                     (handle_recv isBlocking) (handleRecv isBlocking)"
   (is "corres dc (?pre1) (?pre2) (handle_recv _) (handleRecv _)")
@@ -1530,8 +1480,7 @@ lemma handleRecv_isBlocking_corres':
 
 lemma handleRecv_isBlocking_corres:
   "corres dc (einvs and ct_active)
-             (invs' and ct_active' and sch_act_sane and
-                    (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)))
+             (invs' and ct_active' and sch_act_sane)
             (handle_recv isBlocking) (handleRecv isBlocking)"
   apply (rule corres_guard_imp)
     apply (rule handleRecv_isBlocking_corres')
@@ -1546,42 +1495,27 @@ lemma lookupCap_refs[wp]:
   "\<lbrace>invs'\<rbrace> lookupCap t ref \<lbrace>\<lambda>rv s. \<forall>r\<in>zobj_refs' rv. ex_nonz_cap_to' r s\<rbrace>,-"
   by (simp add: lookupCap_def split_def | wp | simp add: o_def)+
 
-lemma deleteCallerCap_ksQ_ct':
-  "\<lbrace>invs' and ct_in_state' simple' and sch_act_sane and
-     (\<lambda>s. ksCurThread s \<notin> set (ksReadyQueues s p) \<and> thread = ksCurThread s)\<rbrace>
-      deleteCallerCap thread
-   \<lbrace>\<lambda>rv s. thread \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (rule_tac Q="\<lambda>rv s. thread = ksCurThread s \<and> ksCurThread s \<notin> set (ksReadyQueues s p)"
-            in hoare_strengthen_post)
-   apply (wp deleteCallerCap_ct_not_ksQ)
-    apply auto
-  done
-
 lemma hw_invs'[wp]:
   "\<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)
-          and (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))\<rbrace>
+          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
-                           deleteCallerCap_ksQ_ct'
                            hoare_lift_Pf2[OF deleteCallerCap_simple
                            deleteCallerCap_ct']
                       | wpc | simp)+)[1]
                apply simp
                apply (wp deleteCallerCap_nonz_cap hoare_vcg_all_lift
-                         deleteCallerCap_ksQ_ct'
                          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> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))
                              \<and> thread = ksCurThread s
                              \<and> ct_in_state' simple' s
                              \<and> ex_nonz_cap_to' thread s
@@ -1605,34 +1539,45 @@ lemma setSchedulerAction_obj_at'[wp]:
   by (wp, clarsimp elim!: obj_at'_pspaceI)
 
 lemma handleYield_corres:
-  "corres dc einvs (invs' and ct_active' and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)) handle_yield handleYield"
+  "corres dc
+     (einvs and ct_active)
+     (invs' and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread))
+     handle_yield handleYield"
   apply (clarsimp simp: handle_yield_def handleYield_def)
   apply (rule corres_guard_imp)
     apply (rule corres_split[OF getCurThread_corres])
       apply simp
-      apply (rule corres_split[OF tcbSchedDequeue_corres])
-        apply (rule corres_split[OF tcbSchedAppend_corres])
+      apply (rule corres_split[OF tcbSchedDequeue_corres], simp)
+        apply (rule corres_split[OF tcbSchedAppend_corres], simp)
           apply (rule rescheduleRequired_corres)
-         apply (wp weak_sch_act_wf_lift_linear tcbSchedDequeue_valid_queues | simp add: )+
+         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)
-  apply clarsimp
-  apply (frule ct_active_runnable')
-  apply (clarsimp simp: invs'_def valid_state'_def ct_in_state'_def sch_act_wf_weak 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)
-  apply (erule(1) valid_objs_valid_tcbE[OF valid_pspace_valid_objs'])
-  apply (simp add:valid_tcb'_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 hy_invs':
   "\<lbrace>invs' and ct_active'\<rbrace> handleYield \<lbrace>\<lambda>r. invs' and ct_active'\<rbrace>"
   apply (simp add: handleYield_def)
-  apply (wp ct_in_state_thread_state_lift'
-            rescheduleRequired_all_invs_but_ct_not_inQ
-            tcbSchedAppend_invs_but_ct_not_inQ' | simp)+
-  apply (clarsimp simp add: 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
-                   )
+  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
 
@@ -1834,7 +1779,7 @@ 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 haskell_assert_wp doReplyTransfer_sane getCTE_wp'| wpc)+
+   apply (wp doReplyTransfer_sane getCTE_wp'| wpc)+
   apply (clarsimp simp: cte_wp_at_ctes_of)
   done
 
@@ -1850,74 +1795,6 @@ lemma handleReply_nonz_cap_to_ct:
 
 crunch ksQ[wp]: handleFaultReply "\<lambda>s. P (ksReadyQueues s p)"
 
-lemma doReplyTransfer_ct_not_ksQ:
-  "\<lbrace> invs' and sch_act_simple
-           and tcb_at' thread and tcb_at' word
-           and ct_in_state' simple'
-           and (\<lambda>s. ksCurThread s \<noteq> word)
-           and (\<lambda>s. \<forall>p. ksCurThread s \<notin> set(ksReadyQueues s p))\<rbrace>
-   doReplyTransfer thread word callerSlot g
-   \<lbrace>\<lambda>rv s. \<forall>p. ksCurThread s \<notin> set(ksReadyQueues s p)\<rbrace>"
-proof -
-  have astct: "\<And>t p.
-       \<lbrace>(\<lambda>s. ksCurThread s \<notin> set(ksReadyQueues s p) \<and> sch_act_sane s)
-             and (\<lambda>s. ksCurThread s \<noteq> t)\<rbrace>
-       possibleSwitchTo t \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set(ksReadyQueues s p)\<rbrace>"
-    apply (rule hoare_weaken_pre)
-     apply (wps possibleSwitchTo_ct')
-     apply (wp possibleSwitchTo_ksQ')
-    apply (clarsimp simp: sch_act_sane_def)
-    done
-  have stsct: "\<And>t st p.
-       \<lbrace>(\<lambda>s. ksCurThread s \<notin> set(ksReadyQueues s p)) and sch_act_simple\<rbrace>
-       setThreadState st t
-       \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set(ksReadyQueues s p)\<rbrace>"
-    apply (rule hoare_weaken_pre)
-     apply (wps setThreadState_ct')
-     apply (wp hoare_vcg_all_lift sts_ksQ)
-    apply (clarsimp)
-    done
-  show ?thesis
-    apply (simp add: doReplyTransfer_def)
-    apply (wp, wpc)
-            apply (wp astct stsct hoare_vcg_all_lift
-                      cteDeleteOne_ct_not_ksQ hoare_drop_imp
-                      hoare_lift_Pf2 [OF cteDeleteOne_sch_act_not cteDeleteOne_ct']
-                      hoare_lift_Pf2 [OF doIPCTransfer_pred_tcb_at' doIPCTransfer_ct']
-                      hoare_lift_Pf2 [OF doIPCTransfer_ksQ doIPCTransfer_ct']
-                      hoare_lift_Pf2 [OF threadSet_ksQ threadSet_ct]
-                      hoare_lift_Pf2 [OF handleFaultReply_ksQ handleFaultReply_ct']
-                   | simp add: ct_in_state'_def)+
-     apply (fastforce simp: sch_act_simple_def sch_act_sane_def ct_in_state'_def)+
-    done
-qed
-
-lemma handleReply_ct_not_ksQ:
-  "\<lbrace>invs' and sch_act_simple
-           and ct_in_state' simple'
-           and (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))\<rbrace>
-   handleReply
-   \<lbrace>\<lambda>rv s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: handleReply_def del: split_paired_All)
-  apply (subst haskell_assert_def)
-  apply (wp | wpc)+
-  apply (wp doReplyTransfer_ct_not_ksQ getThreadCallerSlot_inv)+
-    apply (rule_tac Q="\<lambda>cap.
-                              (\<lambda>s. \<forall>p. ksCurThread s \<notin> set(ksReadyQueues s p))
-                          and invs'
-                          and sch_act_simple
-                          and (\<lambda>s. thread = ksCurThread s)
-                          and tcb_at' thread
-                          and ct_in_state' simple'
-                          and cte_wp_at' (\<lambda>c. cteCap c = cap) callerSlot"
-             in hoare_post_imp)
-     apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def
-                           cte_wp_at_ctes_of valid_cap'_def
-                    dest!: ctes_of_valid')
-    apply (wp getSlotCap_cte_wp_at getThreadCallerSlot_inv)+
-  apply (clarsimp)
-  done
-
 crunch valid_etcbs[wp]: handle_recv "valid_etcbs"
   (wp: crunch_wps simp: crunch_simps)
 
@@ -1930,18 +1807,16 @@ lemma handleReply_handleRecv_corres:
     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 handleReply_ct_not_ksQ handle_reply_valid_sched)+
+               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 (frule(1) ct_not_ksQ)
   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)
              (invs' and sch_act_not thread
-                    and (\<lambda>s. \<forall>p. thread \<notin> set(ksReadyQueues s p))
                     and st_tcb_at' simple' thread and ex_nonz_cap_to' thread)
           (handle_hypervisor_fault thread fault) (handleHypervisorFault thread fault)"
   apply (cases fault; clarsimp simp: handleHypervisorFault_def isFpuEnable_def split del: if_split)
@@ -1964,12 +1839,11 @@ lemma hvmf_invs_lift:
                  curVCPUActive_def doMachineOp_bind getRestartPC_def getRegister_def)
 
 lemma hvmf_invs_etc:
-  "\<lbrace>invs' and sch_act_not t and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p)) and st_tcb_at' simple' t and
+  "\<lbrace>invs' and sch_act_not t and st_tcb_at' simple' t and
     ex_nonz_cap_to' t\<rbrace>
     handleVMFault t f
    \<lbrace>\<lambda>_ _. True\<rbrace>,
-   \<lbrace>\<lambda>_. invs' and sch_act_not t and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p)) and
-        st_tcb_at' simple' t and ex_nonz_cap_to' t\<rbrace>"
+   \<lbrace>\<lambda>_. invs' and sch_act_not t and st_tcb_at' simple' t and ex_nonz_cap_to' t\<rbrace>"
   apply (rule hvmf_invs_lift)
   apply (clarsimp simp: invs'_def valid_state'_def valid_machine_state'_def)
   done
@@ -1982,14 +1856,13 @@ lemma handleEvent_corres:
                       (handle_event event) (handleEvent event)"
 proof -
   have hw:
-    "\<And>isBlocking. corres dc (einvs and ct_running and (\<lambda>s. scheduler_action s = resume_cur_thread))
+    "\<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
-                     dest!: ct_not_ksQ)+
+                     elim!: st_tcb_weakenE pred_tcb'_weakenE)+
     done
   show ?thesis
     apply (case_tac event)
@@ -2015,7 +1888,6 @@ proof -
                           simp: ct_in_state_def)
         apply wp
         apply (clarsimp)
-        apply (frule(1) ct_not_ksQ)
         apply (auto simp: ct_in_state'_def sch_act_simple_def
                           sch_act_sane_def
                     elim: pred_tcb'_weakenE st_tcb_ex_cap'')[1]
@@ -2028,12 +1900,11 @@ proof -
                          simp: ct_in_state_def valid_fault_def)
        apply wp
        apply clarsimp
-       apply (frule(1) ct_not_ksQ)
        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>rv. einvs"
+        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)
@@ -2044,8 +1915,7 @@ proof -
                    doMachineOp_getActiveIRQ_IRQ_active'
                   | simp
                   | simp add: imp_conjR | wp (once) hoare_drop_imps)+
-      apply (clarsimp simp: invs'_def valid_state'_def ct_not_inQ_def valid_queues_def
-                            valid_queues_no_bitmap_def)
+      apply (clarsimp simp: invs'_def valid_state'_def ct_not_inQ_def valid_queues_def)
      apply (rule_tac corres_underlying_split)
         apply (rule corres_guard_imp, rule getCurThread_corres, simp+)
        apply (rule corres_split_catch)
@@ -2058,7 +1928,6 @@ proof -
       apply (fastforce elim!: st_tcb_ex_cap st_tcb_weakenE simp: ct_in_state_def)
      apply wp
      apply (clarsimp)
-     apply (frule(1) ct_not_ksQ)
      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)
@@ -2069,7 +1938,6 @@ proof -
                       simp: ct_in_state_def)
     apply wp
     apply (clarsimp)
-    apply (frule(1) ct_not_ksQ)
     apply (auto simp: ct_in_state'_def sch_act_simple_def
                       sch_act_sane_def
                 elim: pred_tcb'_weakenE st_tcb_ex_cap'')[1]
@@ -2087,9 +1955,9 @@ crunches handleHypervisorFault
   (wp: undefined_valid haskell_assert_inv simp: isFpuEnable_def)
 
 lemma hh_invs'[wp]:
-  "\<lbrace>invs' and sch_act_not p and (\<lambda>s. \<forall>a b. p \<notin> set (ksReadyQueues s (a, b))) and
-    st_tcb_at' simple' p and ex_nonz_cap_to' p and (\<lambda>s. p \<noteq> ksIdleThread s)\<rbrace>
-  handleHypervisorFault p t \<lbrace>\<lambda>_. invs'\<rbrace>"
+  "\<lbrace>invs' and sch_act_not p and st_tcb_at' simple' p and ex_nonz_cap_to' p and (\<lambda>s. p \<noteq> ksIdleThread s)\<rbrace>
+   handleHypervisorFault p t
+   \<lbrace>\<lambda>_. invs'\<rbrace>"
   supply if_split[split del]
   by (cases t; wpsimp simp: AARCH64_H.handleHypervisorFault_def isFpuEnable_def)
 
@@ -2153,10 +2021,8 @@ proof -
         apply (rename_tac syscall)
         apply (case_tac syscall,
                (wp handleReply_sane handleReply_nonz_cap_to_ct handleReply_ksCurThread
-                   handleReply_ct_not_ksQ
                 | clarsimp simp: active_from_running' simple_from_running' simple_sane_strg simp del: split_paired_All
                 | rule conjI active_ex_cap'
-                | drule ct_not_ksQ[rotated]
                 | strengthen nidle)+)
         apply (rule hoare_strengthen_post,
                rule hoare_weaken_pre,
@@ -2169,7 +2035,6 @@ proof -
                  | 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'
-                 | drule ct_not_ksQ[rotated]
                  | wpc | wp (once) hoare_drop_imps hoare_vcg_all_lift)+
   done
 qed
diff --git a/proof/refine/AARCH64/TcbAcc_R.thy b/proof/refine/AARCH64/TcbAcc_R.thy
index 5d1f8f2d2f..6382800cb1 100644
--- a/proof/refine/AARCH64/TcbAcc_R.thy
+++ b/proof/refine/AARCH64/TcbAcc_R.thy
@@ -59,10 +59,8 @@ lemma getHighestPrio_inv[wp]:
   unfolding bitmap_fun_defs by simp
 
 lemma valid_bitmapQ_bitmapQ_simp:
-  "\<lbrakk> valid_bitmapQ s \<rbrakk> \<Longrightarrow>
-   bitmapQ d p s = (ksReadyQueues s (d, p) \<noteq> [])"
-   unfolding valid_bitmapQ_def
-   by simp
+  "valid_bitmapQ s \<Longrightarrow> bitmapQ d p s = (\<not> tcbQueueEmpty (ksReadyQueues s (d, p)))"
+  by (simp add: valid_bitmapQ_def)
 
 lemma prioToL1Index_l1IndexToPrio_or_id:
   "\<lbrakk> unat (w'::priority) < 2 ^ wordRadix ; w < 2^(size w' - wordRadix) \<rbrakk>
@@ -85,20 +83,6 @@ 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 :: "machine_word \<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 and runnable' \<circ> tcbState) t s)
-    \<and>  distinct (ksReadyQueues s (d, p))
-    \<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
-
 lemma st_tcb_at_coerce_abstract:
   assumes t: "st_tcb_at' P t c"
   assumes sr: "(a, c) \<in> state_relation"
@@ -107,11 +91,10 @@ lemma st_tcb_at_coerce_abstract:
   apply (clarsimp simp: state_relation_def pred_tcb_at'_def obj_at'_def objBits_simps)
   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
-                        AARCH64_A.arch_kernel_obj.split_asm)+
-  apply fastforce
+  apply (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
+                          AARCH64_A.arch_kernel_obj.split_asm)+
   done
 
 lemma st_tcb_at_runnable_coerce_concrete:
@@ -133,10 +116,11 @@ lemma pspace_relation_tcb_at':
   assumes t: "tcb_at t a"
   assumes aligned: "pspace_aligned' c"
   assumes distinct: "pspace_distinct' c"
-  shows "tcb_at' t c" using assms
+  shows "tcb_at' t c"
+  using assms
   apply (clarsimp simp: obj_at_def)
   apply (drule(1) pspace_relation_absD)
-  apply (clarsimp simp: is_tcb other_obj_relation_def)
+  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)
@@ -144,13 +128,24 @@ lemma pspace_relation_tcb_at':
   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'"
+  "\<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 is_tcb_def
+              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'"
@@ -167,24 +162,83 @@ lemma cur_tcb_cross:
   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"
+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"
+  using assms
   apply (clarsimp simp add: 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)
   done
 
-lemma valid_objs'_maxDomain:
-  "\<And>s t. \<lbrakk> valid_objs' s; tcb_at' t s \<rbrakk> \<Longrightarrow> obj_at' (\<lambda>tcb. tcbDomain tcb \<le> maxDomain) t s"
-  apply (erule (1) valid_objs_valid_tcbE)
-  apply (clarsimp simp: valid_tcb'_def)
+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
+  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 objBits_simps')
+  done
+
+definition valid_tcbs' :: "kernel_state \<Rightarrow> bool" where
+  "valid_tcbs' s' \<equiv> \<forall>ptr tcb. ksPSpace s' ptr = Some (KOTCB tcb) \<longrightarrow> valid_tcb' tcb s'"
+
+lemma valid_objs'_valid_tcbs'[elim!]:
+  "valid_objs' s \<Longrightarrow> valid_tcbs' s"
+  by (auto simp: valid_objs'_def valid_tcbs'_def valid_obj'_def split: kernel_object.splits)
+
+lemma invs'_valid_tcbs'[elim!]:
+  "invs' s \<Longrightarrow> valid_tcbs' s"
+  by (fastforce intro: valid_objs'_valid_tcbs')
+
+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 valid_tcb'_def)
+  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 valid_tcb'_def)
   done
 
-lemma valid_objs'_maxPriority:
-  "\<And>s t. \<lbrakk> valid_objs' s; tcb_at' t s \<rbrakk> \<Longrightarrow> obj_at' (\<lambda>tcb. tcbPriority tcb \<le> maxPriority) t s"
-  apply (erule (1) valid_objs_valid_tcbE)
-  apply (clarsimp simp: valid_tcb'_def)
+lemmas valid_objs'_maxPriority = valid_tcbs'_maxPriority[OF valid_objs'_valid_tcbs']
+
+lemma valid_tcbs'_obj_at':
+  assumes "valid_tcbs' 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"
+  using assms
+  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)
   done
 
+lemma update_valid_tcb'[simp]:
+  "\<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"
+  "\<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
+                 opt_tcb_at'_def valid_arch_tcb'_def
+          split: option.splits thread_state.splits)
+
+lemma update_valid_tcbs'[simp]:
+  "\<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':
   assumes masks: "\<And>P. \<lbrace>\<lambda>s. P (irq_masks s)\<rbrace> f \<lbrace>\<lambda>_ s. P (irq_masks s)\<rbrace>"
   shows "\<lbrace>valid_irq_states'\<rbrace> doMachineOp f \<lbrace>\<lambda>rv. valid_irq_states'\<rbrace>"
@@ -282,49 +336,109 @@ lemma updateObject_tcb_inv:
   by simp (rule updateObject_default_inv)
 
 lemma setObject_update_TCB_corres':
-  assumes tcbs: "tcb_relation tcb tcb' \<Longrightarrow> tcb_relation tcbu tcbu'"
-  assumes tables: "\<forall>(getF, v) \<in> ran tcb_cap_cases. getF tcbu = getF tcb"
-  assumes tables': "\<forall>(getF, v) \<in> ran tcb_cte_cases. getF tcbu' = getF tcb'"
+  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"
+  assumes tables': "\<forall>(getF, v) \<in> ran tcb_cte_cases. getF new_tcb' = getF tcb'"
+  assumes sched_pointers: "tcbSchedPrev new_tcb' = tcbSchedPrev tcb'"
+                          "tcbSchedNext new_tcb' = tcbSchedNext tcb'"
+  assumes flag: "tcbQueued new_tcb' = tcbQueued tcb'"
   assumes r: "r () ()"
-  assumes exst: "exst_same tcb' tcbu'"
-  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' \<and> exst_same tcb' tcbu'" 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: other_obj_relation_def exst)
-  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
-                           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: 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)
+  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 project_inject split: if_split_asm kernel_object.split_asm)
+   apply (rename_tac aa ba)
+   apply (drule_tac x="(aa, ba)" in bspec, simp)
+   apply clarsimp
+   apply (frule_tac ko'="kernel_object.TCB tcb" and x'=ptr in obj_relation_cut_same_type)
+      apply (simp add: tcb_relation_cut_def)+
+   apply clarsimp
+  apply (extract_conjunct \<open>match conclusion in "ekheap_relation _ _" \<Rightarrow> -\<close>)
+   apply (simp only: ekheap_relation_def)
+   apply (rule ballI, drule (1) bspec)
+   apply (insert exst)
+   apply (clarsimp simp: etcb_relation_def exst_same_def)
+  apply (extract_conjunct \<open>match conclusion in "ready_queues_relation_2 _ _ _ _ _" \<Rightarrow> -\<close>)
+   apply (insert sched_pointers flag exst)
+   apply (clarsimp simp: ready_queues_relation_def Let_def)
+   apply (prop_tac "(tcbSchedNexts_of s')(ptr := tcbSchedNext new_tcb') = tcbSchedNexts_of s'")
+    apply (fastforce simp: opt_map_def)
+   apply (prop_tac "(tcbSchedPrevs_of s')(ptr := tcbSchedPrev new_tcb') = tcbSchedPrevs_of s'")
+    apply (fastforce simp: opt_map_def)
+   apply (clarsimp simp: ready_queue_relation_def opt_pred_def opt_map_def exst_same_def inQ_def
+                  split: option.splits)
+   apply (metis (mono_tags, opaque_lifting))
+  apply (clarsimp simp: fun_upd_def caps_of_state_after_update cte_wp_at_after_update swp_def
+                        obj_at_def)
   done
 
 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 () (); exst_same tcb' tcbu'\<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 fastforce
-  apply (clarsimp simp: getObject_def in_monad split_def obj_at'_def
-                        loadObject_default_def objBits_simps' in_magnitude_check)
+    apply (erule (7) setObject_update_TCB_corres')
+   apply (clarsimp simp: getObject_def in_monad split_def obj_at'_def
+                         loadObject_default_def objBits_simps' in_magnitude_check)+
   done
 
 lemma getObject_TCB_corres:
@@ -364,7 +478,8 @@ lemma ball_tcb_cte_casesI:
   by (simp add: tcb_cte_cases_def cteSizeBits_def)
 
 lemma all_tcbI:
-  "\<lbrakk> \<And>a b c d e f g h i j k l m n p q. P (Thread a b c d e f g h i j k l m n p q) \<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:
@@ -373,6 +488,9 @@ 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"
+  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>
@@ -381,10 +499,13 @@ lemma threadset_corresT:
   apply (rule corres_guard_imp)
     apply (rule corres_split[OF getObject_TCB_corres])
       apply (rule setObject_update_TCB_corres')
-          apply (erule x)
-         apply (rule y)
-        apply (clarsimp simp: bspec_split [OF spec [OF z]])
-        apply fastforce
+             apply (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+
@@ -414,6 +535,9 @@ lemma threadSet_corres_noopT:
                          tcb_relation tcb (fn tcb')"
   assumes y: "\<forall>tcb. \<forall>(getF, setF) \<in> ran tcb_cte_cases.
                  getF (fn tcb) = getF tcb"
+  assumes s: "\<forall>tcb'. tcbSchedPrev (fn tcb') = tcbSchedPrev tcb'"
+             "\<forall>tcb'. tcbSchedNext (fn tcb') = tcbSchedNext tcb'"
+  assumes f: "\<And>tcb'. tcbQueued (fn tcb') = tcbQueued tcb'"
   assumes e: "\<And>tcb'. exst_same tcb' (fn tcb')"
   shows      "corres dc (tcb_at t and pspace_aligned and pspace_distinct) \<top>
                         (return v) (threadSet fn t)"
@@ -432,9 +556,12 @@ proof -
        defer
        apply (subst bind_return [symmetric],
               rule corres_underlying_split [OF threadset_corresT])
-             apply (simp add: x)
-            apply simp
-           apply (rule y)
+                apply (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
@@ -453,14 +580,20 @@ 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>"
+  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)+
@@ -689,7 +822,12 @@ lemma threadSet_valid_pspace'T_P:
   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 p: "\<forall>tcb. (P \<longrightarrow> Q'' (tcbSchedPrev tcb)) \<longrightarrow>
+                      (\<forall>s. opt_tcb_at' (tcbSchedPrev tcb) s
+                              \<longrightarrow> opt_tcb_at' (tcbSchedPrev (F tcb)) s)"
+  assumes n: "\<forall>tcb. (P \<longrightarrow> Q''' (tcbSchedNext tcb)) \<longrightarrow>
+                      (\<forall>s. opt_tcb_at' (tcbSchedNext tcb) s
+                              \<longrightarrow> opt_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"
@@ -697,9 +835,11 @@ lemma threadSet_valid_pspace'T_P:
   assumes w': "\<forall>tcb. tcbMCP tcb \<le> maxPriority \<longrightarrow> tcbMCP (F tcb) \<le> maxPriority"
   assumes v': "\<forall>tcb s. valid_arch_tcb' (tcbArch tcb) s \<longrightarrow> valid_arch_tcb' (tcbArch (F tcb)) s"
   shows
-  "\<lbrace>valid_pspace' and (\<lambda>s. P \<longrightarrow> st_tcb_at' Q t s \<and> bound_tcb_at' Q' t s)\<rbrace>
-     threadSet F t
-   \<lbrace>\<lambda>rv. valid_pspace'\<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>_. valid_pspace'\<rbrace>"
   apply (simp add: valid_pspace'_def threadSet_def)
   apply (rule hoare_pre,
          wp setObject_tcb_valid_objs getObject_tcb_wp)
@@ -707,7 +847,7 @@ lemma threadSet_valid_pspace'T_P:
   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 v w' v')
+                            split_paired_Ball y u w v w' v' p n)
   done
 
 lemmas threadSet_valid_pspace'T =
@@ -791,6 +931,10 @@ lemma threadSet_iflive'T:
               \<and> tcbState (F tcb) \<noteq> Inactive
               \<and> tcbState (F tcb) \<noteq> IdleThreadState
               \<and> ko_at' tcb t s) \<longrightarrow> ex_nonz_cap_to' t s)
+      \<and> ((\<exists>tcb. tcbSchedNext tcb = None \<and> tcbSchedNext (F tcb) \<noteq> None
+              \<and> ko_at' tcb t s) \<longrightarrow> ex_nonz_cap_to' t s)
+      \<and> ((\<exists>tcb. tcbSchedPrev tcb = None \<and> tcbSchedPrev (F tcb) \<noteq> None
+              \<and> ko_at' tcb t s) \<longrightarrow> ex_nonz_cap_to' t s)
       \<and> ((\<exists>tcb. \<not> tcbQueued tcb \<and> tcbQueued (F tcb)
               \<and> ko_at' tcb t s) \<longrightarrow> ex_nonz_cap_to' t s)
       \<and> ((\<exists>tcb. \<not> bound (atcbVCPUPtr (tcbArch tcb)) \<and> bound (atcbVCPUPtr (tcbArch (F tcb)))
@@ -846,6 +990,12 @@ lemmas threadSet_ctes_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)
+  \<Longrightarrow> threadSet f tptr \<lbrace>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 objBits_simps')
+
 lemma threadSet_idle'T:
   assumes x: "\<forall>tcb. \<forall>(getF, setF) \<in> ran tcb_cte_cases. getF (F tcb) = getF tcb"
   shows
@@ -883,30 +1033,6 @@ lemma set_tcb_bitmapQ_no_L2_orphans[wp]:
   apply (wp hoare_Ball_helper hoare_vcg_all_lift updateObject_default_inv | simp add: bitmapQ_def)+
   done
 
-lemma threadSet_valid_queues_no_bitmap:
-  "\<lbrace> valid_queues_no_bitmap and
-    (\<lambda>s. \<forall>d p. (\<exists>tcb. (inQ d p tcb \<and> runnable' (tcbState tcb)) \<and>
-                     \<not>(inQ d p (f tcb) \<and> runnable' (tcbState (f tcb))))
-                \<longrightarrow> obj_at' (\<lambda>tcb. (inQ d p tcb \<and> runnable' (tcbState tcb)) \<and>
-                                 \<not>(inQ d p (f tcb) \<and> runnable' (tcbState (f tcb)))) t s
-                \<longrightarrow> t \<notin> set (ksReadyQueues s (d, p))
-    )\<rbrace>
-     threadSet f t
-   \<lbrace>\<lambda>rv. valid_queues_no_bitmap \<rbrace>"
-  apply (simp add: threadSet_def)
-  apply wp
-   apply (simp add: Invariants_H.valid_queues_no_bitmap_def' pred_tcb_at'_def)
-
-   apply (wp setObject_queues_unchanged_tcb
-             hoare_Ball_helper
-             hoare_vcg_all_lift
-             setObject_tcb_strongest)[1]
-  apply (wp getObject_tcb_wp)
-  apply (clarsimp simp: valid_queues_no_bitmap_def' pred_tcb_at'_def)
-  apply (clarsimp simp: obj_at'_def)
-  apply (fastforce)
-  done
-
 lemma threadSet_valid_bitmapQ[wp]:
   "\<lbrace> valid_bitmapQ \<rbrace> threadSet f t \<lbrace> \<lambda>rv. valid_bitmapQ \<rbrace>"
   unfolding bitmapQ_defs threadSet_def
@@ -925,72 +1051,6 @@ lemma threadSet_valid_bitmapQ_no_L2_orphans[wp]:
   by (clarsimp simp: setObject_def split_def)
      (wp | simp add: updateObject_default_def)+
 
-lemma threadSet_valid_queues:
-  "\<lbrace>Invariants_H.valid_queues and
-    (\<lambda>s. \<forall>d p. (\<exists>tcb. (inQ d p tcb \<and> runnable' (tcbState tcb)) \<and>
-                     \<not>(inQ d p (f tcb) \<and> runnable' (tcbState (f tcb))))
-                \<longrightarrow> obj_at' (\<lambda>tcb. (inQ d p tcb \<and> runnable' (tcbState tcb)) \<and>
-                                 \<not>(inQ d p (f tcb) \<and> runnable' (tcbState (f tcb)))) t s
-                \<longrightarrow> t \<notin> set (ksReadyQueues s (d, p))
-    )\<rbrace>
-     threadSet f t
-   \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  unfolding valid_queues_def
-  by (wp threadSet_valid_queues_no_bitmap;simp)
-
-definition
-  addToQs :: "(Structures_H.tcb \<Rightarrow> Structures_H.tcb)
-                       \<Rightarrow> machine_word \<Rightarrow> (domain \<times> priority \<Rightarrow> machine_word list)
-                       \<Rightarrow> (domain \<times> priority \<Rightarrow> machine_word list)"
-where
- "addToQs F t \<equiv> \<lambda>qs (qdom, prio). if (\<forall>ko. \<not> inQ qdom prio (F ko))
-                             then t # qs (qdom, prio)
-                             else qs (qdom, prio)"
-
-lemma addToQs_set_def:
-  "(t' \<in> set (addToQs F t qs (qdom, prio))) = (t' \<in> set (qs (qdom, prio))
-      \<or> (t' = t \<and> (\<forall>ko. \<not> inQ qdom prio (F ko))))"
-  by (auto simp add: addToQs_def)
-
-lemma threadSet_valid_queues_addToQs:
-  "\<lbrace>\<lambda>s. (\<forall>ko qdom prio. ko_at' ko t s \<and> inQ qdom prio (F ko) \<and> \<not> inQ qdom prio ko
-            \<longrightarrow> t \<in> set (ksReadyQueues s (qdom, prio)))
-             \<and> valid_queues' (ksReadyQueues_update (addToQs F t) s)\<rbrace>
-     threadSet F t
-   \<lbrace>\<lambda>rv. 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 objBits_simps addToQs_set_def
-             split del: if_split cong: if_cong)
-  apply (fastforce split: if_split_asm)
-  done
-
-lemma threadSet_valid_queues_Qf:
-  "\<lbrace>\<lambda>s. (\<forall>ko qdom prio. ko_at' ko t s \<and> inQ qdom prio (F ko) \<and> \<not> inQ qdom prio ko
-            \<longrightarrow> t \<in> set (ksReadyQueues s (qdom, prio)))
-             \<and> valid_queues' (ksReadyQueues_update Qf s)
-             \<and> (\<forall>prio. set (Qf (ksReadyQueues s) prio)
-                        \<subseteq> set (addToQs F t (ksReadyQueues s) prio))\<rbrace>
-     threadSet F t
-   \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (wp threadSet_valid_queues_addToQs)
-  apply (clarsimp simp: valid_queues'_def subset_iff)
-  done
-
-lemma addToQs_subset:
-  "set (qs p) \<subseteq> set (addToQs F t qs p)"
-by (clarsimp simp: addToQs_def split_def)
-
-lemmas threadSet_valid_queues'
-  = threadSet_valid_queues_Qf
-       [where Qf=id, simplified ksReadyQueues_update_id
-                                id_apply addToQs_subset simp_thms]
-
 lemma threadSet_cur:
   "\<lbrace>\<lambda>s. cur_tcb' s\<rbrace> threadSet f t \<lbrace>\<lambda>rv s. cur_tcb' s\<rbrace>"
   apply (simp add: threadSet_def cur_tcb'_def)
@@ -1006,7 +1066,7 @@ lemma modifyReadyQueuesL1Bitmap_obj_at[wp]:
 
 crunches setThreadState, setBoundNotification
   for valid_arch' [wp]: valid_arch_state'
-  (simp: unless_def crunch_simps)
+  (simp: unless_def crunch_simps wp: crunch_wps)
 
 crunch ksInterrupt'[wp]: threadSet "\<lambda>s. P (ksInterruptState s)"
   (wp: setObject_ksInterrupt updateObject_default_inv)
@@ -1259,58 +1319,103 @@ lemma threadSet_valid_dom_schedule':
   unfolding threadSet_def
   by (wp setObject_ksDomSchedule_inv hoare_Ball_helper)
 
+lemma threadSet_wp:
+  "\<lbrace>\<lambda>s. \<forall>tcb. ko_at' tcb t s \<longrightarrow> P (s\<lparr>ksPSpace := (ksPSpace s)(t \<mapsto> injectKO (f tcb))\<rparr>)\<rbrace>
+   threadSet f t
+   \<lbrace>\<lambda>_. P\<rbrace>"
+  unfolding threadSet_def setObject_def
+  apply (wpsimp wp: getObject_tcb_wp simp: updateObject_default_def)
+  apply (auto simp: obj_at'_def split: if_splits)
+  apply (erule rsubst[where P=P])
+  apply (clarsimp simp: fun_upd_def)
+  apply (prop_tac "\<forall>ptr. psMap (ksPSpace s) ptr = ksPSpace s ptr")
+   apply fastforce
+  apply metis
+  done
+
+lemma threadSet_sched_pointers:
+  "\<lbrakk>\<And>tcb. tcbSchedNext (F tcb) = tcbSchedNext tcb; \<And>tcb. tcbSchedPrev (F tcb) = tcbSchedPrev tcb\<rbrakk>
+   \<Longrightarrow> threadSet F tcbPtr \<lbrace>\<lambda>s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)\<rbrace>"
+  apply (wpsimp wp: threadSet_wp getObject_tcb_wp)
+  apply (fastforce simp: opt_map_def obj_at'_def elim: rsubst2[where P=P])
+  done
+
+lemma threadSet_valid_sched_pointers:
+  "\<lbrakk>\<And>tcb. tcbSchedNext (F tcb) = tcbSchedNext tcb; \<And>tcb. tcbSchedPrev (F tcb) = tcbSchedPrev tcb;
+    \<And>tcb. tcbQueued (F tcb) = tcbQueued tcb\<rbrakk>
+   \<Longrightarrow> threadSet F tcbPtr \<lbrace>valid_sched_pointers\<rbrace>"
+  unfolding valid_sched_pointers_def
+  apply (wpsimp wp: threadSet_wp getObject_tcb_wp)
+  by (fastforce simp: opt_pred_def opt_map_def obj_at'_def split: option.splits if_splits)
+
+lemma threadSet_tcbSchedNexts_of:
+  "(\<And>tcb. tcbSchedNext (F tcb) = tcbSchedNext tcb) \<Longrightarrow>
+   threadSet F t \<lbrace>\<lambda>s. P (tcbSchedNexts_of s)\<rbrace>"
+  apply (wpsimp wp: threadSet_wp getObject_tcb_wp)
+  apply (erule rsubst[where P=P])
+  apply (fastforce simp: opt_map_def obj_at'_def)
+  done
+
+lemma threadSet_tcbSchedPrevs_of:
+  "(\<And>tcb. tcbSchedPrev (F tcb) = tcbSchedPrev tcb) \<Longrightarrow>
+   threadSet F t \<lbrace>\<lambda>s. P (tcbSchedPrevs_of s)\<rbrace>"
+  apply (wpsimp wp: threadSet_wp getObject_tcb_wp)
+  apply (erule rsubst[where P=P])
+  apply (fastforce simp: opt_map_def obj_at'_def)
+  done
+
+lemma threadSet_tcbQueued:
+  "(\<And>tcb. tcbQueued (F tcb) = tcbQueued tcb) \<Longrightarrow>
+   threadSet F t \<lbrace>\<lambda>s. P (tcbQueued |< tcbs_of' s)\<rbrace>"
+  apply (wpsimp wp: threadSet_wp getObject_tcb_wp)
+  apply (erule rsubst[where P=P])
+  apply (fastforce simp: opt_pred_def opt_map_def obj_at'_def)
+  done
+
+crunches threadSet
+  for ksReadyQueues[wp]: "\<lambda>s. P (ksReadyQueues s)"
+  and ksReadyQueuesL1Bitmap[wp]: "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
+  and ksReadyQueuesL2Bitmap[wp]: "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
+
 lemma threadSet_invs_trivialT:
-  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 \<and> tcbDomain (F tcb) = tcbDomain tcb"
-  assumes w: "\<forall>tcb. is_aligned (tcbIPCBuffer tcb) msg_align_bits \<longrightarrow> is_aligned (tcbIPCBuffer (F tcb)) msg_align_bits"
-  assumes a: "\<forall>tcb. tcbBoundNotification (F tcb) = tcbBoundNotification tcb"
-  assumes w: "\<forall>tcb. is_aligned (tcbIPCBuffer tcb) msg_align_bits \<longrightarrow> is_aligned (tcbIPCBuffer (F tcb)) msg_align_bits"
-  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 r: "\<forall>tcb. atcbVCPUPtr (tcbArch (F tcb)) = atcbVCPUPtr (tcbArch tcb)"
-  shows
-  "\<lbrace>\<lambda>s. invs' 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. \<not> tcbQueued tcb \<and> tcbQueued (F tcb)) \<longrightarrow> ex_nonz_cap_to' t s \<and> t \<noteq> ksCurThread s) \<and>
-       (\<forall>tcb. tcbQueued (F tcb) \<and> ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> tcbQueued tcb \<or> t \<noteq> ksCurThread s)\<rbrace>
-   threadSet F t
-   \<lbrace>\<lambda>rv. invs'\<rbrace>"
-proof -
-  from z have domains: "\<And>tcb. tcbDomain (F tcb) = tcbDomain tcb" by blast
-  note threadSet_sch_actT_P[where P=False, simplified]
-  have y: "\<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 valid_state'_def split del: if_split)
-    apply (rule hoare_pre)
-     apply (wp x w v u b
-              threadSet_valid_pspace'T
-              threadSet_sch_actT_P[where P=False, simplified]
-              threadSet_valid_queues
-              threadSet_state_refs_of'T[where f'=id]
-              threadSet_state_hyp_refs_of'
-              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_cur
-              untyped_ranges_zero_lift
-           |clarsimp simp: y z a r domains cteCaps_of_def valid_arch_tcb'_def | rule refl)+
-   apply (clarsimp simp: obj_at'_def pred_tcb_at'_def)
-   apply (clarsimp simp: cur_tcb'_def valid_irq_node'_def valid_queues'_def o_def)
-   by (fastforce simp: domains ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def z a)
-qed
+  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. is_aligned (tcbIPCBuffer tcb) msg_align_bits
+           \<longrightarrow> is_aligned (tcbIPCBuffer (F tcb)) msg_align_bits"
+    "\<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. tcbMCP tcb \<le> maxPriority \<longrightarrow> tcbMCP (F tcb) \<le> maxPriority"
+    "\<forall>tcb. atcbVCPUPtr (tcbArch (F tcb)) = atcbVCPUPtr (tcbArch tcb)"
+  shows "threadSet F t \<lbrace>invs'\<rbrace>"
+  apply (simp add: invs'_def valid_state'_def split del: if_split)
+  apply (wp threadSet_valid_pspace'T
+            threadSet_sch_actT_P[where P=False, simplified]
+            threadSet_state_refs_of'T[where f'=id]
+            threadSet_state_hyp_refs_of'
+            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_cur
+            untyped_ranges_zero_lift
+            sym_heap_sched_pointers_lift threadSet_valid_sched_pointers
+            threadSet_tcbQueued
+            threadSet_tcbSchedPrevs_of threadSet_tcbSchedNexts_of valid_bitmaps_lift
+         | clarsimp simp: assms cteCaps_of_def valid_arch_tcb'_def | rule refl)+
+  apply (clarsimp simp: o_def)
+  by (auto simp: assms obj_at'_def)
 
 lemmas threadSet_invs_trivial =
     threadSet_invs_trivialT [OF all_tcbI all_tcbI all_tcbI all_tcbI, OF ball_tcb_cte_casesI]
@@ -1357,6 +1462,70 @@ lemma atcbVCPUPtr_atcbContextSet_id[simp]:
   "atcbVCPUPtr (atcbContextSet f (tcbArch tcb)) = atcbVCPUPtr (tcbArch tcb)"
   by (simp add: atcbContextSet_def)
 
+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']
+
+lemma setObject_valid_tcbs':
+  assumes preserve_valid_tcb': "\<And>s s' ko ko' x n tcb tcb'.
+            \<lbrakk> (ko', s') \<in> fst (updateObject val ko ptr x n s); P s;
+              lookupAround2 ptr (ksPSpace s) = (Some (x, ko), n);
+              projectKO_opt ko = Some tcb; projectKO_opt ko' = Some tcb';
+              valid_tcb' tcb s \<rbrakk> \<Longrightarrow> valid_tcb' tcb' s"
+  shows "\<lbrace>valid_tcbs' and P\<rbrace> setObject ptr val \<lbrace>\<lambda>rv. valid_tcbs'\<rbrace>"
+  unfolding valid_tcbs'_def
+  apply (clarsimp simp: valid_def)
+  apply (rename_tac s s' ptr' tcb)
+  apply (prop_tac "\<forall>tcb'. valid_tcb' tcb s \<longrightarrow> valid_tcb' tcb s'")
+   apply clarsimp
+   apply (erule (1) use_valid[OF _ setObject_valid_tcb'])
+  apply (drule spec, erule mp)
+  apply (clarsimp simp: setObject_def in_monad split_def lookupAround2_char1)
+  apply (rename_tac s ptr' new_tcb' ptr'' old_tcb_ko' s' f)
+  apply (case_tac "ptr'' = ptr'"; clarsimp)
+  apply (prop_tac "\<exists>old_tcb' :: tcb. projectKO_opt old_tcb_ko' = Some old_tcb'")
+   apply (frule updateObject_type)
+   apply (case_tac old_tcb_ko'; clarsimp simp: project_inject)
+  apply (erule exE)
+  apply (rule preserve_valid_tcb', assumption+)
+     apply (simp add: prod_eqI lookupAround2_char1)
+    apply force
+   apply (clarsimp simp: project_inject)
+  apply (clarsimp simp: project_inject)
+  done
+
+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 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>_. valid_tcb' tcb\<rbrace>"
+  apply (simp add: threadSet_def)
+  apply (wpsimp wp: setObject_valid_tcb')
+  done
+
+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>_. valid_tcbs'\<rbrace>"
+  apply (simp add: threadSet_def)
+  apply (rule hoare_seq_ext[OF _ getObject_tcb_sp])
+  apply (wpsimp wp: setObject_tcb_valid_tcbs')
+  apply (clarsimp simp: obj_at'_def valid_tcbs'_def)
+  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 valid_arch_tcb'_def tcb_cte_cases_def objBits_simps')
+  done
+
 lemma asUser_corres':
   assumes y: "corres_underlying Id False True r \<top> \<top> f g"
   shows      "corres r (tcb_at t and pspace_aligned and pspace_distinct) \<top>
@@ -1496,13 +1665,6 @@ lemma asUser_valid_pspace'[wp]:
                 simp: atcbContextSet_def valid_arch_tcb'_def)+
   done
 
-lemma asUser_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> asUser t m \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: asUser_def split_def)
-  apply (wp hoare_drop_imps | simp)+
-  apply (wp threadSet_valid_queues hoare_drop_imps | simp)+
-  done
-
 lemma asUser_ifunsafe'[wp]:
   "\<lbrace>if_unsafe_then_cap'\<rbrace> asUser t m \<lbrace>\<lambda>rv. if_unsafe_then_cap'\<rbrace>"
   apply (simp add: asUser_def split_def)
@@ -1787,19 +1949,22 @@ lemma ethreadget_corres:
   apply (simp add: x)
   done
 
-lemma setQueue_corres:
-  "corres dc \<top> \<top> (set_tcb_queue d p q) (setQueue d p q)"
-  apply (rule corres_no_failI)
-   apply wp
-  apply (clarsimp simp: setQueue_def in_monad set_tcb_queue_def return_def simpler_modify_def)
-  apply (fastforce simp: state_relation_def ready_queues_relation_def)
-  done
-
-
-lemma getQueue_corres: "corres (=) \<top> \<top> (get_tcb_queue qdom prio) (getQueue qdom prio)"
-  apply (clarsimp simp add: getQueue_def state_relation_def ready_queues_relation_def get_tcb_queue_def gets_def)
-  apply (fold gets_def)
-  apply simp
+lemma getQueue_corres:
+  "corres (\<lambda>ls q. (ls = [] \<longleftrightarrow> tcbQueueEmpty q) \<and> (ls \<noteq> [] \<longrightarrow> tcbQueueHead q = Some (hd ls))
+                  \<and> queue_end_valid ls q)
+     \<top> \<top> (get_tcb_queue qdom prio) (getQueue qdom prio)"
+  apply (clarsimp simp: get_tcb_queue_def getQueue_def tcbQueueEmpty_def)
+  apply (rule corres_bind_return2)
+  apply (rule corres_symb_exec_l[OF _ _ gets_sp])
+    apply (rule corres_symb_exec_r[OF _ gets_sp])
+      apply clarsimp
+      apply (drule state_relation_ready_queues_relation)
+      apply (clarsimp simp: ready_queues_relation_def ready_queue_relation_def Let_def
+                            list_queue_relation_def)
+      apply (drule_tac x=qdom in spec)
+      apply (drule_tac x=prio in spec)
+      apply (fastforce dest: heap_path_head)
+     apply wpsimp+
   done
 
 lemma no_fail_return:
@@ -1814,8 +1979,8 @@ lemma addToBitmap_noop_corres:
      (wp | simp add: state_relation_def | rule no_fail_pre)+
 
 lemma addToBitmap_if_null_noop_corres: (* used this way in Haskell code *)
-  "corres dc \<top> \<top> (return ()) (if null queue then addToBitmap d p else return ())"
-  by (cases "null queue", simp_all add: addToBitmap_noop_corres)
+  "corres dc \<top> \<top> (return ()) (if tcbQueueEmpty queue then addToBitmap d p else return ())"
+  by (cases "tcbQueueHead queue", simp_all add: addToBitmap_noop_corres)
 
 lemma removeFromBitmap_corres_noop:
   "corres dc \<top> \<top> (return ()) (removeFromBitmap tdom prioa)"
@@ -1832,56 +1997,701 @@ crunch typ_at'[wp]: removeFromBitmap "\<lambda>s. P (typ_at' T p s)"
 lemmas addToBitmap_typ_ats [wp] = typ_at_lifts [OF addToBitmap_typ_at']
 lemmas removeFromBitmap_typ_ats [wp] = typ_at_lifts [OF removeFromBitmap_typ_at']
 
+lemma ekheap_relation_tcb_domain_priority:
+  "\<lbrakk>ekheap_relation (ekheap s) (ksPSpace s'); ekheap s t = Some (tcb);
+    ksPSpace s' t = Some (KOTCB tcb')\<rbrakk>
+   \<Longrightarrow> tcbDomain tcb' = tcb_domain tcb \<and> tcbPriority tcb' = tcb_priority tcb"
+  apply (clarsimp simp: ekheap_relation_def)
+  apply (drule_tac x=t in bspec, blast)
+  apply (clarsimp simp: other_obj_relation_def etcb_relation_def)
+  done
+
+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
+
+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: obj_at_def obj_at'_def tcb_relation_cut_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)
+  apply (frule (1) pspace_relation_tcb_relation)
+   apply (fastforce simp: obj_at'_def)
+  apply (fastforce dest!: tcb_rel)
+  done
+
+lemma ekheap_relation_update_tcbs:
+  "\<lbrakk> ekheap_relation (ekheap s) (ksPSpace s'); ekheap s x = Some oetcb;
+     ksPSpace s' x = Some (KOTCB otcb'); etcb_relation etcb tcb' \<rbrakk>
+   \<Longrightarrow> ekheap_relation ((ekheap s)(x \<mapsto> etcb)) ((ksPSpace s')(x \<mapsto> KOTCB tcb'))"
+  by (simp add: ekheap_relation_def)
+
+lemma ekheap_relation_update_concrete_tcb:
+  "\<lbrakk>ekheap_relation (ekheap s) (ksPSpace s'); ekheap s ptr = Some etcb;
+    ksPSpace s' ptr = Some (KOTCB otcb');
+    etcb_relation etcb tcb'\<rbrakk>
+   \<Longrightarrow> ekheap_relation (ekheap s) ((ksPSpace s')(ptr \<mapsto> KOTCB tcb'))"
+  by (fastforce dest: ekheap_relation_update_tcbs simp: map_upd_triv)
+
+lemma ekheap_relation_etcb_relation:
+  "\<lbrakk>ekheap_relation (ekheap s) (ksPSpace s'); ekheap s ptr = Some etcb;
+    ksPSpace s' ptr = Some (KOTCB tcb')\<rbrakk>
+   \<Longrightarrow> etcb_relation etcb tcb'"
+  apply (clarsimp simp: ekheap_relation_def)
+  apply (drule_tac x=ptr in bspec)
+   apply (fastforce simp: obj_at_def)
+  apply (clarsimp simp: obj_at_def obj_at'_def)
+  done
+
+lemma threadSet_ekheap_relation:
+  fixes s :: det_state
+  assumes etcb_rel: "(\<And>etcb tcb'. etcb_relation etcb tcb' \<Longrightarrow> etcb_relation etcb (F tcb'))"
+  shows
+    "\<lbrace>\<lambda>s'. ekheap_relation (ekheap s) (ksPSpace s') \<and> pspace_relation (kheap s) (ksPSpace s')
+           \<and> valid_etcbs s\<rbrace>
+     threadSet F tcbPtr
+     \<lbrace>\<lambda>_ s'. ekheap_relation (ekheap s) (ksPSpace s')\<rbrace>"
+  supply fun_upd_apply[simp del]
+  unfolding threadSet_def setObject_def updateObject_default_def
+  apply (wpsimp wp: getObject_tcb_wp simp: updateObject_default_def)
+  apply (frule tcb_at'_cross)
+   apply (fastforce simp: obj_at'_def)
+  apply normalise_obj_at'
+  apply (frule (1) tcb_at_is_etcb_at)
+  apply (clarsimp simp: obj_at_def is_tcb_def is_etcb_at_def)
+  apply (rename_tac ko, case_tac ko; clarsimp)
+  apply (rule ekheap_relation_update_concrete_tcb)
+     apply fastforce
+    apply fastforce
+   apply (fastforce simp: obj_at'_def)
+  apply (frule (1) ekheap_relation_etcb_relation)
+   apply (fastforce simp: obj_at'_def)
+  apply (fastforce dest!: etcb_rel)
+  done
+
+lemma tcbQueued_update_pspace_relation[wp]:
+  fixes s :: det_state
+  shows "threadSet (tcbQueued_update f) tcbPtr \<lbrace>\<lambda>s'. pspace_relation (kheap s) (ksPSpace s')\<rbrace>"
+  by (wpsimp wp: threadSet_pspace_relation simp: tcb_relation_def)
+
+lemma tcbQueued_update_ekheap_relation[wp]:
+  fixes s :: det_state
+  shows
+    "\<lbrace>\<lambda>s'. ekheap_relation (ekheap s) (ksPSpace s') \<and> pspace_relation (kheap s) (ksPSpace s')
+           \<and> valid_etcbs s\<rbrace>
+     threadSet (tcbQueued_update f) tcbPtr
+     \<lbrace>\<lambda>_ s'. ekheap_relation (ekheap s) (ksPSpace s')\<rbrace>"
+  by (wpsimp wp: threadSet_ekheap_relation simp: etcb_relation_def)
+
+lemma tcbQueueRemove_pspace_relation[wp]:
+  fixes s :: det_state
+  shows "tcbQueueRemove queue tcbPtr \<lbrace>\<lambda>s'. pspace_relation (kheap s) (ksPSpace s')\<rbrace>"
+  unfolding tcbQueueRemove_def
+  by (wpsimp wp: threadSet_pspace_relation hoare_drop_imps simp: tcb_relation_def)
+
+lemma tcbQueueRemove_ekheap_relation[wp]:
+  fixes s :: det_state
+  shows
+    "\<lbrace>\<lambda>s'. ekheap_relation (ekheap s) (ksPSpace s') \<and> pspace_relation (kheap s) (ksPSpace s')
+           \<and> valid_etcbs s\<rbrace>
+     tcbQueueRemove queue tcbPtr
+     \<lbrace>\<lambda>_ s'. ekheap_relation (ekheap s) (ksPSpace s')\<rbrace>"
+  unfolding tcbQueueRemove_def
+  by (wpsimp wp: threadSet_ekheap_relation threadSet_pspace_relation hoare_drop_imps
+           simp: tcb_relation_def etcb_relation_def)
+
+lemma threadSet_ghost_relation[wp]:
+  "threadSet f tcbPtr \<lbrace>\<lambda>s'. ghost_relation (kheap s) (gsUserPages s') (gsCNodes s') (gsPTTypes (ksArchState s'))\<rbrace>"
+  unfolding threadSet_def setObject_def updateObject_default_def
+  apply (wpsimp wp: getObject_tcb_wp simp: updateObject_default_def)
+  apply (clarsimp simp: obj_at'_def)
+  done
+
+lemma removeFromBitmap_ghost_relation[wp]:
+  "removeFromBitmap tdom prio
+   \<lbrace>\<lambda>s'. ghost_relation (kheap s) (gsUserPages s') (gsCNodes s')  (gsPTTypes (ksArchState 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)
+
+crunches tcbQueueRemove, tcbQueuePrepend, tcbQueueAppend, tcbQueueInsert,
+         setQueue, removeFromBitmap
+  for ghost_relation_projs[wp]: "\<lambda>s. P (gsUserPages s) (gsCNodes s) (gsPTTypes (ksArchState 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)
+
+crunches 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
+
+crunches 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)
+
+crunches 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 pspace_canonical'[wp]: pspace_canonical'
+  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 ready_queue_relation_def Let_def)
+  apply (wpsimp wp: threadSet_wp)
+  apply (clarsimp simp: list_queue_relation_def obj_at'_def)
+  apply (rename_tac tcb' d p)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply (clarsimp simp: 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 split: option.splits)
+  done
+
+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>
+   isRunnable tcb_ptr
+   \<lbrace>\<lambda>rv s. \<exists>tcb'. ko_at' tcb' tcb_ptr s
+                  \<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_def)
+  apply (fastforce simp: obj_at'_def split: Structures_H.thread_state.splits)
+  done
+
+crunch (no_fail) no_fail[wp]: isRunnable
+
+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)
+
+crunches 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 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 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_queues_relation_def ready_queue_relation_def Let_def)
+
+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_queues_relation_def ready_queue_relation_def Let_def inQ_def
+                         opt_pred_def
+                  split: option.splits)
+  done
+
 lemma tcbSchedEnqueue_corres:
-  "corres dc (tcb_at t and is_etcb_at t and pspace_aligned and pspace_distinct)
-             (Invariants_H.valid_queues and valid_queues')
-             (tcb_sched_action (tcb_sched_enqueue) t) (tcbSchedEnqueue t)"
-proof -
-  have ready_queues_helper:
-    "\<And>t tcb a b. \<lbrakk> ekheap a t = Some tcb;  obj_at' tcbQueued t b  ;  valid_queues' b  ;
-                   ekheap_relation (ekheap a) (ksPSpace b) \<rbrakk>
-                 \<Longrightarrow> t \<in> set (ksReadyQueues b (tcb_domain tcb, tcb_priority tcb))"
-  unfolding valid_queues'_def
-  by (fastforce dest: ekheap_relation_absD simp: obj_at'_def inQ_def etcb_relation_def)
-
-  show ?thesis unfolding tcbSchedEnqueue_def tcb_sched_action_def
-    apply (rule corres_cross_over_guard[where P'=Q and Q="tcb_at' t and Q" for Q])
-     apply (fastforce simp: tcb_at_cross state_relation_def)
-    apply (rule corres_symb_exec_r [OF _ _ threadGet_inv,
-             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 (rule no_fail_pre, wp, blast)
-    apply (case_tac queued; simp_all)
-     apply (rule corres_no_failI; simp add: no_fail_return)
-     apply (clarsimp simp: in_monad ethread_get_def gets_the_def bind_assoc
-                           assert_opt_def exec_gets is_etcb_at_def get_etcb_def get_tcb_queue_def
-                           set_tcb_queue_def simpler_modify_def ready_queues_relation_def
-                           state_relation_def tcb_sched_enqueue_def)
-     apply (rule ready_queues_helper; auto)
-    apply (clarsimp simp: when_def)
-    apply (rule stronger_corres_guard_imp)
-      apply (rule corres_split[where r'="(=)", OF ethreadget_corres])
-         apply (simp add: etcb_relation_def)
-        apply (rule corres_split[where r'="(=)", OF ethreadget_corres])
-           apply (simp add: etcb_relation_def)
-          apply (rule corres_split[where r'="(=)"])
-             apply simp
-             apply (rule getQueue_corres)
-            apply (rule corres_split_noop_rhs2)
-               apply simp
-               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
-               apply (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 exst_same_def)
-               apply (wp getObject_tcb_wp | simp add: threadGet_def)+
-    apply (fastforce simp: valid_queues_def valid_queues_no_bitmap_def obj_at'_def inQ_def
-                           project_inject)
-    done
-qed
+  "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)
+   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)?)
+
+  \<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)
+
+  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)
+
+  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)
+  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)
+    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 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 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)
+  apply (frule valid_tcbs'_maxPriority[where t=tcbPtr], simp add: obj_at'_def)
+  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)
+  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
+               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 fun_upd_apply split: if_splits)
+   apply (clarsimp simp: fun_upd_apply 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
+           split: if_splits option.splits)
 
 definition
   weak_sch_act_wf :: "scheduler_action \<Rightarrow> kernel_state \<Rightarrow> bool"
@@ -1908,8 +2718,10 @@ lemma getSchedulerAction_corres:
   done
 
 lemma rescheduleRequired_corres:
-  "corres dc (weak_valid_sched_action and valid_etcbs and pspace_aligned and pspace_distinct)
-             (Invariants_H.valid_queues and valid_queues')
+  "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)
@@ -1920,7 +2732,7 @@ lemma rescheduleRequired_corres:
          apply (case_tac action)
            apply simp
           apply simp
-          apply (rule tcbSchedEnqueue_corres)
+          apply (rule tcbSchedEnqueue_corres, simp)
          apply simp
         apply (rule setSchedulerAction_corres)
         apply simp
@@ -1995,20 +2807,18 @@ lemmas addToBitmap_weak_sch_act_wf[wp]
   = weak_sch_act_wf_lift[OF addToBitmap_nosch]
 
 crunch st_tcb_at'[wp]: removeFromBitmap "st_tcb_at' P t"
-crunch pred_tcb_at'[wp]: removeFromBitmap "pred_tcb_at' proj P t"
+crunch pred_tcb_at'[wp]: removeFromBitmap "\<lambda>s. Q (pred_tcb_at' proj P t s)"
 
 crunch not_st_tcb_at'[wp]: removeFromBitmap "\<lambda>s. \<not> (st_tcb_at' P' t) s"
-crunch not_pred_tcb_at'[wp]: removeFromBitmap "\<lambda>s. \<not> (pred_tcb_at' proj P' t) s"
 
 crunch st_tcb_at'[wp]: addToBitmap "st_tcb_at' P' t"
-crunch pred_tcb_at'[wp]: addToBitmap "pred_tcb_at' proj P' t"
+crunch pred_tcb_at'[wp]: addToBitmap "\<lambda>s. Q (pred_tcb_at' proj P t s)"
 
 crunch not_st_tcb_at'[wp]: addToBitmap "\<lambda>s. \<not> (st_tcb_at' P' t) s"
-crunch not_pred_tcb_at'[wp]: addToBitmap "\<lambda>s. \<not> (pred_tcb_at' proj P' t) s"
 
-crunch obj_at'[wp]: removeFromBitmap "obj_at' P t"
+crunch obj_at'[wp]: removeFromBitmap "\<lambda>s. Q (obj_at' P t s)"
 
-crunch obj_at'[wp]: addToBitmap "obj_at' P t"
+crunch obj_at'[wp]: addToBitmap "\<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>"
@@ -2025,9 +2835,11 @@ lemma addToBitmap_tcb_in_cur_domain'[wp]:
   done
 
 lemma tcbSchedDequeue_weak_sch_act_wf[wp]:
-  "\<lbrace> \<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s \<rbrace> tcbSchedDequeue a \<lbrace> \<lambda>_ s. weak_sch_act_wf (ksSchedulerAction s) s \<rbrace>"
-  apply (simp add: tcbSchedDequeue_def)
-  apply (wp threadSet_weak_sch_act_wf removeFromBitmap_weak_sch_act_wf | simp add: crunch_simps)+
+  "tcbSchedDequeue tcbPtr \<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
+  apply (simp add: tcbSchedDequeue_def tcbQueueRemove_def)
+  apply (wp threadSet_weak_sch_act_wf getObject_tcb_wp removeFromBitmap_weak_sch_act_wf
+         | simp add: crunch_simps threadGet_def)+
+  apply (clarsimp simp: obj_at'_def)
   done
 
 lemma dequeue_nothing_eq[simp]:
@@ -2043,47 +2855,342 @@ lemma gets_the_exec: "f s \<noteq> None \<Longrightarrow>  (do x \<leftarrow> ge
                    return_def assert_opt_def)
   done
 
+lemma tcbQueueRemove_no_fail:
+  "no_fail (\<lambda>s. tcb_at' tcbPtr s
+                \<and> (\<exists>ts. list_queue_relation ts queue (tcbSchedNexts_of s) (tcbSchedPrevs_of s)
+                        \<and> tcbPtr \<in> set ts)
+                \<and> sym_heap_sched_pointers s \<and> valid_objs' s)
+           (tcbQueueRemove queue tcbPtr)"
+  unfolding tcbQueueRemove_def
+  apply (wpsimp wp: getObject_tcb_wp)
+  apply normalise_obj_at'
+  apply (frule (1) ko_at_valid_objs')
+   apply fastforce
+  apply (clarsimp simp: list_queue_relation_def)
+  apply (prop_tac "tcbQueueHead queue \<noteq> Some tcbPtr \<longrightarrow> tcbSchedPrevs_of s tcbPtr \<noteq> None")
+   apply (rule impI)
+   apply (frule not_head_prev_not_None[where p=tcbPtr])
+      apply (fastforce simp: inQ_def opt_pred_def opt_map_def obj_at'_def)
+     apply (fastforce dest: heap_path_head)
+    apply fastforce
+   apply (fastforce simp: opt_map_def obj_at'_def valid_tcb'_def valid_bound_tcb'_def)
+  by (fastforce dest!: not_last_next_not_None[where p=tcbPtr]
+                 simp: queue_end_valid_def opt_map_def obj_at'_def valid_obj'_def valid_tcb'_def)
+
+crunch (no_fail) no_fail[wp]: removeFromBitmap
+
+crunches removeFromBitmap
+  for ready_queues_relation[wp]: "ready_queues_relation s"
+  and list_queue_relation[wp]:
+   "\<lambda>s'. list_queue_relation ts (P (ksReadyQueues s'))
+                             (tcbSchedNexts_of s') (tcbSchedPrevs_of s')"
+  (simp: bitmap_fun_defs ready_queues_relation_def)
+
+\<comment> \<open>
+  A direct analogue of tcbQueueRemove, used in tcb_sched_dequeue' below, so that within the proof of
+  tcbQueueRemove_corres, we may reason in terms of the list operations used within this function
+  rather than @{term filter}.\<close>
+definition tcb_queue_remove :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
+  "tcb_queue_remove a ls \<equiv>
+     if ls = [a]
+     then []
+     else if a = hd ls
+          then tl ls
+          else if a = last ls
+               then butlast ls
+               else list_remove ls a"
+
+definition tcb_sched_dequeue' :: "obj_ref \<Rightarrow> unit det_ext_monad" where
+  "tcb_sched_dequeue' tcb_ptr \<equiv> do
+     d \<leftarrow> ethread_get tcb_domain tcb_ptr;
+     prio \<leftarrow> ethread_get tcb_priority tcb_ptr;
+     queue \<leftarrow> get_tcb_queue d prio;
+     when (tcb_ptr \<in> set queue) $ set_tcb_queue d prio (tcb_queue_remove tcb_ptr queue)
+   od"
+
+lemma filter_tcb_queue_remove:
+  "\<lbrakk>a \<in> set ls; distinct ls \<rbrakk> \<Longrightarrow> filter ((\<noteq>) a) ls = tcb_queue_remove a ls"
+  apply (clarsimp simp: tcb_queue_remove_def)
+  apply (intro conjI impI)
+     apply (fastforce elim: filter_hd_equals_tl)
+    apply (fastforce elim: filter_last_equals_butlast)
+   apply (fastforce elim: filter_hd_equals_tl)
+  apply (frule split_list)
+  apply (clarsimp simp: list_remove_middle_distinct)
+  apply (subst filter_True | clarsimp simp: list_remove_none)+
+  done
+
+lemma tcb_sched_dequeue_monadic_rewrite:
+  "monadic_rewrite False True (is_etcb_at t and (\<lambda>s. \<forall>d p. distinct (ready_queues s d p)))
+     (tcb_sched_action tcb_sched_dequeue t) (tcb_sched_dequeue' t)"
+  supply if_split[split del]
+  apply (clarsimp simp: tcb_sched_dequeue'_def tcb_sched_dequeue_def tcb_sched_action_def
+                        set_tcb_queue_def)
+  apply (rule monadic_rewrite_bind_tail)+
+     apply (clarsimp simp: when_def)
+     apply (rule monadic_rewrite_if_r)
+      apply (rule_tac P="\<lambda>_. distinct queue" in monadic_rewrite_guard_arg_cong)
+      apply (frule (1) filter_tcb_queue_remove)
+      apply (metis (mono_tags, lifting) filter_cong)
+     apply (rule monadic_rewrite_modify_noop)
+    apply (wpsimp wp: thread_get_wp)+
+  apply (clarsimp simp: etcb_at_def split: option.splits)
+  apply (prop_tac "(\<lambda>d' p. if d' = tcb_domain x2 \<and> p = tcb_priority x2
+                           then filter (\<lambda>x. x \<noteq> t) (ready_queues s (tcb_domain x2) (tcb_priority x2))
+                           else ready_queues s d' p)
+                   = ready_queues s")
+   apply (subst filter_True)
+    apply fastforce
+   apply (clarsimp intro!: ext split: if_splits)
+  apply fastforce
+  done
+
+crunches removeFromBitmap
+  for ksReadyQueues[wp]: "\<lambda>s. P (ksReadyQueues s)"
+
+lemma list_queue_relation_neighbour_in_set:
+  "\<lbrakk>list_queue_relation ls q hp hp'; sym_heap hp hp'; p \<in> set ls\<rbrakk>
+   \<Longrightarrow> \<forall>nbr. (hp p = Some nbr \<longrightarrow> nbr \<in> set ls) \<and> (hp' p = Some nbr \<longrightarrow> nbr \<in> set ls)"
+  apply (rule heap_ls_neighbour_in_set)
+     apply (fastforce simp: list_queue_relation_def)
+    apply fastforce
+   apply (clarsimp simp: list_queue_relation_def prev_queue_head_def)
+  apply fastforce
+  done
+
+lemma in_queue_not_head_or_not_tail_length_gt_1:
+  "\<lbrakk>tcbPtr \<in> set ls; tcbQueueHead q \<noteq> Some tcbPtr \<or> tcbQueueEnd q \<noteq> Some tcbPtr;
+    list_queue_relation ls q nexts prevs\<rbrakk>
+   \<Longrightarrow> Suc 0 < length ls"
+  apply (clarsimp simp: list_queue_relation_def)
+  apply (cases ls; fastforce simp: queue_end_valid_def)
+  done
+
 lemma tcbSchedDequeue_corres:
-  "corres dc (is_etcb_at t and tcb_at t and pspace_aligned and pspace_distinct)
-             (Invariants_H.valid_queues)
-             (tcb_sched_action tcb_sched_dequeue t) (tcbSchedDequeue t)"
-  apply (rule corres_cross_over_guard[where P'=Q and Q="tcb_at' t and Q" for Q])
-   apply (fastforce simp: tcb_at_cross state_relation_def)
-  apply (simp only: tcbSchedDequeue_def tcb_sched_action_def)
-  apply (rule corres_symb_exec_r[OF _ _ threadGet_inv, where Q'="\<lambda>rv. tcb_at' t and Invariants_H.valid_queues and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"])
-    defer
-    apply (wp threadGet_obj_at', simp, simp)
-   apply (rule no_fail_pre, wp, simp)
-  apply (case_tac queued)
-   defer
-   apply (simp add: when_def)
-   apply (rule corres_no_failI)
-    apply (wp)
-   apply (clarsimp simp: in_monad ethread_get_def set_tcb_queue_def is_etcb_at_def state_relation_def)
-   apply (subgoal_tac "t \<notin> set (ready_queues a (tcb_domain y) (tcb_priority y))")
-    prefer 2
-    subgoal by (force simp: tcb_sched_dequeue_def Invariants_H.valid_queues_def valid_queues_no_bitmap_def
-                            ready_queues_relation_def obj_at'_def inQ_def project_inject)
-   apply (subst gets_the_exec)
-    apply (simp add: get_etcb_def)
-   apply (subst gets_the_exec)
-    apply (simp add: get_etcb_def)
-   apply (simp add: exec_gets simpler_modify_def get_etcb_def ready_queues_relation_def cong: if_cong get_tcb_queue_def)
-  apply (simp add: when_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[where r'="(=)"])
-       apply (rule ethreadget_corres, simp add: etcb_relation_def)
-      apply (rule corres_split[where r'="(=)"])
-         apply (rule ethreadget_corres, simp add: etcb_relation_def)
-        apply (rule corres_split[where r'="(=)"])
-           apply (simp, rule getQueue_corres)
-          apply (rule corres_split_noop_rhs2)
-             apply (simp add: tcb_sched_dequeue_def)
-             apply (rule setQueue_corres)
-            apply (rule corres_split_noop_rhs)
-              apply (clarsimp, rule removeFromBitmap_corres_noop)
-             apply (rule threadSet_corres_noop; simp_all add: tcb_relation_def exst_same_def)
-            apply (wp | simp)+
+  "tcb_ptr = tcbPtr \<Longrightarrow>
+   corres dc
+     (in_correct_ready_q and ready_qs_distinct and valid_etcbs and tcb_at tcb_ptr
+      and pspace_aligned and pspace_distinct)
+     (sym_heap_sched_pointers and valid_objs')
+     (tcb_sched_action tcb_sched_dequeue tcb_ptr) (tcbSchedDequeue tcbPtr)"
+  supply heap_path_append[simp del] fun_upd_apply[simp del] distinct_append[simp del]
+         list_remove_append[simp del]
+  apply (rule_tac Q'="tcb_at' tcbPtr" in corres_cross_add_guard)
+   apply (fastforce intro!: tcb_at_cross simp: obj_at_def is_tcb_def)
+  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 monadic_rewrite_corres_l[where P=P and Q=P for P, simplified])
+   apply (rule monadic_rewrite_guard_imp[OF tcb_sched_dequeue_monadic_rewrite])
+   apply (fastforce dest: tcb_at_is_etcb_at simp: in_correct_ready_q_def ready_qs_distinct_def)
+  apply (clarsimp simp: tcb_sched_dequeue'_def get_tcb_queue_def tcbSchedDequeue_def  getQueue_def
+                        unless_def when_def)
+  apply (rule corres_symb_exec_l[OF _ _ ethread_get_sp]; wpsimp?)
+  apply (rename_tac dom)
+  apply (rule corres_symb_exec_l[OF _ _ ethread_get_sp]; wpsimp?)
+  apply (rename_tac prio)
+  apply (rule corres_symb_exec_l[OF _ _ gets_sp]; (solves wpsimp)?)
+  apply (rule corres_stateAssert_ignore)
+   apply (fastforce intro: ksReadyQueues_asrt_cross)
+  apply (rule corres_symb_exec_r[OF _ threadGet_sp]; (solves wpsimp)?)
+  apply (rule corres_if_strong'; fastforce?)
+    apply (frule state_relation_ready_queues_relation)
+    apply (frule in_ready_q_tcbQueued_eq[where t=tcbPtr])
+    apply (fastforce simp: obj_at'_def opt_pred_def opt_map_def obj_at_def is_tcb_def
+                           in_correct_ready_q_def etcb_at_def is_etcb_at_def)
+  apply (rule corres_symb_exec_r[OF _ threadGet_sp]; wpsimp?)
+  apply (rule corres_symb_exec_r[OF _ threadGet_sp]; wpsimp?)
+  apply (rule corres_symb_exec_r[OF _ gets_sp]; wpsimp?)
+  apply (rule corres_from_valid_det)
+    apply (fastforce intro: det_wp_modify det_wp_pre simp: set_tcb_queue_def)
+   apply (wpsimp wp: tcbQueueRemove_no_fail)
+   apply (fastforce dest: state_relation_ready_queues_relation
+                    simp: ex_abs_underlying_def ready_queues_relation_def ready_queue_relation_def
+                          Let_def inQ_def opt_pred_def opt_map_def obj_at'_def)
+  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 tcbQueueRemove_def
+         split_del: if_split)
+  apply (frule (1) tcb_at_is_etcb_at)
+  apply (clarsimp simp: obj_at_def is_etcb_at_def etcb_at_def)
+  apply normalise_obj_at'
+  apply (rename_tac s d p s' tcb' tcb etcb)
+  apply (frule_tac t=tcbPtr in ekheap_relation_tcb_domain_priority)
+    apply (force simp: obj_at_def)
+   apply (force simp: obj_at'_def)
+
+  apply (case_tac "d \<noteq> tcb_domain etcb \<or> p \<noteq> tcb_priority etcb")
+   apply clarsimp
+   apply (cut_tac p=tcbPtr and ls="ready_queues s (tcb_domain etcb) (tcb_priority etcb)"
+               in list_queue_relation_neighbour_in_set)
+      apply (fastforce dest!: spec)
+     apply fastforce
+    apply fastforce
+   apply (cut_tac xs="ready_queues s d p" in heap_path_head')
+    apply (force dest!: spec simp: ready_queues_relation_def Let_def list_queue_relation_def)
+   apply (cut_tac d=d and d'="tcb_domain etcb" and p=p and p'="tcb_priority etcb"
+               in ready_queues_disjoint)
+      apply force
+     apply fastforce
+    apply fastforce
+   apply (cut_tac ts="ready_queues s d p" in list_queue_relation_nil)
+    apply fast
+   apply (clarsimp simp: tcbQueueEmpty_def)
+   apply (prop_tac "Some tcbPtr \<noteq> tcbQueueHead (ksReadyQueues s' (d, p))")
+    apply (metis hd_in_set not_emptyI option.sel option.simps(2))
+   apply (prop_tac "tcbPtr \<notin> set (ready_queues s d p)")
+    apply blast
+   apply (clarsimp simp: list_queue_relation_def)
+   apply (intro conjI; clarsimp)
+
+    \<comment> \<open>the ready queue is the singleton consisting of tcbPtr\<close>
+    apply (intro conjI)
+         apply (force intro!: heap_path_heap_upd_not_in simp: fun_upd_apply)
+        apply (clarsimp simp: queue_end_valid_def fun_upd_apply)
+       apply (force simp: prev_queue_head_heap_upd fun_upd_apply)
+      apply (clarsimp simp: inQ_def in_opt_pred fun_upd_apply)
+     apply (clarsimp simp: fun_upd_apply)
+    apply (clarsimp simp: fun_upd_apply)
+
+   apply (clarsimp simp: etcb_at_def obj_at'_def)
+   apply (intro conjI; clarsimp)
+
+    \<comment> \<open>tcbPtr is the head of the ready queue\<close>
+    apply (intro conjI)
+         apply (intro heap_path_heap_upd_not_in)
+           apply (force simp: fun_upd_apply)
+          apply (force simp: not_emptyI opt_map_red)
+         apply assumption
+        apply (clarsimp simp: queue_end_valid_def fun_upd_apply)
+       apply (clarsimp simp: prev_queue_head_def fun_upd_apply)
+      apply (clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply split: option.splits)
+     apply (clarsimp simp: fun_upd_apply)
+    apply (clarsimp simp: fun_upd_apply)
+   apply (intro conjI; clarsimp)
+
+    \<comment> \<open>tcbPtr is the end of the ready queue\<close>
+    apply (intro conjI)
+         apply (intro heap_path_heap_upd_not_in)
+           apply (simp add: fun_upd_apply split: if_splits)
+          apply (force simp: not_emptyI opt_map_red)
+         apply (clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply split: option.splits)
+        apply (clarsimp simp: queue_end_valid_def fun_upd_apply)
+       apply (force simp: prev_queue_head_def fun_upd_apply opt_map_red opt_map_upd_triv)
+      apply (clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply split: option.splits)
+     apply (clarsimp simp: fun_upd_apply)
+    apply (clarsimp simp: fun_upd_apply)
+
+   \<comment> \<open>tcbPtr is in the middle of the ready queue\<close>
+   apply (intro conjI)
+     apply (intro heap_path_heap_upd_not_in)
+        apply (simp add: fun_upd_apply)
+       apply (force simp: not_emptyI opt_map_red)
+      apply (force simp: not_emptyI opt_map_red)
+     apply fastforce
+    apply (clarsimp simp: opt_map_red opt_map_upd_triv)
+    apply (intro prev_queue_head_heap_upd)
+      apply (force dest!: spec)
+     apply (metis hd_in_set not_emptyI option.sel option.simps(2))
+    apply fastforce
+   subgoal
+     by (clarsimp simp: inQ_def opt_map_def opt_pred_def fun_upd_apply
+                 split: if_splits option.splits)
+
+  \<comment> \<open>d = tcb_domain tcb \<and> p = tcb_priority tcb\<close>
+  apply clarsimp
+  apply (drule_tac x="tcb_domain etcb" in spec)
+  apply (drule_tac x="tcb_priority etcb" in spec)
+  apply (clarsimp simp: list_queue_relation_def)
+  apply (frule heap_path_head')
+  apply (frule heap_ls_distinct)
+  apply (intro conjI; clarsimp simp: tcbQueueEmpty_def)
+
+   \<comment> \<open>the ready queue is the singleton consisting of tcbPtr\<close>
+   apply (intro conjI)
+      apply (simp add: fun_upd_apply tcb_queue_remove_def queue_end_valid_def heap_ls_unique
+                       heap_path_last_end)
+     apply (simp add: fun_upd_apply tcb_queue_remove_def queue_end_valid_def heap_ls_unique
+                      heap_path_last_end)
+    apply (simp add: fun_upd_apply prev_queue_head_def)
+   apply (case_tac "ready_queues s (tcb_domain etcb) (tcb_priority etcb)";
+          clarsimp simp: tcb_queue_remove_def inQ_def opt_pred_def fun_upd_apply)
+  apply (intro conjI; clarsimp)
+
+   \<comment> \<open>tcbPtr is the head of the ready queue\<close>
+   apply (frule set_list_mem_nonempty)
+   apply (frule in_queue_not_head_or_not_tail_length_gt_1)
+     apply fastforce
+    apply (fastforce simp: list_queue_relation_def)
+   apply (frule list_not_head)
+   apply (clarsimp simp: tcb_queue_remove_def)
+   apply (frule length_tail_nonempty)
+   apply (frule (2) heap_ls_next_of_hd)
+   apply (clarsimp simp: obj_at'_def)
+   apply (intro conjI impI allI)
+      apply (drule (1) heap_ls_remove_head_not_singleton)
+      apply (clarsimp simp: opt_map_red opt_map_upd_triv fun_upd_apply)
+     apply (clarsimp simp: queue_end_valid_def fun_upd_apply last_tl)
+    apply (clarsimp simp: prev_queue_head_def fun_upd_apply)
+   apply (case_tac "ready_queues s (tcb_domain etcb) (tcb_priority etcb)";
+          clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply split: option.splits)
+  apply (intro conjI; clarsimp)
+
+   \<comment> \<open>tcbPtr is the end of the ready queue\<close>
+   apply (frule set_list_mem_nonempty)
+   apply (frule in_queue_not_head_or_not_tail_length_gt_1)
+     apply fast
+    apply (force dest!: spec simp: list_queue_relation_def)
+   apply (clarsimp simp: queue_end_valid_def)
+   apply (frule list_not_last)
+   apply (clarsimp simp: tcb_queue_remove_def)
+   apply (frule length_gt_1_imp_butlast_nonempty)
+   apply (frule (3) heap_ls_prev_of_last)
+   apply (clarsimp simp: obj_at'_def)
+   apply (intro conjI impI; clarsimp?)
+      apply (drule (1) heap_ls_remove_last_not_singleton)
+      apply (force elim!: rsubst3[where P=heap_ls] simp: opt_map_def fun_upd_apply)
+     apply (clarsimp simp: opt_map_def fun_upd_apply)
+    apply (clarsimp simp: prev_queue_head_def fun_upd_apply opt_map_def)
+   apply (clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply split: option.splits)
+   apply (meson distinct_in_butlast_not_last in_set_butlastD last_in_set not_last_in_set_butlast)
+
+  \<comment> \<open>tcbPtr is in the middle of the ready queue\<close>
+  apply (clarsimp simp: obj_at'_def)
+  apply (frule set_list_mem_nonempty)
+  apply (frule split_list)
+  apply clarsimp
+  apply (rename_tac xs ys)
+  apply (prop_tac "xs \<noteq> [] \<and> ys \<noteq> []", fastforce simp: queue_end_valid_def)
+  apply clarsimp
+  apply (frule (2) ptr_in_middle_prev_next)
+   apply fastforce
+  apply (clarsimp simp: tcb_queue_remove_def)
+  apply (prop_tac "tcbPtr \<noteq> last xs")
+   apply (clarsimp simp: distinct_append)
+  apply (prop_tac "tcbPtr \<noteq> hd ys")
+   apply (fastforce dest: hd_in_set simp: distinct_append)
+  apply (prop_tac "last xs \<noteq> hd ys")
+   apply (metis distinct_decompose2 hd_Cons_tl last_in_set)
+  apply (prop_tac "list_remove (xs @ tcbPtr # ys) tcbPtr = xs @ ys")
+   apply (simp add: list_remove_middle_distinct del: list_remove_append)
+  apply (intro conjI impI allI; (solves \<open>clarsimp simp: distinct_append\<close>)?)
+     apply (fastforce elim!: rsubst3[where P=heap_ls]
+                      dest!: heap_ls_remove_middle hd_in_set last_in_set
+                       simp: distinct_append not_emptyI opt_map_def fun_upd_apply)
+    apply (clarsimp simp: queue_end_valid_def fun_upd_apply)
+   apply (case_tac xs;
+          fastforce simp: prev_queue_head_def opt_map_def fun_upd_apply distinct_append)
+  apply (clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply distinct_append
+                 split: option.splits)
   done
 
 lemma thread_get_test: "do cur_ts \<leftarrow> get_thread_state cur; g (test cur_ts) od =
@@ -2143,30 +3250,84 @@ lemma setBoundNotification_corres:
 crunches rescheduleRequired, tcbSchedDequeue, setThreadState, setBoundNotification
   for tcb'[wp]: "tcb_at' addr"
 
+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
+
+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
+
+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)
+
+crunches addToBitmap
+  for valid_objs'[wp]: valid_objs'
+  (simp: unless_def crunch_simps wp: crunch_wps)
+
+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
+
 crunches rescheduleRequired, removeFromBitmap
   for valid_objs'[wp]: valid_objs'
-  (simp: unless_def crunch_simps)
+  (simp: crunch_simps)
 
+lemmas ko_at_valid_objs'_pre =
+  ko_at_valid_objs'[simplified project_inject, atomized, simplified, rule_format]
 
-lemma tcbSchedDequeue_valid_objs' [wp]: "\<lbrace> valid_objs' \<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>_. valid_objs' \<rbrace>"
-  unfolding tcbSchedDequeue_def
-  apply (wp threadSet_valid_objs')
-        apply (clarsimp simp add: valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)
-        apply wp
-       apply (simp add: if_apply_def2)
-       apply (wp hoare_drop_imps)
-       apply (wp | simp cong: if_cong add: valid_tcb'_def tcb_cte_cases_def cteSizeBits_def if_apply_def2)+
+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]
+
+lemma tcbQueueRemove_valid_objs'[wp]:
+  "tcbQueueRemove queue tcbPtr \<lbrace>valid_objs'\<rbrace>"
+  unfolding tcbQueueRemove_def
+  apply (wpsimp wp: getObject_tcb_wp)
+  apply normalise_obj_at'
+  apply (fastforce dest!: tcb_ko_at_valid_objs_valid_tcb'
+                    simp: valid_tcb'_def valid_bound_tcb'_def obj_at'_def)
   done
 
+lemma tcbSchedDequeue_valid_objs'[wp]:
+  "tcbSchedDequeue t \<lbrace>valid_objs'\<rbrace>"
+  unfolding tcbSchedDequeue_def setQueue_def
+  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>"
-  apply (simp add: setThreadState_def setQueue_def isRunnable_def isStopped_def)
-  apply (wp threadSet_valid_objs')
-     apply (simp add: valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)
-     apply (wp threadSet_valid_objs' | simp)+
-  apply (clarsimp simp: valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)
+  "\<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')
+   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':
@@ -2251,18 +3412,6 @@ lemma setQueue_valid_bitmapQ_except[wp]:
   unfolding setQueue_def bitmapQ_defs
   by (wp, clarsimp simp: bitmapQ_def)
 
-lemma setQueue_valid_bitmapQ: (* enqueue only *)
-  "\<lbrace> valid_bitmapQ and (\<lambda>s. (ksReadyQueues s (d, p) = []) = (ts = [])) \<rbrace>
-  setQueue d p ts
-  \<lbrace>\<lambda>_. valid_bitmapQ \<rbrace>"
-  unfolding setQueue_def bitmapQ_defs
-  by (wp, clarsimp simp: bitmapQ_def)
-
-lemma setQueue_valid_queues':
-  "\<lbrace>valid_queues' and (\<lambda>s. \<forall>t. obj_at' (inQ d p) t s \<longrightarrow> t \<in> set ts)\<rbrace>
-    setQueue d p ts \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  by (wp | simp add: valid_queues'_def setQueue_def)+
-
 lemma setQueue_cur:
   "\<lbrace>\<lambda>s. cur_tcb' s\<rbrace> setQueue d p ts \<lbrace>\<lambda>rv s. cur_tcb' s\<rbrace>"
   unfolding setQueue_def cur_tcb'_def
@@ -2400,9 +3549,17 @@ lemma threadSet_queued_sch_act_wf[wp]:
   apply (wp tcb_in_cur_domain'_lift | simp add: obj_at'_def)+
   done
 
+lemma tcbSchedNext_update_pred_tcb_at'[wp]:
+  "threadSet (tcbSchedNext_update f) t \<lbrace>\<lambda>s. P (pred_tcb_at' proj P' t' s)\<rbrace>"
+  by (wp threadSet_pred_tcb_no_state crunch_wps | clarsimp simp: tcb_to_itcb'_def)+
+
+lemma tcbSchedPrev_update_pred_tcb_at'[wp]:
+  "threadSet (tcbSchedPrev_update f) t \<lbrace>\<lambda>s. P (pred_tcb_at' proj P' t' s)\<rbrace>"
+  by (wp threadSet_pred_tcb_no_state crunch_wps | clarsimp simp: tcb_to_itcb'_def)+
+
 lemma tcbSchedEnqueue_pred_tcb_at'[wp]:
   "\<lbrace>\<lambda>s. pred_tcb_at' proj P' t' s \<rbrace> tcbSchedEnqueue t \<lbrace>\<lambda>_ s. pred_tcb_at' proj P' t' s\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def when_def unless_def)
+  apply (simp add: tcbSchedEnqueue_def tcbQueuePrepend_def when_def unless_def)
   apply (wp threadSet_pred_tcb_no_state crunch_wps | clarsimp simp: tcb_to_itcb'_def)+
   done
 
@@ -2410,8 +3567,9 @@ lemma tcbSchedDequeue_sch_act_wf[wp]:
   "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>
     tcbSchedDequeue t
    \<lbrace>\<lambda>_ s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  unfolding tcbSchedDequeue_def
-  by (wp setQueue_sch_act | wp sch_act_wf_lift | simp add: if_apply_def2)+
+  unfolding tcbSchedDequeue_def tcbQueueRemove_def
+  by (wp setQueue_sch_act threadSet_tcbDomain_triv hoare_drop_imps
+      | wp sch_act_wf_lift | simp add: if_apply_def2)+
 
 crunch nosch: tcbSchedDequeue "\<lambda>s. P (ksSchedulerAction s)"
 
@@ -2507,21 +3665,22 @@ lemma tcbSchedEnqueue_sch_act[wp]:
   "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>
     tcbSchedEnqueue t
    \<lbrace>\<lambda>_ s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  by (simp add: tcbSchedEnqueue_def unless_def)
-     (wp setQueue_sch_act | wp sch_act_wf_lift  | clarsimp)+
+  by (simp add: tcbSchedEnqueue_def tcbQueuePrepend_def unless_def)
+     (wp setQueue_sch_act threadSet_tcbDomain_triv | wp sch_act_wf_lift  | clarsimp)+
 
 lemma tcbSchedEnqueue_weak_sch_act[wp]:
   "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
     tcbSchedEnqueue t
    \<lbrace>\<lambda>_ s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
+  apply (simp add: tcbSchedEnqueue_def tcbQueuePrepend_def unless_def)
   apply (wp setQueue_sch_act threadSet_weak_sch_act_wf | clarsimp)+
   done
 
-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>"
+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
+  apply (clarsimp simp: obj_at'_def)
   done
 
 lemma threadGet_const:
@@ -2567,14 +3726,6 @@ lemma addToBitmap_bitmapQ:
   by (wpsimp simp: bitmap_fun_defs bitmapQ_def prioToL1Index_bit_set prioL2Index_bit_set
              simp_del: bit_exp_iff)
 
-lemma addToBitmap_valid_queues_no_bitmap_except:
-" \<lbrace> valid_queues_no_bitmap_except t \<rbrace>
-     addToBitmap d p
-  \<lbrace>\<lambda>_. valid_queues_no_bitmap_except t \<rbrace>"
-  unfolding addToBitmap_def modifyReadyQueuesL1Bitmap_def modifyReadyQueuesL2Bitmap_def
-             getReadyQueuesL1Bitmap_def getReadyQueuesL2Bitmap_def valid_queues_no_bitmap_except_def
-  by (wp, clarsimp)
-
 crunch norq[wp]: addToBitmap "\<lambda>s. P (ksReadyQueues s)"
   (wp: updateObject_cte_inv hoare_drop_imps)
 crunch norq[wp]: removeFromBitmap "\<lambda>s. P (ksReadyQueues s)"
@@ -2606,9 +3757,8 @@ lemma prioToL1Index_complement_nth_w2p:
 
 lemma valid_bitmapQ_exceptE:
   "\<lbrakk> valid_bitmapQ_except d' p' s ; d \<noteq> d' \<or> p \<noteq> p' \<rbrakk>
-   \<Longrightarrow> bitmapQ d p s = (ksReadyQueues s (d, p) \<noteq> [])"
-   unfolding valid_bitmapQ_except_def
-   by blast
+   \<Longrightarrow> bitmapQ d p s = (\<not> tcbQueueEmpty (ksReadyQueues s (d, p)))"
+  by (fastforce simp: valid_bitmapQ_except_def)
 
 lemma invertL1Index_eq_cancelD:
   "\<lbrakk>  invertL1Index i = invertL1Index j ; i < l2BitmapSize ; j < l2BitmapSize \<rbrakk>
@@ -2723,22 +3873,15 @@ lemma addToBitmap_valid_bitmapQ_except:
   done
 
 lemma addToBitmap_valid_bitmapQ:
-" \<lbrace> valid_bitmapQ_except d p and bitmapQ_no_L2_orphans and
-    (\<lambda>s. ksReadyQueues s (d,p) \<noteq> []) \<rbrace>
-     addToBitmap d p
-  \<lbrace>\<lambda>_. valid_bitmapQ \<rbrace>"
-proof -
-  have "\<lbrace> valid_bitmapQ_except d p and bitmapQ_no_L2_orphans and
-            (\<lambda>s. ksReadyQueues s (d,p) \<noteq> []) \<rbrace>
-         addToBitmap d p
-         \<lbrace>\<lambda>_. valid_bitmapQ_except d p and
-              bitmapQ_no_L2_orphans and (\<lambda>s. bitmapQ d p s \<and> ksReadyQueues s (d,p) \<noteq> []) \<rbrace>"
-  by (wp addToBitmap_valid_queues_no_bitmap_except addToBitmap_valid_bitmapQ_except
-            addToBitmap_bitmapQ_no_L2_orphans addToBitmap_bitmapQ; simp)
-
-  thus ?thesis
-    by - (erule hoare_strengthen_post; fastforce elim: valid_bitmap_valid_bitmapQ_exceptE)
-qed
+  "\<lbrace>valid_bitmapQ_except d p and bitmapQ_no_L2_orphans
+    and (\<lambda>s. \<not> tcbQueueEmpty (ksReadyQueues s (d,p)))\<rbrace>
+   addToBitmap d p
+   \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
+  (is "\<lbrace>?pre\<rbrace> _ \<lbrace>_\<rbrace>")
+  apply (rule_tac Q="\<lambda>_ s. ?pre s \<and> bitmapQ d p s" in hoare_strengthen_post)
+   apply (wpsimp wp: addToBitmap_valid_bitmapQ_except addToBitmap_bitmapQ)
+  apply (fastforce elim: valid_bitmap_valid_bitmapQ_exceptE)
+  done
 
 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>"
@@ -2756,12 +3899,6 @@ lemma threadGet_const_tcb_at_imp_lift:
   apply (clarsimp simp: obj_at'_def)
   done
 
-lemma valid_queues_no_bitmap_objD:
-  "\<lbrakk> valid_queues_no_bitmap s; t \<in> set (ksReadyQueues s (d, p))\<rbrakk>
-   \<Longrightarrow> obj_at' (inQ d p and runnable' \<circ> tcbState) t s"
-   unfolding valid_queues_no_bitmap_def
-   by metis
-
 lemma setQueue_bitmapQ_no_L1_orphans[wp]:
   "\<lbrace> bitmapQ_no_L1_orphans \<rbrace>
        setQueue d p ts
@@ -2781,126 +3918,6 @@ lemma setQueue_sets_queue[wp]:
   unfolding setQueue_def
   by (wp, simp)
 
-lemma tcbSchedEnqueueOrAppend_valid_queues:
-  (* f is either (t#ts) or (ts @ [t]), so we define its properties generally *)
-  assumes f_set[simp]: "\<And>ts. t \<in> set (f ts)"
-  assumes f_set_insert[simp]: "\<And>ts. set (f ts) = insert t (set ts)"
-  assumes f_not_empty[simp]: "\<And>ts. f ts \<noteq> []"
-  assumes f_distinct: "\<And>ts. \<lbrakk> distinct ts ; t \<notin> set ts \<rbrakk> \<Longrightarrow> distinct (f ts)"
-  shows "\<lbrace>Invariants_H.valid_queues and st_tcb_at' runnable' t and valid_objs' \<rbrace>
-    do queued \<leftarrow> threadGet tcbQueued t;
-       unless queued $
-       do tdom \<leftarrow> threadGet tcbDomain t;
-          prio \<leftarrow> threadGet tcbPriority t;
-          queue \<leftarrow> getQueue tdom prio;
-          setQueue tdom prio $ f queue;
-          when (null queue) $ addToBitmap tdom prio;
-          threadSet (tcbQueued_update (\<lambda>_. True)) t
-       od
-    od
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-proof -
-
-  define could_run where "could_run ==
-    \<lambda>d p t. obj_at' (\<lambda>tcb. inQ d p (tcbQueued_update (\<lambda>_. True) tcb) \<and> runnable' (tcbState tcb)) t"
-
-  have addToBitmap_could_run:
-  "\<And>d p. \<lbrace>\<lambda>s. \<forall>d p. t \<in> set (ksReadyQueues s (d, p)) \<longrightarrow> could_run d p t s\<rbrace>
-         addToBitmap d p
-         \<lbrace>\<lambda>_ s. \<forall>d p. t \<in> set (ksReadyQueues s (d, p)) \<longrightarrow> could_run d p t s\<rbrace>"
-    unfolding bitmap_fun_defs
-    by (wp, clarsimp simp: could_run_def)
-
-  have setQueue_valid_queues_no_bitmap_except:
-    "\<And>d p ts.
-     \<lbrace> valid_queues_no_bitmap_except t and
-       (\<lambda>s. ksReadyQueues s (d, p) = ts \<and> p \<le> maxPriority \<and> d \<le> maxDomain \<and> t \<notin> set ts) \<rbrace>
-         setQueue d p (f ts)
-     \<lbrace>\<lambda>rv. valid_queues_no_bitmap_except t\<rbrace>"
-    unfolding setQueue_def valid_queues_no_bitmap_except_def null_def
-    by (wp, auto intro: f_distinct)
-
-  have threadSet_valid_queues_could_run:
-   "\<And>f. \<lbrace> valid_queues_no_bitmap_except t and
-          (\<lambda>s. \<forall>d p. t \<in> set (ksReadyQueues s (d,p)) \<longrightarrow> could_run d p t s) and
-          valid_bitmapQ and bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans \<rbrace>
-            threadSet (tcbQueued_update (\<lambda>_. True)) t
-         \<lbrace>\<lambda>rv. Invariants_H.valid_queues \<rbrace>"
-    unfolding threadSet_def could_run_def
-    apply (rule hoare_seq_ext[OF _ getObject_tcb_sp])
-    apply (rule hoare_pre)
-     apply (simp add: valid_queues_def valid_queues_no_bitmap_def)
-     apply (wp setObject_queues_unchanged_tcb hoare_Ball_helper hoare_vcg_all_lift
-               setObject_tcb_strongest)
-    apply (clarsimp simp: valid_queues_no_bitmap_except_def obj_at'_def)
-    done
-
-  have setQueue_could_run: "\<And>d p ts.
-    \<lbrace> valid_queues and (\<lambda>_. t \<in> set ts) and
-      (\<lambda>s. could_run d p t s) \<rbrace>
-    setQueue d p ts
-    \<lbrace>\<lambda>rv s. (\<forall>d p. t \<in> set (ksReadyQueues s (d, p)) \<longrightarrow> could_run d p t s)\<rbrace>"
-    unfolding setQueue_def valid_queues_def could_run_def
-    by wp (fastforce dest: valid_queues_no_bitmap_objD simp: obj_at'_def inQ_def)
-
-  note hoare_vcg_if_lift[wp] hoare_vcg_conj_lift[wp] hoare_vcg_const_imp_lift[wp]
-
-  show ?thesis
-  unfolding tcbSchedEnqueue_def null_def
-  apply (rule hoare_pre)
-   apply (rule hoare_seq_ext)
-    apply (simp add: unless_def)
-    apply (wp threadSet_valid_queues_could_run)
-        apply (wp addToBitmap_could_run addToBitmap_valid_bitmapQ
-                  addToBitmap_valid_queues_no_bitmap_except addToBitmap_bitmapQ_no_L2_orphans)+
-       apply (wp setQueue_valid_queues_no_bitmap_except setQueue_could_run
-                 setQueue_valid_bitmapQ_except setQueue_sets_queue setQueue_valid_bitmapQ)+
-      apply (wp threadGet_const_tcb_at_imp_lift | simp add: if_apply_def2)+
-  apply clarsimp
-  apply (frule pred_tcb_at')
-  apply (frule (1) valid_objs'_maxDomain)
-  apply (frule (1) valid_objs'_maxPriority)
-  apply (clarsimp simp: valid_queues_def st_tcb_at'_def obj_at'_def valid_queues_no_bitmap_exceptI)
-  apply (fastforce dest!: valid_queues_no_bitmap_objD simp: obj_at'_def inQ_def could_run_def)
-  done
-qed
-
-lemma tcbSchedEnqueue_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues
-    and st_tcb_at' runnable' t
-    and valid_objs' \<rbrace>
-     tcbSchedEnqueue t
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-   unfolding tcbSchedEnqueue_def
-   by (fastforce intro:  tcbSchedEnqueueOrAppend_valid_queues)
-
-lemma tcbSchedAppend_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues
-    and st_tcb_at' runnable' t
-    and valid_objs' \<rbrace>
-     tcbSchedAppend t
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-   unfolding tcbSchedAppend_def
-   by (fastforce intro:  tcbSchedEnqueueOrAppend_valid_queues)
-
-lemma rescheduleRequired_valid_queues[wp]:
-  "\<lbrace>\<lambda>s. Invariants_H.valid_queues s \<and> valid_objs' s \<and>
-        weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | wpc | simp)+
-  apply (fastforce simp: weak_sch_act_wf_def elim: valid_objs'_maxDomain valid_objs'_maxPriority)
-  done
-
-lemma rescheduleRequired_valid_queues_sch_act_simple:
-  "\<lbrace>Invariants_H.valid_queues and sch_act_simple\<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | wpc | simp | fastforce simp: Invariants_H.valid_queues_def sch_act_simple_def)+
-  done
-
 lemma rescheduleRequired_valid_bitmapQ_sch_act_simple:
   "\<lbrace> valid_bitmapQ and sch_act_simple\<rbrace>
     rescheduleRequired
@@ -2942,151 +3959,32 @@ lemma rescheduleRequired_bitmapQ_no_L2_orphans_sch_act_simple:
 
 lemma sts_valid_bitmapQ_sch_act_simple:
   "\<lbrace>valid_bitmapQ and sch_act_simple\<rbrace>
-    setThreadState st t
+   setThreadState st t
    \<lbrace>\<lambda>_. valid_bitmapQ \<rbrace>"
   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 Invariants_H.valid_queues_def inQ_def)+
+   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>"
+  "\<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 Invariants_H.valid_queues_def inQ_def)+
+   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>"
+  "\<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)
   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 Invariants_H.valid_queues_def inQ_def)+
-  done
-
-lemma sts_valid_queues:
-  "\<lbrace>\<lambda>s. Invariants_H.valid_queues s \<and>
-    ((\<exists>p. t \<in> set(ksReadyQueues s p)) \<longrightarrow> runnable' st)\<rbrace>
-   setThreadState st t \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: setThreadState_def)
-  apply (wp rescheduleRequired_valid_queues_sch_act_simple
-            threadSet_valid_queues [THEN hoare_strengthen_post])
-   apply (clarsimp simp: sch_act_simple_def Invariants_H.valid_queues_def inQ_def)+
-  done
-
-lemma sbn_valid_queues:
-  "\<lbrace>\<lambda>s. Invariants_H.valid_queues s\<rbrace>
-   setBoundNotification ntfn t \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: setBoundNotification_def)
-  apply (wp threadSet_valid_queues [THEN hoare_strengthen_post])
-   apply (clarsimp simp: sch_act_simple_def Invariants_H.valid_queues_def inQ_def)+
-  done
-
-
-
-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]:
-  "\<lbrace>valid_queues' and st_tcb_at' runnable' t \<rbrace>
-    tcbSchedEnqueue t
-   \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def)
-  apply (rule hoare_pre)
-   apply (rule_tac B="\<lambda>rv. valid_queues' and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"
-           in hoare_seq_ext)
-    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 inQ_def)
-       apply (wp setQueue_valid_queues' | simp | simp add: setQueue_def)+
-     apply (wp getObject_tcb_wp | simp add: threadGet_def)+
-     apply (clarsimp simp: obj_at'_def inQ_def valid_queues'_def)
-    apply (wp getObject_tcb_wp | simp add: threadGet_def)+
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-lemma rescheduleRequired_valid_queues'_weak[wp]:
-  "\<lbrace>\<lambda>s. valid_queues' s \<and> weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply wpsimp
-  apply (clarsimp simp: weak_sch_act_wf_def)
-  done
-
-lemma rescheduleRequired_valid_queues'_sch_act_simple:
-  "\<lbrace>valid_queues' and sch_act_simple\<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | wpc | simp | fastforce simp: valid_queues'_def sch_act_simple_def)+
-  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)
-  apply (wp rescheduleRequired_valid_queues'_sch_act_simple)
-  apply (rule_tac Q="\<lambda>_. valid_queues'" in hoare_post_imp)
-   apply (clarsimp simp: sch_act_simple_def)
-  apply (wp threadSet_valid_queues')
-  apply (fastforce simp: inQ_def obj_at'_def pred_tcb_at'_def)
-  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 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 cteSizeBits_def valid_tcb_state'_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)
-  apply (wp threadSet_valid_objs' | clarsimp simp: valid_tcb'_tcbState_update)+
-  done
-
-lemma rescheduleRequired_ksQ:
-  "\<lbrace>\<lambda>s. sch_act_simple s \<and> P (ksReadyQueues s p)\<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_ s. P (ksReadyQueues s p)\<rbrace>"
-  including no_pre
-  apply (simp add: rescheduleRequired_def sch_act_simple_def)
-  apply (rule_tac B="\<lambda>rv s. (rv = ResumeCurrentThread \<or> rv = ChooseNewThread)
-                            \<and> P (ksReadyQueues s p)" in hoare_seq_ext)
-   apply wpsimp
-   apply (case_tac x; simp)
-  apply wp
+   apply (clarsimp simp: sch_act_simple_def inQ_def)+
   done
 
 lemma setSchedulerAction_ksQ[wp]:
@@ -3101,17 +3999,6 @@ lemma sbn_ksQ:
   "\<lbrace>\<lambda>s. P (ksReadyQueues s p)\<rbrace> setBoundNotification ntfn t \<lbrace>\<lambda>rv s. P (ksReadyQueues s p)\<rbrace>"
   by (simp add: setBoundNotification_def, wp)
 
-lemma sts_ksQ:
-  "\<lbrace>\<lambda>s. sch_act_simple s \<and> P (ksReadyQueues s p)\<rbrace>
-    setThreadState st t
-   \<lbrace>\<lambda>_ s. P (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: setThreadState_def)
-  apply (wp rescheduleRequired_ksQ)
-  apply (rule_tac Q="\<lambda>_ s. P (ksReadyQueues s p)" in hoare_post_imp)
-   apply (clarsimp simp: sch_act_simple_def)+
-  apply (wp, simp)
-  done
-
 lemma setQueue_ksQ[wp]:
   "\<lbrace>\<lambda>s. P ((ksReadyQueues s)((d, p) := q))\<rbrace>
      setQueue d p q
@@ -3119,22 +4006,6 @@ lemma setQueue_ksQ[wp]:
   by (simp add: setQueue_def fun_upd_def[symmetric]
            | wp)+
 
-lemma tcbSchedEnqueue_ksQ:
-  "\<lbrace>\<lambda>s. t' \<notin> set (ksReadyQueues s p) \<and> t' \<noteq> t \<rbrace>
-   tcbSchedEnqueue t \<lbrace>\<lambda>_ s. t' \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply (wpsimp wp: hoare_vcg_imp_lift threadGet_wp)
-  apply (drule obj_at_ko_at')
-  apply fastforce
-  done
-
-lemma rescheduleRequired_ksQ':
-  "\<lbrace>\<lambda>s. t \<notin> set (ksReadyQueues s p) \<and> sch_act_not t s \<rbrace>
-   rescheduleRequired \<lbrace>\<lambda>_ s. t \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wpsimp wp: tcbSchedEnqueue_ksQ)
-  done
-
 lemma threadSet_tcbState_st_tcb_at':
   "\<lbrace>\<lambda>s. P st \<rbrace> threadSet (tcbState_update (\<lambda>_. st)) t \<lbrace>\<lambda>_. st_tcb_at' P t\<rbrace>"
   apply (simp add: threadSet_def pred_tcb_at'_def)
@@ -3145,36 +4016,6 @@ lemma isRunnable_const:
   "\<lbrace>st_tcb_at' runnable' t\<rbrace> isRunnable t \<lbrace>\<lambda>runnable _. runnable \<rbrace>"
   by (rule isRunnable_wp)
 
-lemma sts_ksQ':
-  "\<lbrace>\<lambda>s. (runnable' st \<or> ksCurThread s \<noteq> t) \<and> P (ksReadyQueues s p)\<rbrace>
-   setThreadState st t
-   \<lbrace>\<lambda>_ s. P (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: setThreadState_def)
-  apply (rule hoare_pre_disj')
-   apply (rule hoare_seq_ext [OF _
-                 hoare_vcg_conj_lift
-                   [OF threadSet_tcbState_st_tcb_at' [where P=runnable']
-                       threadSet_ksQ]])
-   apply (rule hoare_seq_ext [OF _
-                 hoare_vcg_conj_lift [OF isRunnable_const isRunnable_inv]])
-   apply (clarsimp simp: when_def)
-   apply (case_tac x)
-    apply (clarsimp, wp)[1]
-   apply (clarsimp)
-  apply (rule hoare_seq_ext [OF _
-                hoare_vcg_conj_lift
-                  [OF threadSet_ct threadSet_ksQ]])
-  apply (rule hoare_seq_ext [OF _ isRunnable_inv])
-  apply (rule hoare_seq_ext [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 valid_ipc_buffer_ptr'D:
   assumes yv: "y < unat max_ipc_words"
   and    buf: "valid_ipc_buffer_ptr' a s"
@@ -3635,11 +4476,11 @@ qed
 lemmas valid_ipc_buffer_cap_simps = valid_ipc_buffer_cap_def [split_simps cap.split arch_cap.split]
 
 lemma lookupIPCBuffer_corres':
-  "corres (=) (tcb_at t and valid_objs and pspace_aligned and pspace_distinct)
-              (no_0_obj')
-              (lookup_ipc_buffer w t) (lookupIPCBuffer w t)"
-  apply (rule corres_cross_over_guard[where P'=Q and
-                                            Q="pspace_aligned' and pspace_distinct' and Q" for Q])
+  "corres (=)
+     (tcb_at t and valid_objs and pspace_aligned and pspace_distinct)
+     (valid_objs' and no_0_obj')
+     (lookup_ipc_buffer w t) (lookupIPCBuffer w t)"
+  apply (rule corres_cross_add_guard[where Q'="pspace_aligned' and pspace_distinct'"])
    apply (fastforce simp: pspace_aligned_cross pspace_distinct_cross state_relation_def)
   apply (simp add: lookup_ipc_buffer_def AARCH64_H.lookupIPCBuffer_def)
   apply (rule corres_guard_imp)
@@ -3684,11 +4525,11 @@ lemma lookupIPCBuffer_corres':
   done
 
 lemma lookupIPCBuffer_corres:
-  "corres (=) (tcb_at t and invs) (no_0_obj') (lookup_ipc_buffer w t) (lookupIPCBuffer w t)"
+  "corres (=) (tcb_at t and invs) (valid_objs' and no_0_obj')
+     (lookup_ipc_buffer w t) (lookupIPCBuffer w t)"
   using lookupIPCBuffer_corres'
   by (rule corres_guard_imp, auto simp: invs'_def valid_state'_def)
 
-
 crunch inv[wp]: lookupIPCBuffer P
   (wp: crunch_wps simp: crunch_simps)
 
@@ -3749,7 +4590,7 @@ lemma ct_in_state'_set:
 
 crunches setQueue, rescheduleRequired, tcbSchedDequeue
   for idle'[wp]: "valid_idle'"
-  (simp: crunch_simps)
+  (simp: crunch_simps wp: crunch_wps)
 
 lemma sts_valid_idle'[wp]:
   "\<lbrace>valid_idle' and valid_pspace' and
@@ -3789,8 +4630,9 @@ lemma gbn_sp':
 
 lemma tcbSchedDequeue_tcbState_obj_at'[wp]:
   "\<lbrace>obj_at' (P \<circ> tcbState) t'\<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>rv. obj_at' (P \<circ> tcbState) t'\<rbrace>"
-  apply (simp add: tcbSchedDequeue_def)
-  apply (wp | simp add: o_def split del: if_split cong: if_cong)+
+  apply (simp add: tcbSchedDequeue_def tcbQueueRemove_def)
+  apply (wpsimp wp: getObject_tcb_wp simp: o_def threadGet_def)
+  apply (clarsimp simp: obj_at'_def)
   done
 
 crunch typ_at'[wp]: setQueue "\<lambda>s. P' (typ_at' P t s)"
@@ -3809,10 +4651,14 @@ lemma setQueue_pred_tcb_at[wp]:
 lemma tcbSchedDequeue_pred_tcb_at'[wp]:
   "\<lbrace>\<lambda>s. P' (pred_tcb_at' proj P t' s)\<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>_ s. P' (pred_tcb_at' proj P t' s)\<rbrace>"
   apply (rule_tac P=P' in P_bool_lift)
-   apply (simp add: tcbSchedDequeue_def)
-   apply (wp threadSet_pred_tcb_no_state | clarsimp simp: tcb_to_itcb'_def)+
-  apply (simp add: tcbSchedDequeue_def)
-  apply (wp threadSet_pred_tcb_no_state | clarsimp simp: tcb_to_itcb'_def)+
+   apply (simp add: tcbSchedDequeue_def tcbQueueRemove_def)
+   apply (wpsimp wp: threadSet_pred_tcb_no_state getObject_tcb_wp
+               simp: threadGet_def tcb_to_itcb'_def)
+   apply (clarsimp simp: obj_at'_def)
+  apply (simp add: tcbSchedDequeue_def tcbQueueRemove_def)
+  apply (wpsimp wp: threadSet_pred_tcb_no_state getObject_tcb_wp
+              simp: threadGet_def tcb_to_itcb'_def)
+  apply (clarsimp simp: obj_at'_def)
   done
 
 lemma sts_st_tcb':
@@ -3926,39 +4772,153 @@ crunch nonz_cap[wp]: addToBitmap "ex_nonz_cap_to' t"
 crunch iflive'[wp]: removeFromBitmap if_live_then_nonz_cap'
 crunch nonz_cap[wp]: removeFromBitmap "ex_nonz_cap_to' t"
 
-lemma tcbSchedEnqueue_iflive'[wp]:
-  "\<lbrace>if_live_then_nonz_cap' and ex_nonz_cap_to' tcb\<rbrace>
-    tcbSchedEnqueue tcb \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply (wp threadSet_iflive' hoare_drop_imps | simp add: crunch_simps)+
+crunches rescheduleRequired
+  for cap_to'[wp]: "ex_nonz_cap_to' p"
+
+lemma tcbQueued_update_tcb_cte_cases:
+  "(getF, setF) \<in> ran tcb_cte_cases \<Longrightarrow> getF (tcbQueued_update f tcb) = getF tcb"
+  unfolding tcb_cte_cases_def
+  by (case_tac tcb; fastforce simp: objBits_simps')
+
+lemma tcbSchedNext_update_tcb_cte_cases:
+  "(getF, setF) \<in> ran tcb_cte_cases \<Longrightarrow> getF (tcbSchedNext_update f tcb) = getF tcb"
+  unfolding tcb_cte_cases_def
+  by (case_tac tcb; fastforce simp: objBits_simps')
+
+lemma tcbSchedPrev_update_tcb_cte_cases:
+  "(getF, setF) \<in> ran tcb_cte_cases \<Longrightarrow> getF (tcbSchedPrev_update f tcb) = getF tcb"
+  unfolding tcb_cte_cases_def
+  by (case_tac tcb; fastforce simp: objBits_simps')
+
+lemma tcbSchedNext_update_ctes_of[wp]:
+  "threadSet (tcbSchedNext_update f) tptr \<lbrace>\<lambda>s. P (ctes_of s)\<rbrace>"
+  by (wpsimp wp: threadSet_ctes_ofT simp: tcbSchedNext_update_tcb_cte_cases)
+
+lemma tcbSchedPrev_update_ctes_of[wp]:
+  "threadSet (tcbSchedPrev_update f) tptr \<lbrace>\<lambda>s. P (ctes_of s)\<rbrace>"
+  by (wpsimp wp: threadSet_ctes_ofT simp: tcbSchedPrev_update_tcb_cte_cases)
+
+lemma tcbSchedNext_ex_nonz_cap_to'[wp]:
+  "threadSet (tcbSchedNext_update f) tptr \<lbrace>ex_nonz_cap_to' p\<rbrace>"
+  by (wpsimp wp: threadSet_cap_to simp: tcbSchedNext_update_tcb_cte_cases)
+
+lemma tcbSchedPrev_ex_nonz_cap_to'[wp]:
+  "threadSet (tcbSchedPrev_update f) tptr \<lbrace>ex_nonz_cap_to' p\<rbrace>"
+  by (wpsimp wp: threadSet_cap_to simp: tcbSchedPrev_update_tcb_cte_cases)
+
+lemma tcbSchedNext_update_iflive':
+  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s \<and> ex_nonz_cap_to' t s\<rbrace>
+   threadSet (tcbSchedNext_update f) t
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  by (wpsimp wp: threadSet_iflive'T simp: tcbSchedNext_update_tcb_cte_cases)
+
+lemma tcbSchedPrev_update_iflive':
+  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s \<and> ex_nonz_cap_to' t s\<rbrace>
+   threadSet (tcbSchedPrev_update f) t
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  by (wpsimp wp: threadSet_iflive'T simp: tcbSchedPrev_update_tcb_cte_cases)
+
+lemma tcbQueued_update_iflive'[wp]:
+  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s \<and> ex_nonz_cap_to' t s\<rbrace>
+   threadSet (tcbQueued_update f) t
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  by (wpsimp wp: threadSet_iflive'T simp: tcbQueued_update_tcb_cte_cases)
+
+lemma getTCB_wp:
+  "\<lbrace>\<lambda>s. \<forall>ko :: tcb. ko_at' ko p s \<longrightarrow> Q ko s\<rbrace> getObject p \<lbrace>Q\<rbrace>"
+  apply (wpsimp wp: getObject_tcb_wp)
+  apply (clarsimp simp: obj_at'_def)
   done
 
-lemma rescheduleRequired_iflive'[wp]:
-  "\<lbrace>if_live_then_nonz_cap'
-        and (\<lambda>s. \<forall>t. ksSchedulerAction s = SwitchToThread t
-                \<longrightarrow> st_tcb_at' runnable' t s)\<rbrace>
-      rescheduleRequired
-   \<lbrace>\<lambda>rv. if_live_then_nonz_cap'\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | wpc | simp)+
-  apply (clarsimp simp: pred_tcb_at'_def obj_at'_real_def)
-  apply (erule(1) if_live_then_nonz_capD')
-  apply (fastforce simp: live'_def)
+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')
+  by (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 ko_wp_at'_def opt_tcb_at'_def live'_def)
+
+lemma tcbQueueRemove_ex_nonz_cap_to'[wp]:
+  "tcbQueueRemove q tcbPtr \<lbrace>ex_nonz_cap_to' tcbPtr'\<rbrace>"
+  unfolding tcbQueueRemove_def
+  by (wpsimp wp: threadSet_cap_to' hoare_drop_imps getTCB_wp)
+
+(* We could write this one as "\<forall>t. tcbQueueHead t \<longrightarrow> ..." instead, but we can't do the same in
+   tcbQueueAppend_if_live_then_nonz_cap', and it's nicer if the two lemmas are symmetric *)
+lemma tcbQueuePrepend_if_live_then_nonz_cap':
+  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s \<and> ex_nonz_cap_to' tcbPtr s
+        \<and> (\<not> tcbQueueEmpty q \<longrightarrow> ex_nonz_cap_to' (the (tcbQueueHead q)) s)\<rbrace>
+   tcbQueuePrepend q tcbPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  unfolding tcbQueuePrepend_def
+  by (wpsimp wp: tcbSchedPrev_update_iflive' tcbSchedNext_update_iflive'
+                 hoare_vcg_if_lift2 hoare_vcg_imp_lift')
+
+lemma tcbQueueAppend_if_live_then_nonz_cap':
+  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s \<and> ex_nonz_cap_to' tcbPtr s
+        \<and> (\<not> tcbQueueEmpty q \<longrightarrow> ex_nonz_cap_to' (the (tcbQueueEnd q)) s)\<rbrace>
+   tcbQueueAppend q tcbPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  unfolding tcbQueueAppend_def
+  by (wpsimp wp: tcbSchedPrev_update_iflive' tcbSchedNext_update_iflive')
+
+lemma tcbQueueInsert_if_live_then_nonz_cap':
+  "\<lbrace>if_live_then_nonz_cap' and ex_nonz_cap_to' tcbPtr and valid_objs' and sym_heap_sched_pointers\<rbrace>
+   tcbQueueInsert tcbPtr afterPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  unfolding tcbQueueInsert_def
+  apply (wpsimp wp: tcbSchedPrev_update_iflive' tcbSchedNext_update_iflive' getTCB_wp)
+  apply (intro conjI)
+   apply (erule if_live_then_nonz_capE')
+   apply (clarsimp simp: ko_wp_at'_def obj_at'_def live'_def)
+  apply (erule if_live_then_nonz_capE')
+  apply (frule_tac p'=afterPtr in sym_heapD2)
+   apply (fastforce simp: opt_map_def obj_at'_def)
+  apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+  apply (clarsimp simp: valid_tcb'_def ko_wp_at'_def obj_at'_def opt_map_def live'_def)
   done
 
+lemma tcbSchedEnqueue_iflive'[wp]:
+  "\<lbrace>if_live_then_nonz_cap' and pspace_aligned' and pspace_distinct'\<rbrace>
+   tcbSchedEnqueue tcbPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  unfolding tcbSchedEnqueue_def
+  apply (wpsimp wp: tcbQueuePrepend_if_live_then_nonz_cap' threadGet_wp)
+  apply normalise_obj_at'
+  apply (rename_tac tcb)
+  apply (frule_tac p=tcbPtr in if_live_then_nonz_capE')
+   apply (fastforce simp: ko_wp_at'_def obj_at'_def live'_def)
+  apply clarsimp
+  apply (erule if_live_then_nonz_capE')
+  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 (fastforce dest!: obj_at'_tcbQueueHead_ksReadyQueues
+                    simp: ko_wp_at'_def inQ_def opt_pred_def opt_map_def obj_at'_def live'_def
+                   split: option.splits)
+  done
+
+crunches rescheduleRequired
+  for iflive'[wp]: if_live_then_nonz_cap'
+
 lemma sts_iflive'[wp]:
   "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s
-      \<and> (st \<noteq> Inactive \<and> \<not> idle' st \<longrightarrow> ex_nonz_cap_to' t s)\<rbrace>
+        \<and> (st \<noteq> Inactive \<and> \<not> idle' st \<longrightarrow> ex_nonz_cap_to' t s)
+        \<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 setQueue_def)
-  apply (rule hoare_pre)
-   apply (wp | simp)+
-      apply (rule_tac Q="\<lambda>rv. if_live_then_nonz_cap'" in hoare_post_imp)
-       apply clarsimp
-      apply (wp threadSet_iflive' | simp)+
-   apply auto
- done
+  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
+  done
 
 lemma sbn_iflive'[wp]:
   "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s
@@ -4077,6 +5037,18 @@ lemma setBoundNotification_vms'[wp]:
   apply (intro hoare_vcg_all_lift hoare_vcg_disj_lift; wp)
   done
 
+lemma threadSet_ct_not_inQ:
+  "(\<And>tcb. tcbQueued tcb = tcbQueued (F tcb))
+   \<Longrightarrow> threadSet F tcbPtr \<lbrace>\<lambda>s. P (ct_not_inQ s)\<rbrace>"
+  unfolding threadSet_def
+  apply (wpsimp wp: getTCB_wp simp: setObject_def updateObject_default_def)
+  apply (erule rsubst[where P=P])
+  by (fastforce simp: ct_not_inQ_def obj_at'_def objBits_simps ps_clear_def split: if_splits)
+
+crunches tcbQueuePrepend, tcbQueueAppend, tcbQueueInsert, tcbQueueRemove, addToBitmap
+  for ct_not_inQ[wp]: ct_not_inQ
+  (wp: threadSet_ct_not_inQ crunch_wps)
+
 lemma tcbSchedEnqueue_ct_not_inQ:
   "\<lbrace>ct_not_inQ and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t)\<rbrace>
     tcbSchedEnqueue t \<lbrace>\<lambda>_. ct_not_inQ\<rbrace>"
@@ -4100,12 +5072,7 @@ lemma tcbSchedEnqueue_ct_not_inQ:
       done
     show ?thesis
       apply (simp add: tcbSchedEnqueue_def unless_def null_def)
-      apply (wp ts sq hoare_convert_imp [OF addToBitmap_nosch addToBitmap_ct'])+
-           apply (rule_tac Q="\<lambda>_. ?PRE" in hoare_post_imp, clarsimp)
-           apply (wp sq hoare_convert_imp [OF setQueue_nosch setQueue_ct])+
-       apply (rule_tac Q="\<lambda>_. ?PRE" in hoare_post_imp, clarsimp)
-       apply wp
-      apply assumption
+      apply (wpsimp wp: ts sq hoare_vcg_imp_lift' getTCB_wp simp: threadGet_def)+
       done
   qed
 
@@ -4132,12 +5099,7 @@ lemma tcbSchedAppend_ct_not_inQ:
       done
     show ?thesis
       apply (simp add: tcbSchedAppend_def unless_def null_def)
-      apply (wp ts sq hoare_convert_imp [OF addToBitmap_nosch addToBitmap_ct'])+
-           apply (rule_tac Q="\<lambda>_. ?PRE" in hoare_post_imp, clarsimp)
-           apply (wp sq hoare_convert_imp [OF setQueue_nosch setQueue_ct])+
-       apply (rule_tac Q="\<lambda>_. ?PRE" in hoare_post_imp, clarsimp)
-       apply wp
-      apply assumption
+      apply (wpsimp wp: ts sq hoare_vcg_imp_lift' getTCB_wp simp: threadGet_def)+
       done
   qed
 
@@ -4166,12 +5128,10 @@ lemma rescheduleRequired_sa_cnt[wp]:
 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>"
-  (is "\<lbrace>?PRE\<rbrace> _ \<lbrace>_\<rbrace>")
   apply (simp add: possibleSwitchTo_def curDomain_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)
+         | (rule hoare_post_imp[OF _ rescheduleRequired_sa_cnt], fastforce))+
   done
 
 lemma threadSet_tcbState_update_ct_not_inQ[wp]:
@@ -4251,29 +5211,6 @@ lemma tcbSchedDequeue_ct_not_inQ[wp]:
       done
   qed
 
-lemma tcbSchedEnqueue_not_st:
-  "(\<And>tcb st qd. P (tcb\<lparr>tcbState := st, tcbQueued := qd\<rparr>) \<longleftrightarrow> P tcb)
-     \<Longrightarrow> \<lbrace>obj_at' P t'\<rbrace> tcbSchedEnqueue t \<lbrace>\<lambda>_. obj_at' P t'\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply (wp threadGet_wp | simp)+
-  apply (clarsimp simp: obj_at'_def)
-  apply (case_tac obja)
-  apply fastforce
-  done
-
-lemma setThreadState_not_st:
-  "(\<And>tcb st qd. P (tcb\<lparr>tcbState := st, tcbQueued := qd\<rparr>) \<longleftrightarrow> P tcb)
-     \<Longrightarrow> \<lbrace>obj_at' P t'\<rbrace> setThreadState st t \<lbrace>\<lambda>_. obj_at' P t'\<rbrace>"
-  apply (simp add: setThreadState_def rescheduleRequired_def)
-  apply (wp hoare_vcg_conj_lift tcbSchedEnqueue_not_st
-          | wpc
-          | rule hoare_drop_imps
-          | simp)+
-  apply (clarsimp simp: obj_at'_def)
-  apply (case_tac obj)
-  apply fastforce
-  done
-
 crunch ct_idle_or_in_cur_domain'[wp]: setQueue ct_idle_or_in_cur_domain'
   (simp: ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def)
 
@@ -4302,17 +5239,8 @@ lemma removeFromBitmap_ct_idle_or_in_cur_domain'[wp]:
            | clarsimp simp: updateObject_default_def in_monad setNotification_def)+
   done
 
-lemma tcbSchedEnqueue_ksCurDomain[wp]:
-  "\<lbrace> \<lambda>s. P (ksCurDomain s)\<rbrace> tcbSchedEnqueue tptr \<lbrace>\<lambda>_ s. P (ksCurDomain s)\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply wpsimp
-  done
-
-lemma tcbSchedEnqueue_ksDomSchedule[wp]:
-  "\<lbrace> \<lambda>s. P (ksDomSchedule s)\<rbrace> tcbSchedEnqueue tptr \<lbrace>\<lambda>_ s. P (ksDomSchedule s)\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply wpsimp
-  done
+crunches tcbQueuePrepend
+  for ct_idle_or_in_cur_domain'[wp]: ct_idle_or_in_cur_domain'
 
 lemma tcbSchedEnqueue_ct_idle_or_in_cur_domain'[wp]:
   "\<lbrace>ct_idle_or_in_cur_domain'\<rbrace> tcbSchedEnqueue tptr \<lbrace>\<lambda>_. ct_idle_or_in_cur_domain'\<rbrace>"
@@ -4390,12 +5318,375 @@ lemma sts_utr[wp]:
   apply (wp untyped_ranges_zero_lift)
   done
 
+lemma removeFromBitmap_bitmapQ:
+  "\<lbrace>\<top>\<rbrace> removeFromBitmap d p \<lbrace>\<lambda>_ s. \<not> bitmapQ d p s \<rbrace>"
+  unfolding bitmapQ_defs bitmap_fun_defs
+  by (wpsimp simp: bitmap_fun_defs)
+
+lemma removeFromBitmap_valid_bitmapQ[wp]:
+  "\<lbrace>valid_bitmapQ_except d p and bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans
+    and (\<lambda>s. tcbQueueEmpty (ksReadyQueues s (d,p)))\<rbrace>
+   removeFromBitmap d p
+   \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
+  (is "\<lbrace>?pre\<rbrace> _ \<lbrace>_\<rbrace>")
+  apply (rule_tac Q="\<lambda>_ s. ?pre s \<and> \<not> bitmapQ d p s" in hoare_strengthen_post)
+   apply (wpsimp wp: removeFromBitmap_valid_bitmapQ_except removeFromBitmap_bitmapQ)
+  apply (fastforce elim: valid_bitmap_valid_bitmapQ_exceptE)
+  done
+
+crunches tcbSchedDequeue
+  for bitmapQ_no_L1_orphans[wp]: bitmapQ_no_L1_orphans
+  and bitmapQ_no_L2_orphans[wp]: bitmapQ_no_L2_orphans
+  (wp: crunch_wps simp: crunch_simps)
+
+lemma setQueue_nonempty_valid_bitmapQ':
+  "\<lbrace>\<lambda>s. valid_bitmapQ s \<and> \<not> tcbQueueEmpty (ksReadyQueues s (d, p))\<rbrace>
+   setQueue d p queue
+   \<lbrace>\<lambda>_ s. \<not> tcbQueueEmpty queue \<longrightarrow> valid_bitmapQ s\<rbrace>"
+  apply (wpsimp simp: setQueue_def)
+  apply (fastforce simp: valid_bitmapQ_def bitmapQ_def)
+  done
+
+lemma threadSet_valid_bitmapQ_except[wp]:
+  "threadSet f tcbPtr \<lbrace>valid_bitmapQ_except d p\<rbrace>"
+  unfolding threadSet_def
+  apply (wpsimp wp: getTCB_wp simp: setObject_def updateObject_default_def)
+  apply (clarsimp simp: valid_bitmapQ_except_def bitmapQ_def)
+  done
+
+lemma threadSet_bitmapQ:
+  "threadSet F t \<lbrace>bitmapQ domain priority\<rbrace>"
+  unfolding threadSet_def
+  apply (wpsimp wp: getTCB_wp simp: setObject_def updateObject_default_def)
+  by (clarsimp simp: bitmapQ_def)
+
+crunches tcbQueueRemove, tcbQueuePrepend, tcbQueueAppend
+  for valid_bitmapQ_except[wp]: "valid_bitmapQ_except d p"
+  and valid_bitmapQ[wp]: valid_bitmapQ
+  and bitmapQ[wp]: "bitmapQ tdom prio"
+  (wp: crunch_wps)
+
+lemma tcbQueued_imp_queue_nonempty:
+  "\<lbrakk>list_queue_relation ts (ksReadyQueues s (tcbDomain tcb, tcbPriority tcb)) nexts prevs;
+    \<forall>t. t \<in> set ts \<longleftrightarrow> (inQ (tcbDomain tcb) (tcbPriority tcb) |< tcbs_of' s) t;
+    ko_at' tcb tcbPtr s; tcbQueued tcb\<rbrakk>
+   \<Longrightarrow> \<not> tcbQueueEmpty (ksReadyQueues s (tcbDomain tcb, tcbPriority tcb))"
+  apply (clarsimp simp: list_queue_relation_def tcbQueueEmpty_def)
+  apply (drule_tac x=tcbPtr in spec)
+  apply (fastforce dest: heap_path_head simp: inQ_def opt_map_def opt_pred_def obj_at'_def)
+  done
+
+lemma tcbSchedDequeue_valid_bitmapQ[wp]:
+  "\<lbrace>valid_bitmaps\<rbrace> tcbSchedDequeue tcbPtr \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
+  unfolding tcbSchedDequeue_def tcbQueueRemove_def
+  apply (wpsimp wp: setQueue_nonempty_valid_bitmapQ' hoare_vcg_conj_lift
+                    hoare_vcg_if_lift2 hoare_vcg_const_imp_lift threadGet_wp
+         | wp (once) hoare_drop_imps)+
+  by (fastforce dest!: tcbQueued_imp_queue_nonempty
+                 simp: ready_queue_relation_def ksReadyQueues_asrt_def obj_at'_def)
+
+lemma tcbSchedDequeue_valid_bitmaps[wp]:
+  "tcbSchedDequeue tcbPtr \<lbrace>valid_bitmaps\<rbrace>"
+  by (wpsimp simp: valid_bitmaps_def)
+
+lemma setQueue_valid_bitmapQ': (* enqueue only *)
+  "\<lbrace>valid_bitmapQ_except d p and bitmapQ d p and K (\<not> tcbQueueEmpty q)\<rbrace>
+   setQueue d p q
+   \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
+  unfolding setQueue_def bitmapQ_defs
+  by (wpsimp simp: bitmapQ_def)
+
+lemma tcbSchedEnqueue_valid_bitmapQ[wp]:
+  "\<lbrace>valid_bitmaps\<rbrace> tcbSchedEnqueue tcbPtr \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
+  supply if_split[split del]
+  unfolding tcbSchedEnqueue_def
+  apply (wpsimp simp: tcbQueuePrepend_def
+                  wp: setQueue_valid_bitmapQ' addToBitmap_valid_bitmapQ_except addToBitmap_bitmapQ
+                      threadGet_wp)
+  apply (fastforce simp: valid_bitmaps_def valid_bitmapQ_def tcbQueueEmpty_def split: if_splits)
+  done
+
+crunches tcbSchedEnqueue, tcbSchedAppend
+  for bitmapQ_no_L1_orphans[wp]: bitmapQ_no_L1_orphans
+  and bitmapQ_no_L2_orphans[wp]: bitmapQ_no_L2_orphans
+
+lemma tcbSchedEnqueue_valid_bitmaps[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>valid_bitmaps\<rbrace>"
+  unfolding valid_bitmaps_def
+  apply wpsimp
+  apply (clarsimp simp: valid_bitmaps_def)
+  done
+
+crunches rescheduleRequired, threadSet, setThreadState
+  for valid_bitmaps[wp]: valid_bitmaps
+  (rule: valid_bitmaps_lift)
+
+lemma tcbSchedEnqueue_valid_sched_pointers[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>valid_sched_pointers\<rbrace>"
+  apply (clarsimp simp: tcbSchedEnqueue_def getQueue_def unless_def)
+  \<comment> \<open>we step forwards until we can step over the addToBitmap in order to avoid state blow-up\<close>
+  apply (intro hoare_seq_ext[OF _ stateAssert_sp] hoare_seq_ext[OF _ isRunnable_inv]
+               hoare_seq_ext[OF _ assert_sp] hoare_seq_ext[OF _ threadGet_sp]
+               hoare_seq_ext[OF _ gets_sp]
+         | rule hoare_when_cases, fastforce)+
+  apply (forward_inv_step wp: hoare_vcg_ex_lift)
+  supply if_split[split del]
+  apply (wpsimp wp: getTCB_wp
+              simp: threadSet_def setObject_def updateObject_default_def tcbQueuePrepend_def
+                    setQueue_def)
+  apply (clarsimp simp: valid_sched_pointers_def)
+  apply (intro conjI impI)
+   apply (fastforce simp: opt_pred_def opt_map_def split: if_splits)
+  apply normalise_obj_at'
+  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: valid_sched_pointers_def list_queue_relation_def)
+  apply (case_tac "ts = []", fastforce simp: tcbQueueEmpty_def)
+  by (intro conjI impI;
+      force dest!: hd_in_set heap_path_head
+             simp: inQ_def opt_pred_def opt_map_def obj_at'_def split: if_splits)
+
+lemma tcbSchedAppend_valid_sched_pointers[wp]:
+  "tcbSchedAppend tcbPtr \<lbrace>valid_sched_pointers\<rbrace>"
+  apply (clarsimp simp: tcbSchedAppend_def getQueue_def unless_def)
+  \<comment> \<open>we step forwards until we can step over the addToBitmap in order to avoid state blow-up\<close>
+  apply (intro hoare_seq_ext[OF _ stateAssert_sp] hoare_seq_ext[OF _ isRunnable_inv]
+               hoare_seq_ext[OF _ assert_sp] hoare_seq_ext[OF _ threadGet_sp]
+               hoare_seq_ext[OF _ gets_sp]
+         | rule hoare_when_cases, fastforce)+
+  apply (forward_inv_step wp: hoare_vcg_ex_lift)
+  supply if_split[split del]
+  apply (wpsimp wp: getTCB_wp
+              simp: threadSet_def setObject_def updateObject_default_def tcbQueueAppend_def
+                    setQueue_def)
+  apply (clarsimp simp: valid_sched_pointers_def)
+  apply (intro conjI impI)
+   apply (fastforce simp: opt_pred_def opt_map_def split: if_splits)
+  apply normalise_obj_at'
+  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)
+  by (intro conjI impI;
+      clarsimp dest: last_in_set
+               simp: valid_sched_pointers_def opt_map_def list_queue_relation_def tcbQueueEmpty_def
+                     queue_end_valid_def inQ_def opt_pred_def obj_at'_def
+              split: if_splits option.splits;
+      fastforce)
+
+lemma tcbSchedDequeue_valid_sched_pointers[wp]:
+  "\<lbrace>valid_sched_pointers and sym_heap_sched_pointers\<rbrace>
+   tcbSchedDequeue tcbPtr
+   \<lbrace>\<lambda>_. valid_sched_pointers\<rbrace>"
+  supply if_split[split del] fun_upd_apply[simp del]
+  apply (clarsimp simp: tcbSchedDequeue_def getQueue_def setQueue_def)
+  apply (wpsimp wp: threadSet_wp getTCB_wp threadGet_wp simp: tcbQueueRemove_def)
+  apply normalise_obj_at'
+  apply (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 split: if_splits)
+  apply (frule (1) list_queue_relation_neighbour_in_set[where p=tcbPtr])
+   apply (fastforce simp: inQ_def opt_pred_def opt_map_def obj_at'_def)
+  apply (clarsimp simp: list_queue_relation_def)
+  apply (intro conjI impI)
+     \<comment> \<open>the ready queue is the singleton consisting of tcbPtr\<close>
+     apply (clarsimp simp: valid_sched_pointers_def)
+     apply (case_tac "ptr = tcbPtr")
+      apply (force dest!: heap_ls_last_None
+                    simp: prev_queue_head_def queue_end_valid_def inQ_def opt_map_def obj_at'_def)
+     apply (simp add: fun_upd_def opt_pred_def)
+    \<comment> \<open>tcbPtr is the head of the ready queue\<close>
+    subgoal
+      by (auto dest!: heap_ls_last_None
+                simp: valid_sched_pointers_def fun_upd_apply prev_queue_head_def
+                      inQ_def opt_pred_def opt_map_def obj_at'_def
+               split: if_splits option.splits)
+   \<comment> \<open>tcbPtr is the end of the ready queue\<close>
+   subgoal
+     by (auto dest!: heap_ls_last_None
+               simp: valid_sched_pointers_def queue_end_valid_def inQ_def opt_pred_def
+                     opt_map_def fun_upd_apply obj_at'_def
+              split: if_splits option.splits)
+  \<comment> \<open>tcbPtr is in the middle of the ready queue\<close>
+  apply (intro conjI impI allI)
+  by (clarsimp simp: valid_sched_pointers_def inQ_def opt_pred_def opt_map_def fun_upd_apply obj_at'_def
+              split: if_splits option.splits;
+      auto)
+
+lemma tcbQueueRemove_sym_heap_sched_pointers:
+  "\<lbrace>\<lambda>s. sym_heap_sched_pointers s
+        \<and> (\<exists>ts. list_queue_relation ts q (tcbSchedNexts_of s) (tcbSchedPrevs_of s)
+                \<and> tcbPtr \<in> set ts)\<rbrace>
+   tcbQueueRemove q tcbPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  supply heap_path_append[simp del]
+  apply (clarsimp simp: tcbQueueRemove_def)
+  apply (wpsimp wp: threadSet_wp getTCB_wp)
+  apply (rename_tac tcb ts)
+
+  \<comment> \<open>tcbPtr is the head of q, which is not a singleton\<close>
+  apply (rule conjI)
+   apply clarsimp
+   apply (clarsimp simp: list_queue_relation_def Let_def)
+   apply (prop_tac "tcbSchedNext tcb \<noteq> Some tcbPtr")
+    apply (fastforce dest: heap_ls_no_loops[where p=tcbPtr] simp: opt_map_def obj_at'_def)
+   apply (fastforce intro: sym_heap_remove_only'
+                     simp: prev_queue_head_def opt_map_red opt_map_upd_triv obj_at'_def)
+
+  \<comment> \<open>tcbPtr is the end of q, which is not a singleton\<close>
+  apply (intro impI)
+  apply (rule conjI)
+   apply clarsimp
+   apply (prop_tac "tcbSchedPrev tcb \<noteq> Some tcbPtr")
+    apply (fastforce dest!: heap_ls_prev_no_loops[where p=tcbPtr]
+                      simp: list_queue_relation_def opt_map_def obj_at'_def)
+   apply (subst fun_upd_swap, fastforce)
+   apply (fastforce intro: sym_heap_remove_only simp: opt_map_red opt_map_upd_triv obj_at'_def)
+
+  \<comment> \<open>tcbPtr is in the middle of q\<close>
+  apply (intro conjI impI allI)
+  apply (frule (2) list_queue_relation_neighbour_in_set[where p=tcbPtr])
+  apply (frule split_list)
+  apply clarsimp
+  apply (rename_tac xs ys)
+  apply (prop_tac "xs \<noteq> [] \<and> ys \<noteq> []")
+   apply (fastforce simp: list_queue_relation_def queue_end_valid_def)
+  apply (clarsimp simp: list_queue_relation_def)
+  apply (frule (3) ptr_in_middle_prev_next)
+  apply (frule heap_ls_distinct)
+  apply (rename_tac afterPtr beforePtr xs ys)
+  apply (frule_tac before=beforePtr and middle=tcbPtr and after=afterPtr
+                in sym_heap_remove_middle_from_chain)
+      apply (fastforce dest: last_in_set simp: opt_map_def obj_at'_def)
+     apply (fastforce dest: hd_in_set simp: opt_map_def obj_at'_def)
+    apply (rule_tac hp="tcbSchedNexts_of s" in sym_heapD2)
+     apply fastforce
+    apply (fastforce simp: opt_map_def obj_at'_def)
+   apply (fastforce simp: opt_map_def obj_at'_def)
+  apply (fastforce simp: fun_upd_swap opt_map_red opt_map_upd_triv obj_at'_def split: if_splits)
+  done
+
+lemma tcbQueuePrepend_sym_heap_sched_pointers:
+  "\<lbrace>\<lambda>s. sym_heap_sched_pointers s
+        \<and> (\<exists>ts. list_queue_relation ts q (tcbSchedNexts_of s) (tcbSchedPrevs_of s)
+                \<and> tcbPtr \<notin> set ts)
+        \<and> tcbSchedNexts_of s tcbPtr = None \<and> tcbSchedPrevs_of s tcbPtr = None\<rbrace>
+   tcbQueuePrepend q tcbPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  supply if_split[split del]
+  apply (clarsimp simp: tcbQueuePrepend_def)
+  apply (wpsimp wp: threadSet_wp)
+  apply (prop_tac "tcbPtr \<noteq> the (tcbQueueHead q)")
+   apply (case_tac "ts = []";
+          fastforce dest: heap_path_head simp: list_queue_relation_def tcbQueueEmpty_def)
+  apply (drule_tac a=tcbPtr and b="the (tcbQueueHead q)" in sym_heap_connect)
+    apply assumption
+   apply (clarsimp simp: list_queue_relation_def prev_queue_head_def tcbQueueEmpty_def)
+  apply (fastforce simp: fun_upd_swap opt_map_red opt_map_upd_triv obj_at'_def tcbQueueEmpty_def)
+  done
+
+lemma tcbQueueInsert_sym_heap_sched_pointers:
+  "\<lbrace>\<lambda>s. sym_heap_sched_pointers s
+        \<and> tcbSchedNexts_of s tcbPtr = None \<and> tcbSchedPrevs_of s tcbPtr = None\<rbrace>
+   tcbQueueInsert tcbPtr afterPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  apply (clarsimp simp: tcbQueueInsert_def)
+  \<comment> \<open>forwards step in order to name beforePtr below\<close>
+  apply (rule hoare_seq_ext[OF _ getObject_tcb_sp])
+  apply (rule hoare_seq_ext[OF _ assert_sp])
+  apply (rule hoare_ex_pre_conj[simplified conj_commute], rename_tac beforePtr)
+  apply (rule hoare_seq_ext[OF _ assert_sp])
+  apply (wpsimp wp: threadSet_wp)
+  apply normalise_obj_at'
+  apply (prop_tac "tcbPtr \<noteq> afterPtr")
+   apply (clarsimp simp: list_queue_relation_def opt_map_red obj_at'_def)
+  apply (prop_tac "tcbPtr \<noteq> beforePtr")
+   apply (fastforce dest: sym_heap_None simp: opt_map_def obj_at'_def split: option.splits)
+  apply (prop_tac "tcbSchedNexts_of s beforePtr = Some afterPtr")
+   apply (fastforce intro: sym_heapD2 simp: opt_map_def obj_at'_def)
+  apply (fastforce dest: sym_heap_insert_into_middle_of_chain
+                   simp: fun_upd_swap opt_map_red opt_map_upd_triv obj_at'_def)
+  done
+
+lemma tcbQueueAppend_sym_heap_sched_pointers:
+  "\<lbrace>\<lambda>s. sym_heap_sched_pointers s
+        \<and> (\<exists>ts. list_queue_relation ts q (tcbSchedNexts_of s) (tcbSchedPrevs_of s)
+                \<and> tcbPtr \<notin> set ts)
+        \<and> tcbSchedNexts_of s tcbPtr = None \<and> tcbSchedPrevs_of s tcbPtr = None\<rbrace>
+   tcbQueueAppend q tcbPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  supply if_split[split del]
+  apply (clarsimp simp: tcbQueueAppend_def)
+  apply (wpsimp wp: threadSet_wp)
+  apply (clarsimp simp: tcbQueueEmpty_def list_queue_relation_def queue_end_valid_def obj_at'_def
+                 split: if_splits)
+   apply fastforce
+  apply (drule_tac a="last ts" and b=tcbPtr in sym_heap_connect)
+    apply (fastforce dest: heap_ls_last_None)
+   apply assumption
+  apply (simp add: opt_map_red tcbQueueEmpty_def)
+  apply (subst fun_upd_swap, simp)
+  apply (fastforce simp: opt_map_red opt_map_upd_triv)
+  done
+
+lemma tcbQueued_update_sym_heap_sched_pointers[wp]:
+  "threadSet (tcbQueued_update f) tcbPtr \<lbrace>sym_heap_sched_pointers\<rbrace>"
+  by (rule sym_heap_sched_pointers_lift;
+      wpsimp wp: threadSet_tcbSchedPrevs_of threadSet_tcbSchedNexts_of)
+
+lemma tcbSchedEnqueue_sym_heap_sched_pointers[wp]:
+  "\<lbrace>sym_heap_sched_pointers and valid_sched_pointers\<rbrace>
+   tcbSchedEnqueue tcbPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  unfolding tcbSchedEnqueue_def
+  apply (wpsimp wp: tcbQueuePrepend_sym_heap_sched_pointers threadGet_wp
+              simp: addToBitmap_def 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 (fastforce dest!: spec[where x=tcbPtr] inQ_implies_tcbQueueds_of
+                    simp: valid_sched_pointers_def opt_pred_def opt_map_def obj_at'_def)
+  done
+
+lemma tcbSchedAppend_sym_heap_sched_pointers[wp]:
+  "\<lbrace>sym_heap_sched_pointers and valid_sched_pointers\<rbrace>
+   tcbSchedAppend tcbPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  unfolding tcbSchedAppend_def
+  apply (wpsimp wp: tcbQueueAppend_sym_heap_sched_pointers threadGet_wp
+              simp: addToBitmap_def 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 (fastforce dest!: spec[where x=tcbPtr] inQ_implies_tcbQueueds_of
+                    simp: valid_sched_pointers_def opt_pred_def opt_map_def obj_at'_def)
+  done
+
+lemma tcbSchedDequeue_sym_heap_sched_pointers[wp]:
+  "\<lbrace>sym_heap_sched_pointers and valid_sched_pointers\<rbrace>
+   tcbSchedDequeue tcbPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  unfolding tcbSchedDequeue_def
+  apply (wpsimp wp: tcbQueueRemove_sym_heap_sched_pointers hoare_vcg_if_lift2 threadGet_wp
+              simp: bitmap_fun_defs)
+  apply (fastforce simp: ready_queue_relation_def ksReadyQueues_asrt_def inQ_def opt_pred_def
+                         opt_map_def obj_at'_def)
+  done
+
+crunches setThreadState
+  for valid_sched_pointers[wp]: valid_sched_pointers
+  and sym_heap_sched_pointers[wp]: sym_heap_sched_pointers
+  (simp: crunch_simps wp: crunch_wps threadSet_valid_sched_pointers threadSet_sched_pointers)
+
 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. (\<exists>p. t \<in> set(ksReadyQueues s p)) \<longrightarrow> runnable' st)
       and (\<lambda>s. runnable' st \<and> obj_at' tcbQueued t s \<longrightarrow> st_tcb_at' runnable' t s)
       and sch_act_simple
       and invs'\<rbrace>
@@ -4404,21 +5695,21 @@ lemma sts_invs_minor':
   including no_pre
   apply (simp add: invs'_def valid_state'_def)
   apply (rule hoare_pre)
-   apply (wp sts_valid_queues valid_irq_node_lift irqs_masked_lift
-              setThreadState_ct_not_inQ
+   apply (wp valid_irq_node_lift irqs_masked_lift
+             setThreadState_ct_not_inQ
             | simp add: cteCaps_of_def o_def)+
   apply (clarsimp simp: sch_act_simple_def)
   apply (intro conjI)
-     apply clarsimp
-    defer
-    apply (clarsimp dest!: st_tcb_at_state_refs_ofD'
-                    elim!: rsubst[where P=sym_refs]
-                   intro!: ext)
-   apply (clarsimp elim!: st_tcb_ex_cap'')
+       apply clarsimp
+      defer
+      apply (clarsimp dest!: st_tcb_at_state_refs_ofD'
+                      elim!: rsubst[where P=sym_refs]
+                     intro!: ext)
+      apply (clarsimp elim!: st_tcb_ex_cap'')
+    apply fastforce
+   apply fastforce
   apply (frule tcb_in_valid_state', clarsimp+)
-  apply (cases st, simp_all add: valid_tcb_state'_def
-                  split: Structures_H.thread_state.split_asm)
-  done
+  by (cases st; simp add: valid_tcb_state'_def split: Structures_H.thread_state.split_asm)
 
 lemma sts_cap_to'[wp]:
   "\<lbrace>ex_nonz_cap_to' p\<rbrace> setThreadState st t \<lbrace>\<lambda>rv. ex_nonz_cap_to' p\<rbrace>"
@@ -4463,12 +5754,56 @@ lemma threadSet_ct_running':
   apply wp
   done
 
+lemma tcbQueuePrepend_tcbPriority_obj_at'[wp]:
+  "tcbQueuePrepend queue tptr \<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
+  unfolding tcbQueuePrepend_def
+  apply (wpsimp wp: threadSet_wp)
+  by (auto simp: obj_at'_def objBits_simps ps_clear_def split: if_splits)
+
+lemma tcbQueuePrepend_tcbDomain_obj_at'[wp]:
+  "tcbQueuePrepend queue tptr \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  unfolding tcbQueuePrepend_def
+  apply (wpsimp wp: threadSet_wp)
+  by (auto simp: obj_at'_def objBits_simps ps_clear_def split: if_splits)
+
+lemma tcbSchedDequeue_tcbPriority[wp]:
+  "tcbSchedDequeue t \<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
+  unfolding tcbSchedDequeue_def tcbQueueRemove_def
+  by (wpsimp wp: hoare_when_weak_wp hoare_drop_imps)
+
+lemma tcbSchedDequeue_tcbDomain[wp]:
+  "tcbSchedDequeue t \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  unfolding tcbSchedDequeue_def tcbQueueRemove_def
+  by (wpsimp wp: hoare_when_weak_wp hoare_drop_imps)
+
+lemma tcbSchedEnqueue_tcbPriority_obj_at'[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
+  unfolding tcbSchedEnqueue_def setQueue_def
+  by wpsimp
+
+lemma tcbSchedEnqueue_tcbDomain_obj_at'[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  unfolding tcbSchedEnqueue_def setQueue_def
+  by wpsimp
+
+crunches rescheduleRequired
+  for tcbPriority_obj_at'[wp]: "obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'"
+  and tcbDomain_obj_at'[wp]: "obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'"
+
+lemma setThreadState_tcbPriority_obj_at'[wp]:
+  "setThreadState ts tptr \<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
+  unfolding setThreadState_def
+  apply (wpsimp wp: threadSet_wp)
+  apply (fastforce simp: obj_at'_def objBits_simps ps_clear_def)
+  done
+
 lemma setThreadState_tcb_in_cur_domain'[wp]:
   "\<lbrace>tcb_in_cur_domain' t'\<rbrace> setThreadState 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 setThreadState_not_st | simp)+
+  apply (simp add: setThreadState_def)
+  apply (wpsimp wp: threadSet_ct_idle_or_in_cur_domain' hoare_drop_imps)+
   done
 
 lemma asUser_global_refs':   "\<lbrace>valid_global_refs'\<rbrace> asUser t f \<lbrace>\<lambda>rv. valid_global_refs'\<rbrace>"
@@ -4614,10 +5949,13 @@ 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)
-            (set_eobject ptr etcb) (setObject ptr tcb')"
+  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
@@ -4638,21 +5976,34 @@ lemma set_eobject_corres':
    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 cte_relation_def tcb_relation_def
+     apply (clarsimp simp: obj_at'_def other_obj_relation_def tcb_relation_cut_def
+                           cte_relation_def tcb_relation_def
                      split: if_split_asm)+
    apply (clarsimp simp: aobj_relation_cuts_def split: AARCH64_A.arch_kernel_obj.splits)
    apply (rename_tac arch_kernel_obj obj d p ts)
    apply (case_tac arch_kernel_obj; simp)
      apply (clarsimp simp: pte_relation_def is_tcb_def
                     split: if_split_asm)+
-  apply (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
+  apply (extract_conjunct \<open>match conclusion in "ekheap_relation _ _" \<Rightarrow> -\<close>)
+   apply (simp only: ekheap_relation_def dom_fun_upd2 simp_thms)
+   apply (frule bspec, erule domI)
+   apply (rule ballI, drule(1) bspec)
+   apply (drule domD)
+   apply (clarsimp simp: obj_at'_def)
+   apply (insert e)
+   apply (clarsimp simp: other_obj_relation_def etcb_relation_def is_other_obj_relation_type
                   split: Structures_A.kernel_object.splits kernel_object.splits arch_kernel_obj.splits)
+   apply (frule in_ready_q_tcbQueued_eq[where t=ptr])
+  apply (rename_tac s' conctcb' abstcb exttcb)
+  apply (clarsimp simp: ready_queues_relation_def Let_def)
+  apply (prop_tac "(tcbSchedNexts_of s')(ptr := tcbSchedNext tcb') = tcbSchedNexts_of s'")
+   apply (fastforce simp: opt_map_def obj_at'_def non_exst_same_def split: option.splits)
+  apply (prop_tac "(tcbSchedPrevs_of s')(ptr := tcbSchedPrev tcb') = tcbSchedPrevs_of s'")
+   apply (fastforce simp: opt_map_def obj_at'_def non_exst_same_def split: option.splits)
+  apply (clarsimp simp: ready_queue_relation_def opt_map_def opt_pred_def obj_at'_def inQ_def
+                        non_exst_same_def
+                 split: option.splits)
+  apply metis
   done
 
 lemma set_eobject_corres:
@@ -4660,9 +6011,13 @@ lemma set_eobject_corres:
   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)
-                  (set_eobject add etcbu) (setObject add tcbu')"
+  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)
@@ -4689,24 +6044,27 @@ lemma set_eobject_corres:
 
 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)
-                    (ethread_set f t) (threadSet f' t)"
+  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+
+     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 simp
+  apply (clarsimp simp: obj_at'_def)
   done
 
 lemmas ethread_set_corres =
diff --git a/proof/refine/AARCH64/Tcb_R.thy b/proof/refine/AARCH64/Tcb_R.thy
index f9f1c3c180..dff355d085 100644
--- a/proof/refine/AARCH64/Tcb_R.thy
+++ b/proof/refine/AARCH64/Tcb_R.thy
@@ -192,18 +192,13 @@ lemma setupReplyMaster_weak_sch_act_wf[wp]:
   apply assumption
   done
 
-crunches setupReplyMaster
-  for valid_queues[wp]: "Invariants_H.valid_queues"
-  and valid_queues'[wp]: "valid_queues'"
-  (wp: crunch_wps simp: crunch_simps)
-
 crunches 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) (invs' and tcb_at' t)
+  "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)
@@ -214,19 +209,20 @@ lemma restart_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_valid_queues sts_st_tcb'
-                    | clarsimp simp: valid_tcb_state'_def)+
-       apply (rule_tac Q="\<lambda>rv. valid_sched and cur_tcb and pspace_aligned and pspace_distinct"
-                       in hoare_strengthen_post)
-        apply wp
-       apply (simp add: valid_sched_def valid_sched_action_def)
-      apply (rule_tac Q="\<lambda>rv. invs' and tcb_at' t" in hoare_strengthen_post)
-       apply wp
-      apply (clarsimp simp: invs'_def valid_state'_def sch_act_wf_weak valid_pspace'_def)
-     apply wp+
+              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 simp add: invs'_def valid_state'_def sch_act_wf_weak)
+  apply clarsimp
   done
 
 lemma restart_invs':
@@ -313,6 +309,11 @@ lemma asUser_postModifyRegisters_corres:
     apply (rule corres_stateAssert_assume)
   by simp+
 
+crunches restart
+  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 tcb_at dest and ex_nonz_cap_to dest)
         (invs' and sch_act_simple and tcb_at' dest and ex_nonz_cap_to' dest)
@@ -341,10 +342,12 @@ lemma invokeTCB_WriteRegisters_corres:
                 apply simp
                apply (wp+)[2]
              apply ((wp hoare_weak_lift_imp restart_invs'
-                 | strengthen valid_sched_weak_strg einvs_valid_etcbs invs_valid_queues' invs_queues
-                              invs_weak_sch_act_wf
-                 | 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]
+                     | 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_post_imp)
             apply (fastforce simp: invs_def valid_sched_weak_strg valid_sched_def valid_state_def
                              dest!: idle_no_ex_cap)
@@ -376,6 +379,10 @@ lemma suspend_ResumeCurrentThread_imp_notct[wp]:
    \<lbrace>\<lambda>rv s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>"
   by (wpsimp simp: suspend_def)
 
+crunches restart, suspend
+  for cur_tcb'[wp]: cur_tcb'
+  (wp: crunch_wps threadSet_cur ignore: threadSet)
+
 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
@@ -403,7 +410,7 @@ proof -
         apply (rule corres_modify')
          apply simp
         apply simp
-       apply (simp add: invs_distinct invs_psp_aligned| wp)+
+       apply (simp add: invs_distinct invs_psp_aligned | wp)+
     done
   have R: "\<And>src src' des des' xs ys. \<lbrakk> src = src'; des = des'; xs = ys \<rbrakk> \<Longrightarrow>
            corres dc (tcb_at src and tcb_at des and invs)
@@ -452,11 +459,11 @@ proof -
                     apply simp
                    apply (solves \<open>wp hoare_weak_lift_imp\<close>)+
              apply (rule_tac Q="\<lambda>_. einvs and tcb_at dest" in hoare_post_imp)
-              apply (clarsimp simp: invs_def valid_state_def valid_pspace_def valid_sched_weak_strg valid_sched_def)
+              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_post_imp)
-              apply (clarsimp simp: invs'_def valid_state'_def invs_weak_sch_act_wf cur_tcb'_def)
-             apply ((wp mapM_x_wp' hoare_weak_lift_imp | simp+)+)[4]
+              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
@@ -504,38 +511,6 @@ lemma copyreg_invs':
    \<lbrace>\<lambda>rv. invs'\<rbrace>"
   by (rule hoare_strengthen_post, rule copyreg_invs'', simp)
 
-lemma threadSet_valid_queues_no_state:
-  "\<lbrace>Invariants_H.valid_queues and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))\<rbrace>
-     threadSet f t \<lbrace>\<lambda>_. Invariants_H.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 setObject_queues_unchanged_tcb
-             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
-                        objBits_simps addToQs_def
-             split del: if_split cong: if_cong)
-  apply (fastforce simp: inQ_def split: if_split_asm)
-  done
-
 lemma isRunnable_corres:
   "corres (\<lambda>ts runn. runnable ts = runn)
           (tcb_at t and pspace_aligned and pspace_distinct) \<top>
@@ -560,16 +535,6 @@ lemma tcbSchedDequeue_not_queued:
   apply (wp tg_sp' [where P=\<top>, simplified] | simp)+
   done
 
-lemma tcbSchedDequeue_not_in_queue:
-  "\<And>p. \<lbrace>Invariants_H.valid_queues and tcb_at' t and valid_objs'\<rbrace> tcbSchedDequeue t
-   \<lbrace>\<lambda>rv s. t \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (rule_tac Q="\<lambda>rv. Invariants_H.valid_queues and obj_at' (Not \<circ> tcbQueued) t"
-               in hoare_post_imp)
-   apply (fastforce simp: valid_queues_def valid_queues_no_bitmap_def obj_at'_def inQ_def )
-  apply (wp tcbSchedDequeue_not_queued tcbSchedDequeue_valid_queues |
-         simp add: valid_objs'_maxDomain valid_objs'_maxPriority)+
-  done
-
 lemma threadSet_ct_in_state':
   "(\<And>tcb. tcbState (f tcb) = tcbState tcb) \<Longrightarrow>
   \<lbrace>ct_in_state' test\<rbrace> threadSet f t \<lbrace>\<lambda>rv. ct_in_state' test\<rbrace>"
@@ -615,14 +580,19 @@ lemma tcbSchedDequeue_ct_in_state'[wp]:
 
 crunch cur[wp]: tcbSchedDequeue cur_tcb'
 
+crunches tcbSchedDequeue
+  for st_tcb_at'[wp]: "\<lambda>s. P (st_tcb_at' st tcbPtr s)"
+
 lemma sp_corres2:
-  "corres dc (valid_etcbs and weak_valid_sched_action and cur_tcb and pspace_aligned and pspace_distinct)
-             (Invariants_H.valid_queues and valid_queues' and tcb_at' t and
-             (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and valid_objs' and (\<lambda>_. x \<le> maxPriority))
-             (set_priority t x) (setPriority t x)"
+  "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])
+    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])
@@ -634,25 +604,28 @@ lemma sp_corres2:
            apply ((clarsimp
                    | wp hoare_weak_lift_imp hoare_vcg_if_lift hoare_wp_combs gts_wp
                         isRunnable_wp)+)[4]
-       apply (wp hoare_vcg_imp_lift' hoare_vcg_if_lift hoare_vcg_all_lift)
-      apply clarsimp
-      apply ((wp hoare_drop_imps hoare_vcg_if_lift hoare_vcg_all_lift
-                 isRunnable_wp threadSet_pred_tcb_no_state threadSet_valid_queues_no_state
-                 threadSet_valid_queues'_no_state threadSet_cur threadSet_valid_objs_tcbPriority_update
-                 threadSet_weak_sch_act_wf threadSet_ct_in_state'[simplified ct_in_state'_def]
-              | simp add: etcb_relation_def)+)[1]
-     apply ((wp hoare_vcg_imp_lift' hoare_vcg_if_lift hoare_vcg_all_lift hoare_vcg_disj_lift
-                tcbSchedDequeue_not_in_queue tcbSchedDequeue_valid_queues
-                tcbSchedDequeue_ct_in_state'[simplified ct_in_state'_def]
-             | simp add: etcb_relation_def)+)[2]
+       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 (force simp: state_relation_def elim: valid_objs'_maxDomain valid_objs'_maxPriority)
+  apply clarsimp
   done
 
 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)"
+  "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)
@@ -678,6 +651,9 @@ 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>
@@ -685,10 +661,8 @@ lemma out_corresT:
                \<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
-  apply (clarsimp simp add: threadset_corresT [OF _ x y e])
+  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]
@@ -697,32 +671,41 @@ lemma tcbSchedDequeue_sch_act_simple[wp]:
   "tcbSchedDequeue t \<lbrace>sch_act_simple\<rbrace>"
   by (wpsimp simp: sch_act_simple_def)
 
+lemma tcbSchedNext_update_tcb_cte_cases:
+  "(a, b) \<in> ran tcb_cte_cases \<Longrightarrow> a (tcbPriority_update f tcb) = a tcb"
+  unfolding tcb_cte_cases_def
+  by (case_tac tcb; fastforce simp: objBits_simps')
+
+lemma threadSet_priority_invs':
+  "\<lbrace>invs' and tcb_at' t and K (p \<le> maxPriority)\<rbrace>
+   threadSet (tcbPriority_update (\<lambda>_. p)) t
+   \<lbrace>\<lambda>_. invs'\<rbrace>"
+  apply (rule hoare_gen_asm)
+  apply (simp add: invs'_def valid_state'_def split del: if_split)
+  apply (wp threadSet_valid_pspace'
+            threadSet_sch_actT_P[where P=False, simplified]
+            threadSet_state_refs_of'T[where f'=id]
+            threadSet_state_hyp_refs_of'
+            threadSet_iflive'T
+            threadSet_ifunsafe'T
+            threadSet_idle'T
+            valid_irq_node_lift
+            valid_irq_handlers_lift''
+            threadSet_ctes_ofT
+            threadSet_not_inQ
+            threadSet_ct_idle_or_in_cur_domain'
+            threadSet_cur
+            untyped_ranges_zero_lift
+            sym_heap_sched_pointers_lift threadSet_valid_sched_pointers
+            threadSet_tcbSchedPrevs_of threadSet_tcbSchedNexts_of
+         | clarsimp simp: cteCaps_of_def tcbSchedNext_update_tcb_cte_cases | rule refl)+
+  apply (clarsimp simp: o_def)
+  by (auto simp: obj_at'_def)
+
 lemma setP_invs':
   "\<lbrace>invs' and tcb_at' t and K (p \<le> maxPriority)\<rbrace> setPriority t p \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (rule hoare_gen_asm)
-  apply (simp add: setPriority_def)
-  apply (wp rescheduleRequired_all_invs_but_ct_not_inQ)
-    apply simp
-    apply (wp hoare_vcg_conj_lift hoare_vcg_imp_lift')
-      unfolding st_tcb_at'_def
-      apply (strengthen not_obj_at'_strengthen, wp)
-     apply (wp hoare_vcg_imp_lift')
-      apply (rule_tac Q="\<lambda>rv s. invs' s" in hoare_post_imp)
-       apply (clarsimp simp: invs_sch_act_wf' invs'_def invs_queues)
-       apply (clarsimp simp: valid_state'_def)
-      apply (wp hoare_drop_imps threadSet_invs_trivial,
-             simp_all add: inQ_def cong: conj_cong)[1]
-     apply (wp hoare_drop_imps threadSet_invs_trivial,
-            simp_all add: inQ_def cong: conj_cong)[1]
-    apply (wp hoare_drop_imps threadSet_invs_trivial,
-           simp_all add: inQ_def cong: conj_cong)[1]
-   apply (rule_tac Q="\<lambda>_. invs' and obj_at' (Not \<circ> tcbQueued) t
-                                  and (\<lambda>s. \<forall>d p. t \<notin> set (ksReadyQueues s (d,p)))"
-              in hoare_post_imp)
-    apply (clarsimp simp: obj_at'_def inQ_def)
-   apply (wp tcbSchedDequeue_not_queued)+
-  apply clarsimp
-  done
+  unfolding setPriority_def
+  by (wpsimp wp: rescheduleRequired_invs' threadSet_priority_invs')
 
 crunches setPriority, setMCPriority
   for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
@@ -989,13 +972,6 @@ lemma setMCPriority_valid_objs'[wp]:
 crunch sch_act_simple[wp]: setMCPriority sch_act_simple
   (wp: ssa_sch_act_simple crunch_wps rule: sch_act_simple_lift simp: crunch_simps)
 
-(* For some reason, when this was embedded in a larger expression clarsimp wouldn't remove it.
-   Adding it as a simp rule does *)
-lemma inQ_tc_corres_helper:
-  "(\<forall>d p. (\<exists>tcb. tcbQueued tcb \<and> tcbPriority tcb = p \<and> tcbDomain tcb = d \<and>
-          (tcbQueued tcb \<longrightarrow> tcbDomain tcb \<noteq> d)) \<longrightarrow> a \<notin> set (ksReadyQueues s (d, p)))"
-  by clarsimp
-
 abbreviation "valid_option_prio \<equiv> case_option True (\<lambda>(p, auth). p \<le> maxPriority)"
 
 definition valid_tcb_invocation :: "tcbinvocation \<Rightarrow> bool" where
@@ -1017,35 +993,29 @@ lemma thread_set_ipc_weak_valid_sched_action:
               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_helper2:
-  "is_aligned a msg_align_bits \<Longrightarrow>
-   \<lbrace>invs' and tcb_at' t\<rbrace>
-   threadSet (tcbIPCBuffer_update (\<lambda>_. a)) t
-   \<lbrace>\<lambda>x s. Invariants_H.valid_queues s \<and> valid_queues' s\<rbrace>"
-  by (wp threadSet_invs_trivial
-      | strengthen  invs_valid_queues' invs_queues invs_weak_sch_act_wf
-      | clarsimp simp: inQ_def )+
-
 lemma threadcontrol_corres_helper3:
-  "\<lbrace> einvs and simple_sched_action\<rbrace>
+  "\<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>x. weak_valid_sched_action and valid_etcbs \<rbrace>"
-  apply (rule hoare_pre)
-   apply (wp check_cap_inv | simp add:)+
-  by (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)
+   \<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 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>x. Invariants_H.valid_queues and valid_queues'\<rbrace>"
-  apply (wp
-       | strengthen  invs_valid_queues' invs_queues invs_weak_sch_act_wf
-       | clarsimp simp: )+
+         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>_ 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)
@@ -1065,75 +1035,45 @@ lemma is_valid_vtable_root_simp:
            split: cap.splits arch_cap.splits option.splits pt_type.splits)
 
 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 \<and> tcbDomain (F tcb) = tcbDomain tcb"
-  assumes a: "\<forall>tcb. tcbBoundNotification (F tcb) = tcbBoundNotification 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 r: "\<forall>tcb. atcbVCPUPtr (tcbArch (F tcb)) = atcbVCPUPtr (tcbArch tcb)"
+  assumes
+    "\<forall>tcb. \<forall>(getF,setF) \<in> ran tcb_cte_cases. getF (F tcb) = getF tcb"
+    "\<forall>tcb. tcbState (F tcb) = tcbState tcb \<and> tcbDomain (F tcb) = tcbDomain 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 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"
+    "\<forall>tcb. atcbVCPUPtr (tcbArch (F tcb)) = atcbVCPUPtr (tcbArch tcb)"
   shows
-  "\<lbrace>\<lambda>s. invs' s
-        \<and> tcb_at' t s \<and> (\<forall>tcb. is_aligned (tcbIPCBuffer (F tcb)) msg_align_bits)
-        \<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. \<not> tcbQueued tcb \<and> tcbQueued (F tcb)) \<longrightarrow> ex_nonz_cap_to' t s \<and> t \<noteq> ksCurThread s)
-        \<and> (\<forall>tcb. tcbQueued (F tcb) \<and> ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> tcbQueued tcb \<or> t \<noteq> ksCurThread s)\<rbrace>
-        threadSet F t
-   \<lbrace>\<lambda>rv. invs'\<rbrace>"
-proof -
-  from z have domains: "\<And>tcb. tcbDomain (F tcb) = tcbDomain tcb" by blast
-  note threadSet_sch_actT_P[where P=False, simplified]
-  have y: "\<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 valid_state'_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_state_refs_of'T[where f'=id]
-              threadSet_state_hyp_refs_of'
-              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_cur
-              untyped_ranges_zero_lift
-            |clarsimp simp: y z a r domains cteCaps_of_def valid_arch_tcb'_def|rule refl)+
-    apply (clarsimp simp: obj_at'_def pred_tcb_at'_def)
-    apply (clarsimp simp: cur_tcb'_def valid_irq_node'_def valid_queues'_def o_def)
-    by (fastforce simp: domains ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def z a)
-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 objBits_simps addToQs_def
-             split del: if_split cong: if_cong)
-  apply (fastforce simp: 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_state_hyp_refs_of'
+             threadSet_idle'T
+             threadSet_not_inQ
+             threadSet_ct_idle_or_in_cur_domain'
+             threadSet_cur
+          | clarsimp simp: assms cteCaps_of_def valid_arch_tcb'_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>"
@@ -1144,10 +1084,6 @@ 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)
@@ -1187,6 +1123,12 @@ crunches option_update_thread
   for aligned[wp]: "pspace_aligned"
   and distinct[wp]: "pspace_distinct"
 
+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'" and y: "newroot_rel f f'"
       and z: "(case g of None \<Rightarrow> g' = None
@@ -1378,10 +1320,20 @@ proof -
              apply (rule corres_split[OF getCurThread_corres], clarsimp)
                apply (rule corres_when[OF refl rescheduleRequired_corres])
               apply (wpsimp wp: gct_wp)+
-            apply (wp thread_set_ipc_weak_valid_sched_action|wp (once) hoare_drop_imp)+
-           apply simp
-           apply (wp threadcontrol_corres_helper2 | wpc | simp)+
-          apply (wp|strengthen einvs_valid_etcbs)+
+            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)+
+          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
@@ -1410,7 +1362,7 @@ proof -
                    cap_delete_valid_cap cteDelete_deletes
                    cteDelete_invs'
                    | strengthen use_no_cap_to_obj_asid_strg
-                   | clarsimp simp: inQ_def inQ_tc_corres_helper)+
+                   | 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)
@@ -1493,36 +1445,16 @@ proof -
                                  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
-                                 cap_delete_deletes
+                                 check_cap_inv[where P=simple_sched_action]
+                                 cap_delete_deletes hoare_drop_imps
                                  cap_delete_valid_cap
-                           simp: ran_tcb_cap_cases)
+                           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_drop_imps)
-              apply ((wpsimp wp: hoare_vcg_const_imp_lift hoare_vcg_imp_lift' hoare_vcg_all_lift
-                                 threadSet_cte_wp_at' threadSet_invs_trivialT2 cteDelete_invs'
-                           simp: tcb_cte_cases_def cteSizeBits_def), (fastforce+)[6])
-                  apply wpsimp
-                  apply (wpsimp wp: hoare_vcg_const_imp_lift hoare_drop_imps hoare_vcg_all_lift
-                                    threadSet_invs_trivialT2 threadSet_cte_wp_at'
-                              simp: tcb_cte_cases_def cteSizeBits_def, (fastforce+)[6])
-                  apply wpsimp
-                  apply (wpsimp wp: hoare_vcg_const_imp_lift hoare_drop_imps hoare_vcg_all_lift
-                                    rescheduleRequired_invs' threadSet_cte_wp_at'
-                              simp: tcb_cte_cases_def)
-                 apply (wpsimp wp: hoare_vcg_const_imp_lift hoare_drop_imps hoare_vcg_all_lift
-                                   rescheduleRequired_invs' threadSet_invs_trivialT2 threadSet_cte_wp_at'
-                             simp: tcb_cte_cases_def cteSizeBits_def, (fastforce+)[6])
-                 apply wpsimp
-                 apply (wpsimp wp: hoare_vcg_const_imp_lift hoare_drop_imps hoare_vcg_all_lift
-                                   rescheduleRequired_invs' threadSet_invs_trivialT2 threadSet_cte_wp_at'
-                             simp: tcb_cte_cases_def cteSizeBits_def, (fastforce+)[6])
-                 apply wpsimp
-                 apply (wpsimp wp: hoare_vcg_const_imp_lift hoare_drop_imps hoare_vcg_all_lift
-                                   rescheduleRequired_invs' threadSet_cap_to' threadSet_invs_trivialT2
-                                   threadSet_cte_wp_at' hoare_drop_imps
-                               simp: tcb_cte_cases_def cteSizeBits_def)
-                apply (clarsimp)
+               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_lift_R hoare_vcg_all_lift
                                    hoare_vcg_const_imp_lift_R hoare_vcg_const_imp_lift
                                    threadSet_valid_objs' thread_set_not_state_valid_sched
@@ -1535,9 +1467,9 @@ proof -
                         | strengthen tcb_cap_always_valid_strg
                                    tcb_at_invs
                                    use_no_cap_to_obj_asid_strg
-                        | (erule exE, clarsimp simp: word_bits_def))+)
+                        | (erule exE, clarsimp simp: word_bits_def) | wp (once) hoare_drop_imps)+)
                 apply (strengthen valid_tcb_ipc_buffer_update)
-                apply (strengthen invs_valid_objs')
+                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
@@ -1661,7 +1593,7 @@ lemma setSchedulerAction_invs'[wp]:
   apply (simp add: setSchedulerAction_def)
   apply wp
   apply (clarsimp simp add: invs'_def valid_state'_def valid_irq_node'_def
-                valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs cur_tcb'_def
+                valid_queues_def bitmapQ_defs cur_tcb'_def
                 ct_not_inQ_def)
   apply (simp add: ct_idle_or_in_cur_domain'_def)
   done
@@ -1791,8 +1723,8 @@ lemma invokeTCB_corres:
            apply (rule TcbAcc_R.rescheduleRequired_corres)
           apply (rule corres_trivial, simp)
          apply (wpsimp wp: hoare_drop_imp)+
-   apply (clarsimp simp: valid_sched_weak_strg einvs_valid_etcbs invs_distinct)
-  apply (clarsimp simp: invs_valid_queues' invs_queues)
+   apply (fastforce dest: valid_sched_valid_queues simp: valid_sched_weak_strg einvs_valid_etcbs)
+  apply fastforce
   done
 
 lemma tcbBoundNotification_caps_safe[simp]:
@@ -1807,6 +1739,10 @@ lemma valid_bound_ntfn_lift:
   apply (wp typ_at_lifts[OF P])+
   done
 
+crunches 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
@@ -1819,7 +1755,7 @@ lemma bindNotification_invs':
   apply (simp add: bindNotification_def invs'_def valid_state'_def)
   apply (rule hoare_seq_ext[OF _ get_ntfn_sp'])
   apply (rule hoare_pre)
-   apply (wp set_ntfn_valid_pspace' sbn_sch_act' sbn_valid_queues valid_irq_node_lift
+   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)+
@@ -2045,12 +1981,6 @@ lemma decodeSetMCPriority_corres:
       apply (clarsimp simp: newroot_rel_def elim!: is_thread_cap.elims(2))
   by (wpsimp simp: valid_cap_def valid_cap'_def)+
 
-lemma valid_objs'_maxPriority':
-  "\<And>s t. \<lbrakk> valid_objs' s; tcb_at' t s \<rbrakk> \<Longrightarrow> obj_at' (\<lambda>tcb. tcbMCP tcb \<le> maxPriority) t s"
-  apply (erule (1) valid_objs_valid_tcbE)
-  apply (clarsimp simp: valid_tcb'_def)
-  done
-
 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_def)
diff --git a/proof/refine/AARCH64/Untyped_R.thy b/proof/refine/AARCH64/Untyped_R.thy
index a781e18568..2b28c833b2 100644
--- a/proof/refine/AARCH64/Untyped_R.thy
+++ b/proof/refine/AARCH64/Untyped_R.thy
@@ -1348,16 +1348,6 @@ crunches insertNewCaps
 
 crunch exst[wp]: set_cdt "\<lambda>s. P (exst s)"
 
-(*FIXME: Move to StateRelation*)
-lemma state_relation_schact[elim!]:
-  "(s,s') \<in> state_relation \<Longrightarrow> sched_act_relation (scheduler_action s) (ksSchedulerAction s')"
-  apply (simp add: state_relation_def)
-  done
-
-lemma state_relation_queues[elim!]: "(s,s') \<in> state_relation \<Longrightarrow> ready_queues_relation (ready_queues s) (ksReadyQueues s')"
-  apply (simp add: state_relation_def)
-  done
-
 lemma set_original_symb_exec_l:
   "corres_underlying {(s, s'). f (kheap s) (exst s) s'} nf 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)
@@ -1384,6 +1374,10 @@ lemma updateNewFreeIndex_noop_psp_corres:
         | simp add: updateTrackedFreeIndex_def getSlotCap_def)+
   done
 
+crunches 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]
 shows
@@ -3613,8 +3607,8 @@ lemma updateFreeIndex_clear_invs':
       apply (simp add:updateCap_def)
       apply (wp setCTE_irq_handlers' getCTE_wp)
      apply (simp add:updateCap_def)
-     apply (wp irqs_masked_lift valid_queues_lift' cur_tcb_lift ct_idle_or_in_cur_domain'_lift
-               hoare_vcg_disj_lift untyped_ranges_zero_lift getCTE_wp
+     apply (wp irqs_masked_lift cur_tcb_lift ct_idle_or_in_cur_domain'_lift
+               hoare_vcg_disj_lift untyped_ranges_zero_lift getCTE_wp valid_bitmaps_lift
               | wp (once) hoare_use_eq[where f="gsUntypedZeroRanges"]
               | simp add: getSlotCap_def
               | simp add: cte_wp_at_ctes_of)+
@@ -4226,14 +4220,12 @@ context begin interpretation Arch . (*FIXME: arch_split*)
 lemma resetUntypedCap_corres:
   "untypinv_relation ui ui'
     \<Longrightarrow> corres (dc \<oplus> dc)
-    (invs 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)
   apply (rule corres_guard_imp)
@@ -5077,7 +5069,7 @@ lemma inv_untyped_corres':
       apply (clarsimp simp only: pred_conj_def invs ui)
       apply (strengthen vui)
       apply (cut_tac vui invs invs')
-      apply (clarsimp simp: cte_wp_at_caps_of_state valid_sched_etcbs)
+      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
@@ -5128,7 +5120,6 @@ crunches insertNewCap
   and global_refs': "\<lambda>s. P (global_refs' s)"
   and gsMaxObjectSize[wp]: "\<lambda>s. P (gsMaxObjectSize s)"
   and irq_states' [wp]: valid_irq_states'
-  and vq'[wp]: valid_queues'
   and irqs_masked' [wp]: irqs_masked'
   and valid_machine_state'[wp]: valid_machine_state'
   and pspace_domain_valid[wp]: pspace_domain_valid
@@ -5136,6 +5127,9 @@ crunches insertNewCap
   and tcbState_inv[wp]: "obj_at' (\<lambda>tcb. P (tcbState tcb)) 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 sched_queues_projs[wp]: "\<lambda>s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)"
+  and tcbQueueds_of[wp]: "\<lambda>s. P (tcbQueued |< tcbs_of' s)"
+  and valid_sched_pointers[wp]: valid_sched_pointers
   (wp: crunch_wps)
 
 crunch if_unsafe_then_cap'[wp]: updateNewFreeIndex "if_unsafe_then_cap'"
@@ -5296,8 +5290,8 @@ lemma insertNewCap_invs':
   apply (simp add: invs'_def valid_state'_def)
   apply (rule hoare_pre)
    apply (wp insertNewCap_valid_pspace' sch_act_wf_lift
-             valid_queues_lift cur_tcb_lift tcb_in_cur_domain'_lift
-             insertNewCap_valid_global_refs'
+             cur_tcb_lift tcb_in_cur_domain'_lift valid_bitmaps_lift
+             insertNewCap_valid_global_refs' sym_heap_sched_pointers_lift
              valid_irq_node_lift insertNewCap_valid_irq_handlers)
   apply (clarsimp simp: cte_wp_at_ctes_of)
   apply (frule ctes_of_valid[rotated, where p=parent, OF valid_pspace_valid_objs'])
diff --git a/proof/refine/AARCH64/VSpace_R.thy b/proof/refine/AARCH64/VSpace_R.thy
index 32bce50440..4532ab82b8 100644
--- a/proof/refine/AARCH64/VSpace_R.thy
+++ b/proof/refine/AARCH64/VSpace_R.thy
@@ -316,11 +316,6 @@ lemma setVCPU_ksQ[wp]:
   "\<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace> setObject p (v::vcpu) \<lbrace>\<lambda>rv s. P (ksReadyQueues s)\<rbrace>"
   by (wp setObject_qs updateObject_default_inv | simp)+
 
-lemma setVCPU_valid_queues'[wp]:
-  "setObject v (vcpu::vcpu) \<lbrace>valid_queues'\<rbrace>"
-  unfolding valid_queues'_def
-  by (rule hoare_lift_Pf[where f=ksReadyQueues]; wp hoare_vcg_all_lift updateObject_default_inv)
-
 lemma setVCPU_ct_not_inQ[wp]:
   "setObject v (vcpu::vcpu) \<lbrace>ct_not_inQ\<rbrace>"
   apply (wp ct_not_inQ_lift)
@@ -906,23 +901,6 @@ lemma setVCPU_valid_arch':
   apply (clarsimp simp: is_vcpu'_def ko_wp_at'_def)
   done
 
-lemma setVCPU_valid_queues [wp]:
-  "\<lbrace>valid_queues\<rbrace> setObject p (v::vcpu) \<lbrace>\<lambda>_. valid_queues\<rbrace>"
-  by (wp valid_queues_lift | simp add: pred_tcb_at'_def)+
-
-crunches
-  vcpuDisable, vcpuRestore, vcpuEnable, vcpuUpdate, vcpuSaveRegRange, vgicUpdateLR
-  for valid_queues[wp]: valid_queues
-  (ignore: doMachineOp wp: mapM_x_wp)
-
-lemma vcpuSave_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> vcpuSave param_a \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  by (wpsimp simp: vcpuSave_def armvVCPUSave_def wp: mapM_x_wp cong: option.case_cong_weak | simp)+
-
-lemma vcpuSwitch_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> vcpuSwitch param_a \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  by (wpsimp simp: vcpuSwitch_def modifyArchState_def | simp)+
-
 lemma setObject_vcpu_no_tcb_update:
   "\<lbrakk> vcpuTCBPtr (f vcpu) = vcpuTCBPtr vcpu \<rbrakk>
   \<Longrightarrow> \<lbrace> valid_objs' and ko_at' (vcpu :: vcpu) p\<rbrace> setObject p (f vcpu) \<lbrace> \<lambda>_. valid_objs' \<rbrace>"
@@ -952,6 +930,10 @@ crunches
   and ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
   (wp: mapM_wp_inv simp: mapM_x_mapM)
 
+lemma setVCPU_tcbs_of'[wp]:
+  "setObject v (vcpu :: vcpu) \<lbrace>\<lambda>s. P' (tcbs_of' s)\<rbrace>"
+  by setObject_easy_cases
+
 lemma setVCPU_regs_r_invs_cicd':
   "\<lbrace>invs_no_cicd' and ko_at' vcpu v\<rbrace>
    setObject v (vcpuRegs_update (\<lambda>_. (vcpuRegs vcpu)(r:=rval)) vcpu) \<lbrace>\<lambda>_. invs_no_cicd'\<rbrace>"
@@ -965,7 +947,7 @@ lemma setVCPU_regs_r_invs_cicd':
                     valid_irq_node_lift_asm [where Q=\<top>] valid_irq_handlers_lift'
                     cteCaps_of_ctes_of_lift irqs_masked_lift ct_idle_or_in_cur_domain'_lift
                     valid_irq_states_lift' hoare_vcg_all_lift hoare_vcg_disj_lift
-                    setObject_typ_at' cur_tcb_lift
+                    setObject_typ_at' cur_tcb_lift valid_bitmaps_lift
                     setVCPU_regs_valid_arch' setVCPU_regs_vcpu_live
               simp: objBits_simps archObjSize_def vcpuBits_def pageBits_def
                     state_refs_of'_vcpu_empty state_hyp_refs_of'_vcpu_absorb)
@@ -987,7 +969,7 @@ lemma setVCPU_vgic_invs_cicd':
                     valid_irq_node_lift_asm [where Q=\<top>] valid_irq_handlers_lift'
                     cteCaps_of_ctes_of_lift irqs_masked_lift ct_idle_or_in_cur_domain'_lift
                     valid_irq_states_lift' hoare_vcg_all_lift hoare_vcg_disj_lift
-                    setObject_typ_at' cur_tcb_lift
+                    setObject_typ_at' cur_tcb_lift valid_bitmaps_lift
                     setVCPU_vgic_valid_arch'
               simp: objBits_simps archObjSize_def vcpuBits_def pageBits_def
                     state_refs_of'_vcpu_empty state_hyp_refs_of'_vcpu_absorb)
@@ -1009,7 +991,7 @@ lemma setVCPU_VPPIMasked_invs_cicd':
                     valid_irq_node_lift_asm [where Q=\<top>] valid_irq_handlers_lift'
                     cteCaps_of_ctes_of_lift irqs_masked_lift ct_idle_or_in_cur_domain'_lift
                     valid_irq_states_lift' hoare_vcg_all_lift hoare_vcg_disj_lift
-                    setObject_typ_at' cur_tcb_lift
+                    setObject_typ_at' cur_tcb_lift valid_bitmaps_lift
                     setVCPU_VPPIMasked_valid_arch'
               simp: objBits_simps archObjSize_def vcpuBits_def pageBits_def
                     state_refs_of'_vcpu_empty state_hyp_refs_of'_vcpu_absorb)
@@ -1031,7 +1013,7 @@ lemma setVCPU_VTimer_invs_cicd':
                     valid_irq_node_lift_asm [where Q=\<top>] valid_irq_handlers_lift'
                     cteCaps_of_ctes_of_lift irqs_masked_lift ct_idle_or_in_cur_domain'_lift
                     valid_irq_states_lift' hoare_vcg_all_lift hoare_vcg_disj_lift
-                    setObject_typ_at' cur_tcb_lift
+                    setObject_typ_at' cur_tcb_lift valid_bitmaps_lift
                     setVCPU_VTimer_valid_arch'
               simp: objBits_simps archObjSize_def vcpuBits_def pageBits_def
                     state_refs_of'_vcpu_empty state_hyp_refs_of'_vcpu_absorb)
@@ -1111,13 +1093,12 @@ lemma vcpuSave_invs_no_cicd'[wp]:
   by (wpsimp simp: vcpuSave_def armvVCPUSave_def wp: mapM_x_wp cong: option.case_cong_weak
       | assumption)+
 lemma valid_arch_state'_armHSCurVCPU_update[simp]:
-  "ko_wp_at' (is_vcpu' and hyp_live') v s \<Longrightarrow>
-   valid_arch_state' s \<Longrightarrow> valid_arch_state' (s\<lparr>ksArchState := armHSCurVCPU_update (\<lambda>_. Some (v, b)) (ksArchState s)\<rparr>)"
-  by (clarsimp simp: invs'_def valid_state'_def valid_queues_def valid_queues_no_bitmap_def
-             bitmapQ_defs valid_global_refs'_def valid_arch_state'_def global_refs'_def
-             valid_queues'_def valid_irq_node'_def valid_irq_handlers'_def
-             irq_issued'_def irqs_masked'_def valid_machine_state'_def
-             cur_tcb'_def)
+  "\<lbrakk> ko_wp_at' (is_vcpu' and hyp_live') v s; valid_arch_state' s \<rbrakk> \<Longrightarrow>
+   valid_arch_state' (s\<lparr>ksArchState := armHSCurVCPU_update (\<lambda>_. Some (v, b)) (ksArchState s)\<rparr>)"
+  by (clarsimp simp: invs'_def valid_state'_def
+                     bitmapQ_defs valid_global_refs'_def valid_arch_state'_def global_refs'_def
+                     valid_irq_node'_def valid_irq_handlers'_def
+                     irq_issued'_def irqs_masked'_def valid_machine_state'_def cur_tcb'_def)
 
 lemma dmo_vcpu_hyp:
   "\<lbrace>ko_wp_at' (is_vcpu' and hyp_live') v\<rbrace> doMachineOp f \<lbrace>\<lambda>_. ko_wp_at' (is_vcpu' and hyp_live') v\<rbrace>"
@@ -1210,20 +1191,18 @@ lemma vcpuSwitch_valid_arch_state'[wp]:
 lemma invs_no_cicd'_armHSCurVCPU_update[simp]:
   "ko_wp_at' (is_vcpu' and hyp_live') v s \<Longrightarrow> invs_no_cicd' s \<Longrightarrow>
      invs_no_cicd' (s\<lparr>ksArchState := armHSCurVCPU_update (\<lambda>_. Some (v, b)) (ksArchState s)\<rparr>)"
-  by (clarsimp simp: invs_no_cicd'_def valid_state'_def valid_queues_def valid_queues_no_bitmap_def
-             bitmapQ_defs valid_global_refs'_def valid_arch_state'_def global_refs'_def
-             valid_queues'_def valid_irq_node'_def valid_irq_handlers'_def
-             irq_issued'_def irqs_masked'_def valid_machine_state'_def
-             cur_tcb'_def)
+  by (clarsimp simp: invs_no_cicd'_def valid_state'_def
+                     bitmapQ_defs valid_global_refs'_def valid_arch_state'_def global_refs'_def
+                     valid_irq_node'_def valid_irq_handlers'_def
+                     irq_issued'_def irqs_masked'_def valid_machine_state'_def cur_tcb'_def)
 
 lemma invs'_armHSCurVCPU_update[simp]:
   "ko_wp_at' (is_vcpu' and hyp_live') v s \<Longrightarrow>
    invs' s \<Longrightarrow> invs' (s\<lparr>ksArchState := armHSCurVCPU_update (\<lambda>_. Some (v, b)) (ksArchState s)\<rparr>)"
-  apply (clarsimp simp: invs'_def valid_state'_def valid_queues_def valid_queues_no_bitmap_def
-             bitmapQ_defs valid_global_refs'_def valid_arch_state'_def global_refs'_def
-             valid_queues'_def valid_irq_node'_def valid_irq_handlers'_def
-             irq_issued'_def irqs_masked'_def valid_machine_state'_def
-             cur_tcb'_def)
+  apply (clarsimp simp: invs'_def valid_state'_def
+                        bitmapQ_defs valid_global_refs'_def valid_arch_state'_def global_refs'_def
+                        valid_irq_node'_def valid_irq_handlers'_def
+                        irq_issued'_def irqs_masked'_def valid_machine_state'_def cur_tcb'_def)
   done
 
 lemma armHSCurVCPU_None_invs'[wp]:
@@ -1246,7 +1225,7 @@ lemma setVCPU_vgic_invs':
                     valid_irq_node_lift_asm [where Q=\<top>] valid_irq_handlers_lift'
                     cteCaps_of_ctes_of_lift irqs_masked_lift ct_idle_or_in_cur_domain'_lift
                     valid_irq_states_lift' hoare_vcg_all_lift hoare_vcg_disj_lift
-                    setObject_typ_at' cur_tcb_lift
+                    setObject_typ_at' cur_tcb_lift valid_bitmaps_lift
                     setVCPU_vgic_valid_arch'
               simp: objBits_simps archObjSize_def vcpuBits_def pageBits_def
                     state_refs_of'_vcpu_empty state_hyp_refs_of'_vcpu_absorb)
@@ -1266,7 +1245,7 @@ lemma setVCPU_regs_invs':
                     valid_irq_node_lift_asm [where Q=\<top>] valid_irq_handlers_lift'
                     cteCaps_of_ctes_of_lift irqs_masked_lift ct_idle_or_in_cur_domain'_lift
                     valid_irq_states_lift' hoare_vcg_all_lift hoare_vcg_disj_lift
-                    setObject_typ_at' cur_tcb_lift
+                    setObject_typ_at' cur_tcb_lift valid_bitmaps_lift
                     setVCPU_regs_valid_arch'
               simp: objBits_simps archObjSize_def vcpuBits_def pageBits_def
                     state_refs_of'_vcpu_empty state_hyp_refs_of'_vcpu_absorb)
@@ -1286,7 +1265,7 @@ lemma setVCPU_VPPIMasked_invs':
                     valid_irq_node_lift_asm [where Q=\<top>] valid_irq_handlers_lift'
                     cteCaps_of_ctes_of_lift irqs_masked_lift ct_idle_or_in_cur_domain'_lift
                     valid_irq_states_lift' hoare_vcg_all_lift hoare_vcg_disj_lift
-                    setObject_typ_at' cur_tcb_lift
+                    setObject_typ_at' cur_tcb_lift valid_bitmaps_lift
                     setVCPU_VPPIMasked_valid_arch'
               simp: objBits_simps archObjSize_def vcpuBits_def pageBits_def
                     state_refs_of'_vcpu_empty state_hyp_refs_of'_vcpu_absorb)
@@ -1306,7 +1285,7 @@ lemma setVCPU_VTimer_invs':
                     valid_irq_node_lift_asm [where Q=\<top>] valid_irq_handlers_lift'
                     cteCaps_of_ctes_of_lift irqs_masked_lift ct_idle_or_in_cur_domain'_lift
                     valid_irq_states_lift' hoare_vcg_all_lift hoare_vcg_disj_lift
-                    setObject_typ_at' cur_tcb_lift
+                    setObject_typ_at' cur_tcb_lift valid_bitmaps_lift
                     setVCPU_VTimer_valid_arch'
               simp: objBits_simps archObjSize_def vcpuBits_def pageBits_def
                     state_refs_of'_vcpu_empty state_hyp_refs_of'_vcpu_absorb)
@@ -2530,14 +2509,6 @@ lemma setASIDPool_tcb_obj_at'[wp]:
   apply (clarsimp simp add: updateObject_default_def in_monad)
   done
 
-lemma setASIDPool_valid_queues[wp]:
-  "setObject p (ap::asidpool) \<lbrace>valid_queues\<rbrace>"
-  by (wp valid_queues_lift | simp add: pred_tcb_at'_def)+
-
-lemma setASIDPool_valid_queues'[wp]:
-  "setObject p (ap::asidpool) \<lbrace>valid_queues'\<rbrace>"
-  by (wp valid_queues_lift')
-
 lemma setASIDPool_state_refs'[wp]:
   "setObject p (ap::asidpool) \<lbrace>\<lambda>s. P (state_refs_of' s)\<rbrace>"
   apply (clarsimp simp: setObject_def valid_def in_monad split_def
@@ -2648,6 +2619,10 @@ lemma setObject_ap_ksDomScheduleIdx[wp]:
   "setObject p (ap::asidpool) \<lbrace>\<lambda>s. P (ksDomScheduleIdx s)\<rbrace>"
   by (wpsimp wp: updateObject_default_inv simp: setObject_def)
 
+lemma setObject_ap_tcbs_of'[wp]:
+  "setObject p (ap::asidpool) \<lbrace>\<lambda>s. P' (tcbs_of' s)\<rbrace>"
+  by setObject_easy_cases
+
 lemma setASIDPool_invs[wp]:
   "setObject p (ap::asidpool) \<lbrace>invs'\<rbrace>"
   apply (simp add: invs'_def valid_state'_def valid_pspace'_def)
@@ -2655,10 +2630,10 @@ lemma setASIDPool_invs[wp]:
             valid_irq_node_lift
             cur_tcb_lift valid_irq_handlers_lift''
             untyped_ranges_zero_lift
-            updateObject_default_inv
+            updateObject_default_inv valid_bitmaps_lift
           | simp add: cteCaps_of_def
           | rule setObject_ksPSpace_only)+
-  apply (clarsimp simp:  o_def)
+  apply (clarsimp simp: o_def)
   done
 
 lemma doMachineOp_invalidateTranslationASID_invs'[wp]:
@@ -2710,7 +2685,7 @@ lemma setASIDPool_invs_no_cicd'[wp]:
             valid_irq_node_lift
             cur_tcb_lift valid_irq_handlers_lift''
             untyped_ranges_zero_lift
-            updateObject_default_inv
+            updateObject_default_inv valid_bitmaps_lift
           | simp add: cteCaps_of_def
           | rule setObject_ksPSpace_only)+
   apply (clarsimp simp:  o_def)
@@ -2820,10 +2795,6 @@ crunch norqL1[wp]: storePTE "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
 crunch norqL2[wp]: storePTE "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
   (simp: updateObject_default_def)
 
-lemma storePTE_valid_queues' [wp]:
-  "\<lbrace>valid_queues'\<rbrace> storePTE p pte \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  by (wp valid_queues_lift')
-
 lemma storePTE_iflive [wp]:
   "\<lbrace>if_live_then_nonz_cap'\<rbrace> storePTE p pte \<lbrace>\<lambda>rv. if_live_then_nonz_cap'\<rbrace>"
   apply (simp add: storePTE_def)
@@ -2942,10 +2913,6 @@ lemma storePTE_valid_objs[wp]:
   apply simp
   done
 
-lemma storePTE_valid_queues [wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> storePTE p pde \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  by (wp valid_queues_lift | simp add: pred_tcb_at'_def)+
-
 lemma storePTE_ko_wp_vcpu_at'[wp]:
   "storePTE p pde \<lbrace>\<lambda>s. P (ko_wp_at' (is_vcpu' and hyp_live') p' s)\<rbrace>"
   apply (clarsimp simp: storePTE_def)
@@ -2953,11 +2920,19 @@ lemma storePTE_ko_wp_vcpu_at'[wp]:
    apply (auto simp: bit_simps ko_wp_at'_def obj_at'_def is_vcpu'_def)+
   done
 
+lemma setObject_pte_tcb_of'[wp]:
+  "setObject slote (pte::pte) \<lbrace>\<lambda>s. P' (tcbs_of' s)\<rbrace>"
+  by setObject_easy_cases
+
+crunches storePTE
+  for tcbs_of'[wp]: "\<lambda>s. P (tcbs_of' s)"
+
 lemma storePTE_invs[wp]:
   "\<lbrace>invs' and K (ppn_bounded pte)\<rbrace> storePTE p pte \<lbrace>\<lambda>_. invs'\<rbrace>"
   unfolding invs'_def valid_state'_def valid_pspace'_def
   by (wpsimp wp: sch_act_wf_lift valid_global_refs_lift' irqs_masked_lift valid_arch_state_lift'
                  valid_irq_node_lift cur_tcb_lift valid_irq_handlers_lift'' untyped_ranges_zero_lift
+                 valid_bitmaps_lift
              simp: cteCaps_of_def o_def)
 
 crunch cte_wp_at'[wp]: unmapPageTable "\<lambda>s. P (cte_wp_at' P' p s)"
diff --git a/proof/refine/AARCH64/orphanage/Orphanage.thy b/proof/refine/AARCH64/orphanage/Orphanage.thy
index 7e56a739c6..7196a28156 100644
--- a/proof/refine/AARCH64/orphanage/Orphanage.thy
+++ b/proof/refine/AARCH64/orphanage/Orphanage.thy
@@ -59,8 +59,7 @@ where
 definition
    all_queued_tcb_ptrs :: "kernel_state \<Rightarrow> machine_word set"
 where
-   "all_queued_tcb_ptrs s \<equiv>
-       { tcb_ptr. \<exists> priority. tcb_ptr : set ((ksReadyQueues s) priority) }"
+   "all_queued_tcb_ptrs s \<equiv> { tcb_ptr. obj_at' tcbQueued tcb_ptr s }"
 
 lemma st_tcb_at_neg':
   "(st_tcb_at' (\<lambda> ts. \<not> P ts) t s) = (tcb_at' t s \<and> \<not> st_tcb_at' P t s)"
@@ -107,8 +106,8 @@ lemma no_orphans_lift:
      "\<And> tcb_ptr. \<lbrace> \<lambda>s. tcb_ptr = ksCurThread s \<rbrace> f \<lbrace> \<lambda>_ s. tcb_ptr = ksCurThread s \<rbrace>"
    assumes st_tcb_at'_is_lifted:
      "\<And>P p. \<lbrace> \<lambda>s. st_tcb_at' P p s\<rbrace> f \<lbrace> \<lambda>_ s. st_tcb_at' P p s \<rbrace>"
-   assumes ksReadyQueues_is_lifted:
-     "\<And>P. \<lbrace> \<lambda>s. P (ksReadyQueues s)\<rbrace> f \<lbrace> \<lambda>_ s. P (ksReadyQueues s) \<rbrace>"
+   assumes tcbQueued_is_lifted:
+     "\<And>P tcb_ptr. f \<lbrace> \<lambda>s. obj_at' (\<lambda>tcb. P (tcbQueued tcb)) tcb_ptr s \<rbrace>"
    assumes ksSchedulerAction_is_lifted:
      "\<And>P. \<lbrace> \<lambda>s. P (ksSchedulerAction s)\<rbrace> f \<lbrace> \<lambda>_ s. P (ksSchedulerAction s) \<rbrace>"
    shows
@@ -119,7 +118,7 @@ lemma no_orphans_lift:
   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
     apply (rule ksCurThread_is_lifted)
    apply (wp hoare_vcg_disj_lift)
-    apply (rule ksReadyQueues_is_lifted)
+    apply (wpsimp wp: tcbQueued_is_lifted)
    apply (wp hoare_vcg_disj_lift)
     apply (rule typ_at'_is_lifted)
    apply (wp hoare_vcg_disj_lift)
@@ -139,13 +138,12 @@ lemma st_tcb_at'_all_active_tcb_ptrs_lift:
   by (clarsimp simp: all_active_tcb_ptrs_def)
      (rule st_tcb_at'_is_active_tcb_ptr_lift [OF assms])
 
-lemma ksQ_all_queued_tcb_ptrs_lift:
-  assumes "\<And>P p. \<lbrace>\<lambda>s. P (ksReadyQueues s p)\<rbrace> f \<lbrace>\<lambda>rv s. P (ksReadyQueues s p)\<rbrace>"
+lemma tcbQueued_all_queued_tcb_ptrs_lift:
+  assumes "\<And>Q P tcb_ptr. f \<lbrace>\<lambda>s. Q (obj_at' (\<lambda>tcb. P (tcbQueued tcb)) tcb_ptr s)\<rbrace>"
   shows "\<lbrace>\<lambda>s. P (t \<in> all_queued_tcb_ptrs s)\<rbrace> f \<lbrace>\<lambda>_ s. P (t \<in> all_queued_tcb_ptrs s)\<rbrace>"
   apply (clarsimp simp: all_queued_tcb_ptrs_def)
   apply (rule_tac P=P in P_bool_lift)
    apply (wp hoare_vcg_ex_lift assms)
-  apply (clarsimp)
   apply (wp hoare_vcg_all_lift assms)
   done
 
@@ -180,6 +178,11 @@ lemma almost_no_orphans_disj:
   apply (auto del: pred_tcb_at' intro: pred_tcb_at')
   done
 
+lemma all_queued_tcb_ptrs_ksReadyQueues_update[simp]:
+  "tcb_ptr \<in> all_queued_tcb_ptrs (ksReadyQueues_update f s) = (tcb_ptr \<in> all_queued_tcb_ptrs s)"
+  unfolding all_queued_tcb_ptrs_def
+  by (clarsimp simp: obj_at'_def)
+
 lemma no_orphans_update_simps[simp]:
   "no_orphans (gsCNodes_update f s) = no_orphans s"
   "no_orphans (gsUserPages_update g s) = no_orphans s"
@@ -240,6 +243,12 @@ crunch no_orphans [wp]: removeFromBitmap "no_orphans"
 crunch almost_no_orphans [wp]: addToBitmap "almost_no_orphans x"
 crunch almost_no_orphans [wp]: removeFromBitmap "almost_no_orphans x"
 
+lemma setCTE_tcbQueued[wp]:
+  "setCTE ptr v \<lbrace>\<lambda>s. Q (obj_at' (\<lambda>tcb. P (tcbQueued tcb)) t s)\<rbrace>"
+  apply (simp add: setCTE_def)
+  apply (rule setObject_cte_obj_at_tcb', simp_all)
+  done
+
 lemma setCTE_no_orphans [wp]:
   "\<lbrace> \<lambda>s. no_orphans s \<rbrace>
    setCTE p cte
@@ -253,7 +262,7 @@ lemma setCTE_almost_no_orphans [wp]:
    setCTE p cte
    \<lbrace> \<lambda>rv s. almost_no_orphans tcb_ptr s \<rbrace>"
   unfolding almost_no_orphans_disj all_queued_tcb_ptrs_def
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift setCTE_typ_at' setCTE_pred_tcb_at')
+  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift setCTE_typ_at' setCTE_pred_tcb_at')
   done
 
 crunch no_orphans [wp]: activateIdleThread "no_orphans"
@@ -263,128 +272,131 @@ lemma asUser_no_orphans [wp]:
    asUser thread f
    \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
   unfolding no_orphans_disj all_queued_tcb_ptrs_def
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
+  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift)
+  done
+
+lemma threadSet_all_queued_tcb_ptrs:
+  "\<forall>tcb. tcbQueued (F tcb) = tcbQueued tcb \<Longrightarrow> threadSet F tptr \<lbrace>\<lambda>s. P (t \<in> all_queued_tcb_ptrs s)\<rbrace>"
+  unfolding almost_no_orphans_disj all_queued_tcb_ptrs_def
+  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_st_tcb_at2 threadSet_wp)
+  apply (erule rsubst[where P=P])
+  apply (clarsimp simp: obj_at'_def ps_clear_upd objBits_simps)
+  done
+
+crunches removeFromBitmap, addToBitmap, setQueue
+  for all_queued_tcb_ptrs[wp]: "\<lambda>s. P (t \<in> all_queued_tcb_ptrs s)"
+  (wp: tcbQueued_all_queued_tcb_ptrs_lift)
+
+crunches tcbQueuePrepend, tcbQueueAppend
+  for all_queued_tcb_ptrs[wp]: "\<lambda>s. P (t \<in> all_queued_tcb_ptrs s)"
+  (wp: threadSet_all_queued_tcb_ptrs ignore: threadSet)
+
+lemma tcbQueued_update_True_all_queued_tcb_ptrs[wp]:
+  "\<lbrace>\<lambda>s. tcb_ptr \<noteq> tcb_ptr' \<longrightarrow> tcb_ptr' \<in> all_queued_tcb_ptrs s\<rbrace>
+   threadSet (tcbQueued_update (\<lambda>_. True)) tcb_ptr
+   \<lbrace>\<lambda>_ s. tcb_ptr' \<in> all_queued_tcb_ptrs s\<rbrace>"
+  apply (wpsimp wp: threadSet_wp)
+  apply (fastforce simp: all_queued_tcb_ptrs_def obj_at'_def ps_clear_upd objBits_simps)
+  done
+
+lemma tcbSchedEnqueue_all_queued_tcb_ptrs[wp]:
+  "\<lbrace>\<lambda>s. tcb_ptr \<noteq> tcb_ptr' \<longrightarrow> tcb_ptr \<in> all_queued_tcb_ptrs s\<rbrace>
+   tcbSchedEnqueue tcb_ptr'
+   \<lbrace>\<lambda>_ s. tcb_ptr \<in> all_queued_tcb_ptrs s\<rbrace>"
+  unfolding tcbSchedEnqueue_def tcbQueuePrepend_def
+  apply (wpsimp wp: hoare_vcg_imp_lift' threadGet_wp
+         | wpsimp wp: threadSet_all_queued_tcb_ptrs)+
+  apply (clarsimp simp: all_queued_tcb_ptrs_def obj_at'_def)
+  done
+
+lemmas tcbSchedEnqueue_all_queued_tcb_ptrs'[wp] =
+  tcbSchedEnqueue_all_queued_tcb_ptrs[simplified all_queued_tcb_ptrs_def, simplified]
+
+lemma tcbSchedAppend_all_queued_tcb_ptrs[wp]:
+  "\<lbrace>\<lambda>s. tcb_ptr \<noteq> tcb_ptr' \<longrightarrow> tcb_ptr \<in> all_queued_tcb_ptrs s\<rbrace>
+   tcbSchedAppend tcb_ptr'
+   \<lbrace>\<lambda>_ s. tcb_ptr \<in> all_queued_tcb_ptrs s\<rbrace>"
+  unfolding tcbSchedAppend_def tcbQueueAppend_def
+  apply (wpsimp wp: hoare_vcg_imp_lift' threadGet_wp
+         | wpsimp wp: threadSet_all_queued_tcb_ptrs)+
+  apply (clarsimp simp: all_queued_tcb_ptrs_def obj_at'_def)
   done
 
+lemmas tcbSchedAppend_all_queued_tcb_ptrs'[wp] =
+  tcbSchedAppend_all_queued_tcb_ptrs[simplified all_queued_tcb_ptrs_def, simplified]
+
 lemma threadSet_no_orphans:
-  "\<forall>tcb. \<not> is_active_thread_state (tcbState tcb) \<longrightarrow> \<not> is_active_thread_state (tcbState (F tcb)) \<Longrightarrow>
-   \<lbrace> \<lambda>s. no_orphans s \<rbrace>
-   threadSet F tptr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+  "\<lbrakk>\<forall>tcb. \<not> is_active_thread_state (tcbState tcb) \<longrightarrow> \<not> is_active_thread_state (tcbState (F tcb));
+    \<forall>tcb. tcbQueued (F tcb) = tcbQueued tcb\<rbrakk>
+   \<Longrightarrow> threadSet F tptr \<lbrace>no_orphans\<rbrace>"
   unfolding no_orphans_disj all_queued_tcb_ptrs_def
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_st_tcb_at2 | clarsimp)+
-  done
+  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_st_tcb_at2)
 
-lemma threadSet_almost_no_orphans:
-  "\<forall>tcb. \<not> is_active_thread_state (tcbState tcb) \<longrightarrow> \<not> is_active_thread_state (tcbState (F tcb)) \<Longrightarrow>
-   \<lbrace> \<lambda>s. almost_no_orphans ptr s \<rbrace>
-   threadSet F tptr
-   \<lbrace> \<lambda>rv s. almost_no_orphans ptr s \<rbrace>"
-  unfolding almost_no_orphans_disj all_queued_tcb_ptrs_def
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_st_tcb_at2 | clarsimp)+
+lemma tcbQueued_update_True_no_orphans:
+  "\<lbrace>almost_no_orphans tptr and tcb_at' tptr\<rbrace>
+   threadSet (tcbQueued_update (\<lambda>_. True)) tptr
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
+  unfolding no_orphans_disj
+  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_st_tcb_at2)
+  apply (fastforce simp: almost_no_orphans_def all_active_tcb_ptrs_def
+                         tcb_at_typ_at' st_tcb_at_neg' is_active_tcb_ptr_def)
   done
 
-lemma setQueue_no_orphans_enq:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> set (ksReadyQueues s (d, prio)) \<subseteq> set qs \<rbrace>
-   setQueue d prio qs
-   \<lbrace> \<lambda>_ s. no_orphans s \<rbrace>"
-  unfolding setQueue_def
-  apply wp
-  apply (clarsimp simp: no_orphans_def all_queued_tcb_ptrs_def
-                  split: if_split_asm)
+lemma tcbQueued_update_True_almost_no_orphans:
+  "threadSet (tcbQueued_update (\<lambda>_. True)) tptr' \<lbrace>almost_no_orphans tptr\<rbrace>"
+  unfolding almost_no_orphans_disj
+  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift' hoare_vcg_disj_lift threadSet_st_tcb_at2)
   apply fastforce
   done
 
-lemma setQueue_almost_no_orphans_enq:
-  "\<lbrace> \<lambda>s. almost_no_orphans tcb_ptr s \<and> set (ksReadyQueues s (d, prio)) \<subseteq> set qs \<and> tcb_ptr \<in> set qs \<rbrace>
-   setQueue d prio qs
-   \<lbrace> \<lambda>_ s. no_orphans s \<rbrace>"
+lemma threadSet_almost_no_orphans:
+  "\<lbrakk>\<forall>tcb. \<not> is_active_thread_state (tcbState tcb) \<longrightarrow> \<not> is_active_thread_state (tcbState (F tcb));
+    \<forall>tcb. tcbQueued (F tcb) = tcbQueued tcb\<rbrakk>
+   \<Longrightarrow> threadSet F tptr \<lbrace>almost_no_orphans ptr\<rbrace>"
+  unfolding almost_no_orphans_disj all_queued_tcb_ptrs_def
+  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_st_tcb_at2)
+
+lemma setQueue_no_orphans[wp]:
+  "setQueue d prio qs \<lbrace>no_orphans\<rbrace>"
   unfolding setQueue_def
   apply wp
-  apply (clarsimp simp: no_orphans_def almost_no_orphans_def all_queued_tcb_ptrs_def
-                  split: if_split_asm)
-  apply fastforce
+  apply (clarsimp simp: no_orphans_def)
   done
 
-lemma setQueue_almost_no_orphans_enq_lift:
-  "\<lbrace> \<lambda>s. almost_no_orphans tcb_ptr s \<and> set (ksReadyQueues s (d, prio)) \<subseteq> set qs \<rbrace>
-   setQueue d prio qs
-   \<lbrace> \<lambda>_ s. almost_no_orphans tcb_ptr s \<rbrace>"
+lemma setQueue_almost_no_orphans[wp]:
+  "setQueue d prio qs \<lbrace>almost_no_orphans tptr\<rbrace>"
   unfolding setQueue_def
   apply wp
-  apply (clarsimp simp: almost_no_orphans_def all_queued_tcb_ptrs_def
-                  split: if_split_asm)
-  apply fastforce
+  apply (clarsimp simp: almost_no_orphans_def)
   done
 
 lemma tcbSchedEnqueue_no_orphans[wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<rbrace>
-   tcbSchedEnqueue tcb_ptr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
-  unfolding tcbSchedEnqueue_def
-  apply (wp setQueue_no_orphans_enq threadSet_no_orphans | clarsimp simp: unless_def)+
-   apply (wp getObject_tcb_wp | clarsimp simp: threadGet_def)+
-  apply (drule obj_at_ko_at')
-  apply auto
+  "tcbSchedEnqueue tcb_ptr \<lbrace>no_orphans\<rbrace>"
+  unfolding tcbSchedEnqueue_def tcbQueuePrepend_def
+  apply (wpsimp wp: tcbQueued_update_True_no_orphans threadSet_almost_no_orphans threadGet_wp)
+  apply (fastforce simp: no_orphans_strg_almost)
   done
 
 lemma tcbSchedAppend_no_orphans[wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<rbrace>
-   tcbSchedAppend tcb_ptr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
-  unfolding tcbSchedAppend_def
-  apply (wp setQueue_no_orphans_enq threadSet_no_orphans | clarsimp simp: unless_def)+
-   apply (wp getObject_tcb_wp | clarsimp simp: threadGet_def)+
-  apply (drule obj_at_ko_at')
-  apply auto
-  done
-
-lemma ko_at_obj_at':
-  "ko_at' ko p s \<and> P ko \<Longrightarrow> obj_at' P p s"
-  unfolding  obj_at'_def
-  apply clarsimp
-  done
-
-lemma queued_in_queue:
-  "\<lbrakk>valid_queues' s; ko_at' tcb tcb_ptr s; tcbQueued tcb\<rbrakk> \<Longrightarrow>
-   \<exists> p. tcb_ptr \<in> set (ksReadyQueues s p)"
-  unfolding valid_queues'_def
-   apply (drule_tac x="tcbDomain tcb" in spec)
-   apply (drule_tac x="tcbPriority tcb" in spec)
-   apply (drule_tac x="tcb_ptr" in spec)
-   apply (drule mp)
-    apply (rule ko_at_obj_at')
-    apply (auto simp: inQ_def)
+  "tcbSchedAppend tcb_ptr \<lbrace>no_orphans\<rbrace>"
+  unfolding tcbSchedAppend_def tcbQueueAppend_def
+  apply (wpsimp wp: tcbQueued_update_True_no_orphans threadSet_almost_no_orphans threadGet_wp)
+  apply (fastforce simp: no_orphans_strg_almost)
   done
 
 lemma tcbSchedEnqueue_almost_no_orphans:
-  "\<lbrace> \<lambda>s. almost_no_orphans tcb_ptr s \<and> valid_queues' s \<rbrace>
+  "\<lbrace>almost_no_orphans tcb_ptr\<rbrace>
    tcbSchedEnqueue tcb_ptr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
-  unfolding tcbSchedEnqueue_def
-  apply simp
-  apply (wp setQueue_almost_no_orphans_enq[where tcb_ptr=tcb_ptr] threadSet_no_orphans
-            | clarsimp)+
-   apply (wp getObject_tcb_wp | clarsimp simp: threadGet_def)+
-  apply normalise_obj_at'
-  apply (rule_tac x=ko in exI)
-  apply (clarsimp simp: subset_insertI)
-  apply (unfold no_orphans_def almost_no_orphans_def)
-  apply clarsimp
-  apply (drule(2) queued_in_queue)
-  apply (fastforce simp: all_queued_tcb_ptrs_def)
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
+  unfolding tcbSchedEnqueue_def tcbQueuePrepend_def
+  apply (wpsimp wp: tcbQueued_update_True_no_orphans threadSet_almost_no_orphans threadGet_wp)
+  apply (fastforce simp: no_orphans_def almost_no_orphans_def all_queued_tcb_ptrs_def obj_at'_def)
   done
 
 lemma tcbSchedEnqueue_almost_no_orphans_lift:
-  "\<lbrace> \<lambda>s. almost_no_orphans ptr s \<rbrace>
-   tcbSchedEnqueue tcb_ptr
-   \<lbrace> \<lambda>rv s. almost_no_orphans ptr s \<rbrace>"
-  unfolding tcbSchedEnqueue_def
-  apply (wp setQueue_almost_no_orphans_enq_lift threadSet_almost_no_orphans | clarsimp simp: unless_def)+
-   apply (wp getObject_tcb_wp | clarsimp simp: threadGet_def)+
-  apply (drule obj_at_ko_at')
-  apply auto
-  done
+  "tcbSchedEnqueue tcb_ptr \<lbrace>almost_no_orphans ptr\<rbrace>"
+  unfolding tcbSchedEnqueue_def tcbQueuePrepend_def
+  by (wpsimp wp: tcbQueued_update_True_almost_no_orphans threadSet_almost_no_orphans)
 
 lemma ssa_no_orphans:
   "\<lbrace> \<lambda>s. no_orphans s \<and>
@@ -416,124 +428,70 @@ lemma ssa_almost_no_orphans_lift [wp]:
   apply auto
   done
 
-lemma tcbSchedEnqueue_inQueue [wp]:
-  "\<lbrace> \<lambda>s. valid_queues' s \<rbrace>
-   tcbSchedEnqueue tcb_ptr
-   \<lbrace> \<lambda>rv s. tcb_ptr \<in> all_queued_tcb_ptrs s \<rbrace>"
-  unfolding tcbSchedEnqueue_def all_queued_tcb_ptrs_def
-  apply (wp | clarsimp simp: unless_def)+
-   apply (rule_tac Q="\<lambda>rv. \<top>" in hoare_post_imp)
-    apply fastforce
-   apply (wp getObject_tcb_wp | clarsimp simp: threadGet_def)+
-  apply (fastforce simp: obj_at'_def valid_queues'_def inQ_def)
-  done
-
-lemma tcbSchedAppend_inQueue [wp]:
-  "\<lbrace> \<lambda>s. valid_queues' s \<rbrace>
-   tcbSchedAppend tcb_ptr
-   \<lbrace> \<lambda>rv s. tcb_ptr \<in> all_queued_tcb_ptrs s \<rbrace>"
-  unfolding tcbSchedAppend_def all_queued_tcb_ptrs_def
-  apply (wp | clarsimp simp: unless_def)+
-   apply (rule_tac Q="\<lambda>rv. \<top>" in hoare_post_imp)
-    apply fastforce
-   apply (wp getObject_tcb_wp | clarsimp simp: threadGet_def)+
-  apply (fastforce simp: obj_at'_def valid_queues'_def inQ_def)
-  done
-
 lemma rescheduleRequired_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<rbrace>
-   rescheduleRequired
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+  "rescheduleRequired \<lbrace>no_orphans\<rbrace>"
   unfolding rescheduleRequired_def
-  apply (wp tcbSchedEnqueue_no_orphans hoare_vcg_all_lift ssa_no_orphans | wpc | clarsimp)+
-   apply (wps tcbSchedEnqueue_nosch, wp hoare_weak_lift_imp)
-   apply (rename_tac word t p)
-   apply (rule_tac P="word = t" in hoare_gen_asm)
-   apply (wp hoare_disjI1 | clarsimp)+
-  done
+  by (wpsimp wp: ssa_no_orphans hoare_vcg_all_lift hoare_vcg_imp_lift' hoare_vcg_disj_lift | wpc)+
 
 lemma rescheduleRequired_almost_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. almost_no_orphans tcb_ptr s \<and> valid_queues' s \<rbrace>
-   rescheduleRequired
-   \<lbrace> \<lambda>rv s. almost_no_orphans tcb_ptr s \<rbrace>"
+  "rescheduleRequired \<lbrace>almost_no_orphans tcb_ptr\<rbrace>"
   unfolding rescheduleRequired_def
-  apply (wp tcbSchedEnqueue_almost_no_orphans_lift hoare_vcg_all_lift | wpc | clarsimp)+
-   apply (wps tcbSchedEnqueue_nosch, wp hoare_weak_lift_imp)
-   apply (rename_tac word t p)
-   apply (rule_tac P="word = t" in hoare_gen_asm)
-   apply (wp hoare_disjI1 | clarsimp)+
-  done
+  by (wpsimp wp: ssa_almost_no_orphans_lift hoare_vcg_all_lift tcbSchedEnqueue_almost_no_orphans_lift
+                 hoare_vcg_imp_lift' hoare_vcg_disj_lift)
 
 lemma setThreadState_current_no_orphans:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> ksCurThread s = tcb_ptr \<and> valid_queues' s \<rbrace>
+  "\<lbrace>\<lambda>s. no_orphans s \<and> ksCurThread s = tcb_ptr\<rbrace>
    setThreadState state tcb_ptr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding setThreadState_def
-  apply (wp | clarsimp)+
-  apply (rule_tac Q="\<lambda>rv s. valid_queues' s \<and> no_orphans s" in hoare_post_imp)
-   apply clarsimp
-  apply (wp threadSet_valid_queues')
-   apply (unfold no_orphans_disj all_queued_tcb_ptrs_def)
-   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_pred_tcb_at_state)
-   apply (auto simp: inQ_def)
+  apply wpsimp
+  unfolding no_orphans_disj
+   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_pred_tcb_at_state
+             threadSet_all_queued_tcb_ptrs
+          | fastforce)+
   done
 
 lemma setThreadState_isRestart_no_orphans:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> st_tcb_at' isRestart tcb_ptr s \<and> valid_queues' s\<rbrace>
+  "\<lbrace>no_orphans and st_tcb_at' isRestart tcb_ptr\<rbrace>
    setThreadState state tcb_ptr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_ . no_orphans\<rbrace>"
   unfolding setThreadState_def
-  apply (wp | clarsimp)+
-  apply (rule_tac Q="\<lambda>rv s. valid_queues' s \<and> no_orphans s" in hoare_post_imp)
-   apply clarsimp
-  apply (wp threadSet_valid_queues')
-   apply (unfold no_orphans_disj all_queued_tcb_ptrs_def is_active_thread_state_def)
-   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_pred_tcb_at_state)
-   apply (auto simp: st_tcb_at_double_neg' st_tcb_at_neg' inQ_def)
+  apply wpsimp
+   unfolding no_orphans_disj
+   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_pred_tcb_at_state
+             threadSet_all_queued_tcb_ptrs
+          | fastforce)+
+  apply (auto simp: is_active_thread_state_def st_tcb_at_double_neg' st_tcb_at_neg')
   done
 
 lemma setThreadState_almost_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s\<rbrace>
-   setThreadState state tcb_ptr
-   \<lbrace> \<lambda>rv s. almost_no_orphans tcb_ptr s \<rbrace>"
+  "\<lbrace>no_orphans\<rbrace> setThreadState state tcb_ptr \<lbrace>\<lambda>_. almost_no_orphans tcb_ptr\<rbrace>"
   unfolding setThreadState_def
-  apply (wp | clarsimp)+
-  apply (rule_tac Q="\<lambda>rv s. valid_queues' s \<and> almost_no_orphans tcb_ptr s" in hoare_post_imp)
-   apply clarsimp
-  apply (wp threadSet_valid_queues')
-   apply (unfold no_orphans_disj almost_no_orphans_disj all_queued_tcb_ptrs_def)
-   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_pred_tcb_at_state)
-   apply (auto simp: inQ_def)
+  apply wpsimp
+   apply (unfold no_orphans_disj almost_no_orphans_disj)
+   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_pred_tcb_at_state
+             threadSet_all_queued_tcb_ptrs
+          | fastforce)+
   done
 
 lemma setThreadState_not_active_no_orphans:
-  "\<not> is_active_thread_state state \<Longrightarrow>
-   \<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<rbrace>
-   setThreadState state tcb_ptr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+  "\<not> is_active_thread_state state \<Longrightarrow> setThreadState state tcb_ptr \<lbrace>no_orphans\<rbrace>"
   unfolding setThreadState_def
-  apply (wp | clarsimp)+
-  apply (rule_tac Q="\<lambda>rv s. valid_queues' s \<and> no_orphans s" in hoare_post_imp)
-   apply clarsimp
-  apply (wp threadSet_valid_queues')
-   apply (unfold no_orphans_disj all_queued_tcb_ptrs_def is_active_thread_state_def)
-   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_pred_tcb_at_state)
-   apply (auto simp: isRunning_def isRestart_def inQ_def)
+  apply wpsimp
+   apply (unfold no_orphans_disj)
+   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_pred_tcb_at_state
+             threadSet_all_queued_tcb_ptrs
+          | fastforce)+
   done
 
 lemma setThreadState_not_active_almost_no_orphans:
-  "\<not> is_active_thread_state state \<Longrightarrow>
-   \<lbrace> \<lambda>s. almost_no_orphans thread s \<and> valid_queues' s \<rbrace>
-   setThreadState state tcb_ptr
-   \<lbrace> \<lambda>rv s. almost_no_orphans thread s \<rbrace>"
+  "\<not> is_active_thread_state state \<Longrightarrow> setThreadState state tcb_ptr \<lbrace>almost_no_orphans thread\<rbrace>"
   unfolding setThreadState_def
-  apply (wp | clarsimp)+
-  apply (rule_tac Q="\<lambda>rv s. valid_queues' s \<and> almost_no_orphans thread s" in hoare_post_imp)
-   apply clarsimp
-  apply (wp threadSet_valid_queues')
-   apply (unfold almost_no_orphans_disj all_queued_tcb_ptrs_def is_active_thread_state_def)
-   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_pred_tcb_at_state)
-   apply (auto simp: isRunning_def isRestart_def inQ_def)
+  apply wpsimp
+   apply (unfold almost_no_orphans_disj)
+   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_pred_tcb_at_state
+             threadSet_all_queued_tcb_ptrs
+          | fastforce)+
   done
 
 lemma activateThread_no_orphans [wp]:
@@ -545,60 +503,75 @@ lemma activateThread_no_orphans [wp]:
   apply (auto simp: ct_in_state'_def pred_tcb_at'_def obj_at'_def isRestart_def)
   done
 
-lemma setQueue_no_orphans_deq:
-  "\<lbrace> \<lambda>s. \<exists> tcb_ptr. no_orphans s \<and> \<not> is_active_tcb_ptr tcb_ptr s \<and>
-        queue = [x\<leftarrow>((ksReadyQueues s) (d, priority)). x \<noteq> tcb_ptr] \<rbrace>
-   setQueue d priority queue
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
-  unfolding setQueue_def
-  apply (wp | clarsimp)+
-  apply (fastforce simp: no_orphans_def all_queued_tcb_ptrs_def
-                        all_active_tcb_ptrs_def is_active_tcb_ptr_def)
+crunches removeFromBitmap, tcbQueueRemove, setQueue
+  for almost_no_orphans[wp]: "almost_no_orphans thread"
+  and no_orphans[wp]: no_orphans
+  and all_queued_tcb_ptrs[wp]: "\<lambda>s. tcb_ptr \<in> all_queued_tcb_ptrs s"
+  (wp: crunch_wps)
+
+lemma tcbQueued_update_False_all_queued_tcb_ptrs:
+  "\<lbrace>\<lambda>s. tcb_ptr \<noteq> tcb_ptr' \<and> tcb_ptr' \<in> all_queued_tcb_ptrs s\<rbrace>
+   threadSet (tcbQueued_update (\<lambda>_. False)) tcb_ptr
+   \<lbrace>\<lambda>_ s. tcb_ptr' \<in> all_queued_tcb_ptrs s\<rbrace>"
+  apply (wpsimp wp: threadSet_wp)
+  apply (clarsimp simp: all_queued_tcb_ptrs_def obj_at'_def ps_clear_upd)
   done
 
-lemma setQueue_almost_no_orphans_deq [wp]:
-  "\<lbrace> \<lambda>s. almost_no_orphans tcb_ptr s \<and>
-        queue = [x\<leftarrow>((ksReadyQueues s) (d, priority)). x \<noteq> tcb_ptr] \<rbrace>
-   setQueue d priority queue
-   \<lbrace> \<lambda>rv s. almost_no_orphans tcb_ptr s \<rbrace>"
-  unfolding setQueue_def
-  apply (wp | clarsimp)+
-  apply (fastforce simp: almost_no_orphans_def all_queued_tcb_ptrs_def
-                        all_active_tcb_ptrs_def is_active_tcb_ptr_def)
+lemma tcbSchedDequeue_all_queued_tcb_ptrs_other:
+  "\<lbrace>\<lambda>s. tcb_ptr \<noteq> tcb_ptr' \<and> tcb_ptr' \<in> all_queued_tcb_ptrs s\<rbrace>
+   tcbSchedDequeue tcb_ptr
+   \<lbrace>\<lambda>_ s. tcb_ptr' \<in> all_queued_tcb_ptrs s\<rbrace>"
+  unfolding tcbSchedDequeue_def
+  by (wpsimp wp: tcbQueued_update_False_all_queued_tcb_ptrs threadGet_wp)
+
+lemma tcbQueued_update_False_almost_no_orphans:
+  "\<lbrace>no_orphans\<rbrace>
+   threadSet (tcbQueued_update (\<lambda>_. False)) tptr
+   \<lbrace>\<lambda>_. almost_no_orphans tptr\<rbrace>"
+  apply (wpsimp wp: threadSet_wp)
+  apply (clarsimp simp: no_orphans_def almost_no_orphans_def)
+  apply (rename_tac tcb_ptr)
+  apply (case_tac "tcb_ptr = tptr")
+   apply fastforce
+  apply (fastforce simp: all_queued_tcb_ptrs_def obj_at'_def all_active_tcb_ptrs_def
+                         is_active_tcb_ptr_def st_tcb_at'_def ps_clear_upd)
   done
 
 lemma tcbSchedDequeue_almost_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<rbrace>
-   tcbSchedDequeue thread
-   \<lbrace> \<lambda>rv s. almost_no_orphans thread s \<rbrace>"
+  "\<lbrace>no_orphans\<rbrace> tcbSchedDequeue thread \<lbrace>\<lambda>_. almost_no_orphans thread\<rbrace>"
   unfolding tcbSchedDequeue_def
-  apply (wp threadSet_almost_no_orphans | simp cong: if_cong)+
-  apply (simp add:no_orphans_strg_almost cong: if_cong)
+  apply (wpsimp wp: tcbQueued_update_False_almost_no_orphans threadGet_wp)
+  apply (simp add: no_orphans_strg_almost)
   done
 
-lemma tcbSchedDequeue_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> \<not> is_active_tcb_ptr tcb_ptr s \<rbrace>
-   tcbSchedDequeue tcb_ptr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
-  unfolding tcbSchedDequeue_def
-  apply (wp setQueue_no_orphans_deq threadSet_no_orphans | clarsimp)+
-   apply (wp getObject_tcb_wp | clarsimp simp: threadGet_def)+
-  apply (drule obj_at_ko_at')
-  apply auto
+lemma tcbSchedDequeue_no_orphans[wp]:
+  "\<lbrace>\<lambda>s. no_orphans s \<and> \<not> is_active_tcb_ptr tcbPtr s \<and> tcb_at' tcbPtr s\<rbrace>
+   tcbSchedDequeue tcbPtr
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
+  supply disj_not1[simp del]
+  unfolding no_orphans_disj almost_no_orphans_disj
+  apply (rule hoare_allI)
+  apply (rename_tac tcb_ptr)
+  apply (case_tac "tcb_ptr = tcbPtr")
+   apply (rule_tac Q="\<lambda>_ s. st_tcb_at' (\<lambda>state. \<not> is_active_thread_state state) tcbPtr s"
+                in hoare_post_imp)
+    apply fastforce
+   apply wpsimp
+   apply (clarsimp simp: st_tcb_at'_def obj_at'_def is_active_tcb_ptr_def disj_not1)
+  apply (wpsimp wp: tcbQueued_update_False_all_queued_tcb_ptrs hoare_vcg_disj_lift
+              simp: tcbSchedDequeue_def)
   done
 
 lemma switchToIdleThread_no_orphans' [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and>
-          (is_active_tcb_ptr (ksCurThread s) s
-             \<longrightarrow> ksCurThread s \<in> all_queued_tcb_ptrs s) \<rbrace>
+  "\<lbrace>\<lambda>s. no_orphans s
+        \<and> (is_active_tcb_ptr (ksCurThread s) s \<longrightarrow> ksCurThread s \<in> all_queued_tcb_ptrs s)\<rbrace>
    switchToIdleThread
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
-  unfolding switchToIdleThread_def setCurThread_def AARCH64_H.switchToIdleThread_def
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
+  apply (clarsimp simp: switchToIdleThread_def setCurThread_def AARCH64_H.switchToIdleThread_def)
   apply (simp add: no_orphans_disj all_queued_tcb_ptrs_def)
-  apply (wp hoare_vcg_all_lift hoare_vcg_imp_lift hoare_vcg_disj_lift
-       | clarsimp)+
-  apply (auto simp: no_orphans_disj all_queued_tcb_ptrs_def is_active_tcb_ptr_def
-                    st_tcb_at_neg' tcb_at_typ_at')
+  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift
+                    hoare_drop_imp[where R="\<lambda>_. idleThreadNotQueued"] hoare_vcg_imp_lift')
+  apply (force simp: is_active_tcb_ptr_def st_tcb_at_neg' typ_at_tcb')
   done
 
 crunches getVMID, Arch.switchToThread
@@ -610,14 +583,33 @@ crunches updateASIDPoolEntry, Arch.switchToThread
   for no_orphans[wp]: "no_orphans"
   (wp: no_orphans_lift crunch_wps)
 
-lemma ArchThreadDecls_H_switchToThread_all_queued_tcb_ptrs [wp]:
-  "\<lbrace> \<lambda>s. P (all_queued_tcb_ptrs s) \<rbrace>
-   Arch.switchToThread tcb_ptr
-   \<lbrace> \<lambda>rv s. P (all_queued_tcb_ptrs s) \<rbrace>"
-  unfolding AARCH64_H.switchToThread_def all_queued_tcb_ptrs_def
-  apply (wp | clarsimp)+
+lemma all_queued_tcb_ptrs_machine_state[simp]:
+  "all_queued_tcb_ptrs (s\<lparr>ksMachineState := m\<rparr>) = all_queued_tcb_ptrs s"
+  by (simp add: all_queued_tcb_ptrs_def)
+
+lemma all_queued_tcb_ptrs_arch_state[simp]:
+  "all_queued_tcb_ptrs (s\<lparr>ksArchState := as\<rparr>) = all_queued_tcb_ptrs s"
+  by (simp add: all_queued_tcb_ptrs_def)
+
+lemma setObject_vcpu_all_queued_tcb_ptrs[wp]:
+  "setObject ptr (vcpu::vcpu) \<lbrace>\<lambda>s. P (t \<in> all_queued_tcb_ptrs s)\<rbrace>"
+  apply (simp add: all_queued_tcb_ptrs_def)
+  apply (rule setObject_vcpu_obj_at'_no_vcpu)
+  done
+
+lemma setASID_all_queued_tcb_ptrs[wp]:
+  "setObject ptr (ap::asidpool) \<lbrace>\<lambda>s. P (t \<in> all_queued_tcb_ptrs s)\<rbrace>"
+  apply (simp add: all_queued_tcb_ptrs_def obj_at'_real_def)
+  apply (wpsimp wp: setObject_ko_wp_at simp: objBits_simps)
+    apply (simp add: pageBits_def)
+   apply simp
+  apply (clarsimp simp: obj_at'_def ko_wp_at'_def)
   done
 
+crunches Arch.switchToThread
+  for all_queued_tcb_ptrs[wp]: "\<lambda>s. P (t \<in> all_queued_tcb_ptrs s)"
+  (wp: getASID_wp crunch_wps simp: crunch_simps)
+
 crunch ksSchedulerAction [wp]: "Arch.switchToThread" "\<lambda>s. P (ksSchedulerAction s)"
 
 lemma setCurThread_no_orphans [wp]:
@@ -632,22 +624,6 @@ lemma setCurThread_no_orphans [wp]:
   apply auto
   done
 
-lemma tcbSchedDequeue_all_queued_tcb_ptrs:
-  "\<lbrace>\<lambda>s. x \<in> all_queued_tcb_ptrs s \<and> x \<noteq> t \<rbrace>
-   tcbSchedDequeue t \<lbrace>\<lambda>_ s. x \<in> all_queued_tcb_ptrs s\<rbrace>"
-  apply (rule_tac Q="(\<lambda>s. x \<in> all_queued_tcb_ptrs s) and K (x \<noteq> t)"
-           in hoare_pre_imp, clarsimp)
-  apply (rule hoare_gen_asm)
-  apply (clarsimp simp: tcbSchedDequeue_def all_queued_tcb_ptrs_def)
-  apply (rule hoare_pre)
-   apply (wp, clarsimp)
-       apply (wp hoare_vcg_ex_lift)+
-     apply (rename_tac d p)
-     apply (rule_tac Q="\<lambda>_ s. x \<in> set (ksReadyQueues s (d, p))"
-                     in hoare_post_imp, clarsimp)
-     apply (wp hoare_vcg_all_lift | simp)+
-  done
-
 lemma tcbSchedDequeue_all_active_tcb_ptrs[wp]:
   "\<lbrace>\<lambda>s. P (t' \<in> all_active_tcb_ptrs s)\<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>_ s. P (t' \<in> all_active_tcb_ptrs s)\<rbrace>"
   by (clarsimp simp: all_active_tcb_ptrs_def is_active_tcb_ptr_def) wp
@@ -670,9 +646,6 @@ lemma setCurThread_almost_no_orphans:
 lemmas ArchThreadDecls_H_switchToThread_all_active_tcb_ptrs[wp] =
   st_tcb_at'_all_active_tcb_ptrs_lift [OF Arch_switchToThread_pred_tcb']
 
-lemmas ArchThreadDecls_H_switchToThread_all_queued_tcb_ptrs_lift[wp] =
-  ksQ_all_queued_tcb_ptrs_lift [OF ArchThreadDecls_H_AARCH64_H_switchToThread_ksQ]
-
 lemma ThreadDecls_H_switchToThread_no_orphans:
   "\<lbrace> \<lambda>s. no_orphans s \<and>
          st_tcb_at' runnable' tcb_ptr s \<and>
@@ -681,16 +654,9 @@ lemma ThreadDecls_H_switchToThread_no_orphans:
    ThreadDecls_H.switchToThread tcb_ptr
    \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
   unfolding Thread_H.switchToThread_def
-  apply (wp setCurThread_almost_no_orphans
-            tcbSchedDequeue_almost_no_orphans)
-    apply (wps tcbSchedDequeue_ct')
-    apply (wp tcbSchedDequeue_all_queued_tcb_ptrs hoare_convert_imp)+
-    apply (wps)
-    apply (wp)+
-   apply (wps)
-   apply (wp)
-  apply (clarsimp)
-  done
+  by (wpsimp wp: setCurThread_almost_no_orphans hoare_vcg_imp_lift'
+                 tcbSchedDequeue_all_queued_tcb_ptrs_other
+      | wps)+
 
 lemma findM_failure':
   "\<lbrakk> \<And>x S. \<lbrace> \<lambda>s. P S s \<rbrace> f x \<lbrace> \<lambda>rv s. \<not> rv \<longrightarrow> P (insert x S) s \<rbrace> \<rbrakk> \<Longrightarrow>
@@ -708,22 +674,6 @@ lemma findM_failure':
 
 lemmas findM_failure = findM_failure'[where S="{}", simplified]
 
-lemma tcbSchedEnqueue_inQueue_eq:
-  "\<lbrace> valid_queues' and K (tcb_ptr = tcb_ptr') \<rbrace>
-   tcbSchedEnqueue tcb_ptr
-   \<lbrace> \<lambda>rv s. tcb_ptr' \<in> all_queued_tcb_ptrs s \<rbrace>"
-  apply (rule hoare_gen_asm, simp)
-  apply wp
-  done
-
-lemma tcbSchedAppend_inQueue_eq:
-  "\<lbrace> valid_queues' and K (tcb_ptr = tcb_ptr') \<rbrace>
-   tcbSchedAppend tcb_ptr
-   \<lbrace> \<lambda>rv s. tcb_ptr' \<in> all_queued_tcb_ptrs s \<rbrace>"
-  apply (rule hoare_gen_asm, simp)
-  apply wp
-  done
-
 lemma findM_on_success:
   "\<lbrakk> \<And>x. \<lbrace> P x \<rbrace> f x \<lbrace> \<lambda>rv s. rv \<rbrace>; \<And>x y. \<lbrace> P x \<rbrace> f y \<lbrace> \<lambda>rv. P x \<rbrace> \<rbrakk> \<Longrightarrow>
    \<lbrace> \<lambda>s. \<exists>x \<in> set xs. P x s \<rbrace> findM f xs \<lbrace> \<lambda>rv s. \<exists> y. rv = Some y \<rbrace>"
@@ -735,66 +685,32 @@ lemma findM_on_success:
 
 crunch st_tcb' [wp]: switchToThread "\<lambda>s. P' (st_tcb_at' P t s)"
 
-lemma setQueue_deq_not_empty:
-  "\<lbrace> \<lambda>s. (\<exists>tcb. tcb \<in> set (ksReadyQueues s p) \<and> st_tcb_at' P tcb s) \<and>
-         (\<exists>tcb_ptr. \<not> st_tcb_at' P tcb_ptr s \<and>
-                    queue = [x\<leftarrow>((ksReadyQueues s) (d, priority)). x \<noteq> tcb_ptr]) \<rbrace>
-   setQueue d priority queue
-   \<lbrace> \<lambda>rv s. \<exists>tcb. tcb \<in> set (ksReadyQueues s p) \<and> st_tcb_at' P tcb s \<rbrace>"
-  unfolding setQueue_def
-  apply wp
-  apply auto
-  done
-
-lemma tcbSchedDequeue_not_empty:
-  "\<lbrace> \<lambda>s. (\<exists>tcb. tcb \<in> set (ksReadyQueues s p) \<and> st_tcb_at' P tcb s) \<and> \<not> st_tcb_at' P thread s \<rbrace>
-   tcbSchedDequeue thread
-   \<lbrace> \<lambda>rv s. \<exists>tcb. tcb \<in> set (ksReadyQueues s p) \<and> st_tcb_at' P tcb s \<rbrace>"
-  unfolding tcbSchedDequeue_def
-  apply wp
-         apply (wp hoare_vcg_ex_lift threadSet_pred_tcb_no_state)
-         apply clarsimp
-        apply (wp setQueue_deq_not_empty)
-       apply clarsimp
-       apply (rule hoare_pre_post, assumption)
-       apply (clarsimp simp: bitmap_fun_defs)
-       apply wp
-       apply clarsimp
-      apply clarsimp
-      apply (wp setQueue_deq_not_empty)+
-   apply (rule_tac Q="\<lambda>rv s. \<not> st_tcb_at' P thread s" in hoare_post_imp)
-    apply fastforce
-   apply (wp weak_if_wp | clarsimp)+
-  done
-
 lemmas switchToThread_all_active_tcb_ptrs[wp] =
   st_tcb_at'_all_active_tcb_ptrs_lift [OF switchToThread_st_tcb']
 
 (* ksSchedulerAction s = ChooseNewThread *)
 lemma chooseThread_no_orphans [wp]:
-  notes hoare_TrueI[simp]
-  shows
-  "\<lbrace>\<lambda>s. no_orphans s \<and> all_invs_but_ct_idle_or_in_cur_domain' s \<and>
-          (is_active_tcb_ptr (ksCurThread s) s
-             \<longrightarrow> ksCurThread s \<in> all_queued_tcb_ptrs s)\<rbrace>
+  "\<lbrace>\<lambda>s. no_orphans s \<and> all_invs_but_ct_idle_or_in_cur_domain' s
+        \<and> (is_active_tcb_ptr (ksCurThread s) s \<longrightarrow> ksCurThread s \<in> all_queued_tcb_ptrs s)\<rbrace>
    chooseThread
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   (is "\<lbrace>?PRE\<rbrace> _ \<lbrace>_\<rbrace>")
   unfolding chooseThread_def Let_def
   supply if_split[split del]
   apply (simp only: return_bind, simp)
-  apply (rule hoare_seq_ext[where B="\<lambda>rv s. ?PRE s \<and> rv = ksCurDomain s"])
-   apply (rule_tac B="\<lambda>rv s. ?PRE s \<and> curdom = ksCurDomain s \<and>
-    rv = ksReadyQueuesL1Bitmap s curdom" in hoare_seq_ext)
+  apply (intro hoare_seq_ext[OF _ stateAssert_sp])
+  apply (rule hoare_seq_ext[where B="\<lambda>rv s. ?PRE s \<and> ksReadyQueues_asrt s \<and> ready_qs_runnable s
+                                            \<and> rv = ksCurDomain s"])
+   apply (rule_tac B="\<lambda>rv s. ?PRE s \<and> ksReadyQueues_asrt s \<and> ready_qs_runnable s
+                             \<and> curdom = ksCurDomain s \<and> rv = ksReadyQueuesL1Bitmap s curdom"
+                in hoare_seq_ext)
     apply (rename_tac l1)
     apply (case_tac "l1 = 0")
      (* switch to idle thread *)
      apply (simp, wp, simp)
     (* we have a thread to switch to *)
-    apply (clarsimp simp: bitmap_fun_defs)
     apply (wp assert_inv ThreadDecls_H_switchToThread_no_orphans)
-    apply (clarsimp simp: all_invs_but_ct_idle_or_in_cur_domain'_def valid_state'_def
-                          valid_queues_def st_tcb_at'_def)
+    apply (clarsimp simp: all_invs_but_ct_idle_or_in_cur_domain'_def st_tcb_at'_def)
     apply (fastforce dest!: lookupBitmapPriority_obj_at' elim: obj_at'_weaken
                      simp: all_active_tcb_ptrs_def)
    apply (wpsimp simp: bitmap_fun_defs)
@@ -802,42 +718,6 @@ lemma chooseThread_no_orphans [wp]:
     apply (wpsimp simp: curDomain_def simp: invs_no_cicd_ksCurDomain_maxDomain')+
   done
 
-lemma valid_queues'_ko_atD:
-  "valid_queues' s \<Longrightarrow> ko_at' tcb t s \<Longrightarrow> tcbQueued tcb
-    \<Longrightarrow> t \<in> set (ksReadyQueues s (tcbDomain tcb, tcbPriority tcb))"
-  apply (simp add: valid_queues'_def)
-  apply (elim allE, erule mp)
-  apply normalise_obj_at'
-  apply (simp add: inQ_def)
-  done
-
-lemma tcbSchedAppend_in_ksQ:
-  "\<lbrace>valid_queues' and tcb_at' t\<rbrace> tcbSchedAppend t
-   \<lbrace>\<lambda>r s. \<exists>domain priority. t \<in> set (ksReadyQueues s (domain, priority))\<rbrace>"
-  apply (rule_tac Q="\<lambda>s. \<exists>d p. valid_queues' s \<and>
-                             obj_at' (\<lambda>tcb. tcbPriority tcb = p) t s \<and>
-                             obj_at' (\<lambda>tcb. tcbDomain tcb = d) t s"
-           in hoare_pre_imp)
-   apply (clarsimp simp: tcb_at'_has_tcbPriority tcb_at'_has_tcbDomain)
-  apply (rule hoare_vcg_ex_lift)+
-  apply (simp add: tcbSchedAppend_def unless_def)
-  apply wpsimp
-     apply (rule_tac Q="\<lambda>rv s. tdom = d \<and> rv = p \<and> obj_at' (\<lambda>tcb. tcbPriority tcb = p) t s
-                            \<and> obj_at' (\<lambda>tcb. tcbDomain tcb = d) t s"
-             in hoare_post_imp, clarsimp)
-     apply (wp, (wp threadGet_const)+)
-   apply (rule_tac Q="\<lambda>rv s.
-             obj_at' (\<lambda>tcb. tcbPriority tcb = p) t s \<and>
-             obj_at' (\<lambda>tcb. tcbDomain tcb = d) t s \<and>
-             obj_at' (\<lambda>tcb. tcbQueued tcb = rv) t s \<and>
-             (rv \<longrightarrow> t \<in> set (ksReadyQueues s (d, p)))" in hoare_post_imp)
-   apply (clarsimp simp: o_def elim!: obj_at'_weakenE)
-   apply (wp threadGet_obj_at' hoare_vcg_imp_lift threadGet_const)
-  apply clarsimp
-  apply normalise_obj_at'
-  apply (drule(1) valid_queues'_ko_atD, simp+)
-  done
-
 lemma hoare_neg_imps:
   "\<lbrace>P\<rbrace> f \<lbrace>\<lambda> rv s. \<not> R rv s\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>r s. R r s \<longrightarrow> Q r s\<rbrace>"
   by (auto simp: valid_def)
@@ -861,7 +741,7 @@ lemma ThreadDecls_H_switchToThread_ct [wp]:
 crunch no_orphans [wp]: nextDomain no_orphans
 (wp: no_orphans_lift simp: Let_def)
 
-crunch ksQ [wp]: nextDomain "\<lambda>s. P (ksReadyQueues s p)"
+crunch tcbQueued[wp]: nextDomain "\<lambda>s. Q (obj_at' (\<lambda>tcb. P (tcbQueued tcb)) tcb_ptr s)"
 (simp: Let_def)
 
 crunch st_tcb_at' [wp]: nextDomain "\<lambda>s. P (st_tcb_at' P' p s)"
@@ -873,41 +753,6 @@ crunch ct' [wp]: nextDomain "\<lambda>s. P (ksCurThread s)"
 crunch sch_act_not [wp]: nextDomain "sch_act_not t"
 (simp: Let_def)
 
-lemma tcbSchedEnqueue_in_ksQ:
-  "\<lbrace>valid_queues' and tcb_at' t\<rbrace> tcbSchedEnqueue t
-   \<lbrace>\<lambda>r s. \<exists>domain priority. t \<in> set (ksReadyQueues s (domain, priority))\<rbrace>"
-  apply (rule_tac Q="\<lambda>s. \<exists>d p. valid_queues' s \<and>
-                             obj_at' (\<lambda>tcb. tcbPriority tcb = p) t s \<and>
-                             obj_at' (\<lambda>tcb. tcbDomain tcb = d) t s"
-           in hoare_pre_imp)
-   apply (clarsimp simp: tcb_at'_has_tcbPriority tcb_at'_has_tcbDomain)
-  apply (rule hoare_vcg_ex_lift)+
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply (wpsimp simp: if_apply_def2)
-     apply (rule_tac Q="\<lambda>rv s. tdom = d \<and> rv = p \<and> obj_at' (\<lambda>tcb. tcbPriority tcb = p) t s
-                             \<and> obj_at' (\<lambda>tcb. tcbDomain tcb = d) t s"
-              in hoare_post_imp, clarsimp)
-     apply (wp, (wp threadGet_const)+)
-   apply (rule_tac Q="\<lambda>rv s.
-              obj_at' (\<lambda>tcb. tcbPriority tcb = p) t s \<and>
-              obj_at' (\<lambda>tcb. tcbDomain tcb = d) t s \<and>
-              obj_at' (\<lambda>tcb. tcbQueued tcb = rv) t s \<and>
-              (rv \<longrightarrow> t \<in> set (ksReadyQueues s (d, p)))" in hoare_post_imp)
-    apply (clarsimp simp: o_def elim!: obj_at'_weakenE)
-   apply (wp threadGet_obj_at' hoare_vcg_imp_lift threadGet_const)
-  apply clarsimp
-  apply normalise_obj_at'
-  apply (frule(1) valid_queues'_ko_atD, simp+)
-  done
-
-lemma tcbSchedEnqueue_in_ksQ':
-  "\<lbrace>valid_queues' and tcb_at' t and K (t = t')\<rbrace>
-     tcbSchedEnqueue t'
-   \<lbrace>\<lambda>r s. \<exists>domain priority. t \<in> set (ksReadyQueues s (domain, priority))\<rbrace>"
-  apply (rule hoare_gen_asm)
-  apply (wp tcbSchedEnqueue_in_ksQ | clarsimp)+
-  done
-
 lemma all_invs_but_ct_idle_or_in_cur_domain'_strg:
   "invs' s \<longrightarrow> all_invs_but_ct_idle_or_in_cur_domain' s"
   by (clarsimp simp: invs'_to_invs_no_cicd'_def)
@@ -916,67 +761,6 @@ lemma setSchedulerAction_cnt_sch_act_not[wp]:
   "\<lbrace> \<top> \<rbrace> setSchedulerAction ChooseNewThread \<lbrace>\<lambda>rv s. sch_act_not x s\<rbrace>"
   by (rule hoare_pre, rule hoare_strengthen_post[OF setSchedulerAction_direct]) auto
 
-lemma tcbSchedEnqueue_in_ksQ_aqtp[wp]:
-  "\<lbrace>valid_queues' and tcb_at' t\<rbrace> tcbSchedEnqueue t
-   \<lbrace>\<lambda>r s. t \<in> all_queued_tcb_ptrs s\<rbrace>"
-  apply (clarsimp simp: all_queued_tcb_ptrs_def)
-  apply (rule tcbSchedEnqueue_in_ksQ)
-  done
-
-lemma tcbSchedEnqueue_in_ksQ_already_queued:
-  "\<lbrace>\<lambda>s. valid_queues' s \<and> tcb_at' t s \<and>
-    (\<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority))) \<rbrace>
-   tcbSchedEnqueue t
-   \<lbrace>\<lambda>r s. \<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority))\<rbrace>"
-  apply (case_tac "t'=t", wpsimp wp: tcbSchedEnqueue_in_ksQ)
-  apply (wpsimp simp:  tcbSchedEnqueue_def unless_def)
-     apply (rule_tac Q="\<lambda>_ s. \<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority))"
-              in hoare_post_imp)
-      apply metis
-     apply wpsimp+
-  done
-
-lemma tcbSchedAppend_in_ksQ_already_queued:
-  "\<lbrace>\<lambda>s. valid_queues' s \<and> tcb_at' t s \<and>
-    (\<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority))) \<rbrace>
-   tcbSchedAppend t
-   \<lbrace>\<lambda>r s. \<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority))\<rbrace>"
-  apply (case_tac "t'=t", wpsimp wp: tcbSchedAppend_in_ksQ)
-  apply (wpsimp simp:  tcbSchedAppend_def unless_def)
-     apply (rule_tac Q="\<lambda>_ s. \<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority))"
-              in hoare_post_imp)
-      apply metis
-     apply wpsimp+
-  done
-
-lemma tcbSchedEnqueue_in_ksQ'':
-  "\<lbrace>\<lambda>s. valid_queues' s \<and> tcb_at' t s \<and>
-    (t' \<noteq> t \<longrightarrow> (\<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority)))) \<rbrace>
-   tcbSchedEnqueue t
-   \<lbrace>\<lambda>r s. \<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority))\<rbrace>"
-  apply (case_tac "t'=t", wpsimp wp: tcbSchedEnqueue_in_ksQ)
-  apply clarsimp
-  apply (wpsimp simp:  tcbSchedEnqueue_def unless_def)
-     apply (rule_tac Q="\<lambda>_ s. \<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority))"
-              in hoare_post_imp)
-      apply metis
-     apply wpsimp+
-  done
-
-lemma tcbSchedAppend_in_ksQ'':
-  "\<lbrace>\<lambda>s. valid_queues' s \<and> tcb_at' t s \<and>
-    (t' \<noteq> t \<longrightarrow> (\<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority)))) \<rbrace>
-   tcbSchedAppend t
-   \<lbrace>\<lambda>r s. \<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority))\<rbrace>"
-  apply (case_tac "t'=t", wpsimp wp: tcbSchedAppend_in_ksQ)
-  apply clarsimp
-  apply (wpsimp simp:  tcbSchedAppend_def unless_def)
-     apply (rule_tac Q="\<lambda>_ s. \<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority))"
-              in hoare_post_imp)
-      apply metis
-     apply wpsimp+
-  done
-
 crunches setSchedulerAction
   for pred_tcb_at': "\<lambda>s. P (pred_tcb_at' proj Q t s)"
   and ct': "\<lambda>s. P (ksCurThread s)"
@@ -995,12 +779,6 @@ lemma ct_active_st_tcb_at':
   apply (case_tac st, auto)
   done
 
-lemma tcbSchedEnqueue_in_ksQ_already_queued_aqtp:
-  "\<lbrace>\<lambda>s. valid_queues' s \<and> tcb_at' t s \<and>
-    t' \<in> all_queued_tcb_ptrs s \<rbrace> tcbSchedEnqueue t
-   \<lbrace>\<lambda>r s. t' \<in> all_queued_tcb_ptrs s \<rbrace>"
-  by (clarsimp simp: all_queued_tcb_ptrs_def tcbSchedEnqueue_in_ksQ_already_queued)
-
 (* FIXME move *)
 lemma invs_switchToThread_runnable':
   "\<lbrakk> invs' s ; ksSchedulerAction s = SwitchToThread t \<rbrakk> \<Longrightarrow> st_tcb_at' runnable' t s"
@@ -1033,17 +811,16 @@ lemma chooseThread_nosch:
   done
 
 lemma scheduleChooseNewThread_no_orphans:
-  "\<lbrace> invs' and no_orphans
-     and (\<lambda>s. ksSchedulerAction s = ChooseNewThread
-              \<and> (st_tcb_at' runnable' (ksCurThread s) s
-                 \<longrightarrow> (\<exists>d p. ksCurThread s \<in> set (ksReadyQueues s (d, p))))) \<rbrace>
+  "\<lbrace>invs' and no_orphans
+    and (\<lambda>s. ksSchedulerAction s = ChooseNewThread
+             \<and> (st_tcb_at' runnable' (ksCurThread s) s \<longrightarrow> ksCurThread s \<in> all_queued_tcb_ptrs s))\<rbrace>
    scheduleChooseNewThread
-   \<lbrace>\<lambda>_. no_orphans \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding scheduleChooseNewThread_def
      apply (wp add: ssa_no_orphans hoare_vcg_all_lift)
          apply (wp hoare_disjI1 chooseThread_nosch)+
     apply (wp nextDomain_invs_no_cicd' hoare_vcg_imp_lift
-               hoare_lift_Pf2 [OF ksQ_all_queued_tcb_ptrs_lift[OF nextDomain_ksQ]
+               hoare_lift_Pf2 [OF tcbQueued_all_queued_tcb_ptrs_lift[OF nextDomain_tcbQueued]
                                   nextDomain_ct']
                hoare_lift_Pf2 [OF st_tcb_at'_is_active_tcb_ptr_lift[OF nextDomain_st_tcb_at']
                                   nextDomain_ct']
@@ -1052,24 +829,25 @@ lemma scheduleChooseNewThread_no_orphans:
                        is_active_tcb_ptr_runnable')+
   done
 
+lemma setSchedulerAction_tcbQueued[wp]:
+  "setSchedulerAction sa \<lbrace>\<lambda>s. Q (obj_at' (\<lambda>tcb. P (tcbQueued tcb)) tcb_ptr s)\<rbrace>"
+  by wpsimp
+
 lemma schedule_no_orphans[wp]:
   notes ssa_wp[wp del]
   shows
-  "\<lbrace> \<lambda>s. no_orphans s \<and> invs' s \<rbrace>
-   schedule
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+  "\<lbrace>no_orphans and invs'\<rbrace> schedule \<lbrace>\<lambda>_. no_orphans\<rbrace>"
 proof -
 
   have do_switch_to:
     "\<And>candidate.
      \<lbrace>\<lambda>s. no_orphans s \<and> ksSchedulerAction s = SwitchToThread candidate
           \<and> st_tcb_at' runnable' candidate s
-          \<and> (st_tcb_at' runnable' (ksCurThread s) s
-             \<longrightarrow> (\<exists>d p. ksCurThread s \<in> set (ksReadyQueues s (d, p)))) \<rbrace>
-      do ThreadDecls_H.switchToThread candidate;
-         setSchedulerAction ResumeCurrentThread
-      od
-    \<lbrace>\<lambda>rv. no_orphans\<rbrace>"
+          \<and> (st_tcb_at' runnable' (ksCurThread s) s \<longrightarrow> ksCurThread s \<in> all_queued_tcb_ptrs s) \<rbrace>
+     do ThreadDecls_H.switchToThread candidate;
+        setSchedulerAction ResumeCurrentThread
+     od
+     \<lbrace>\<lambda>_. no_orphans\<rbrace>"
     apply (wpsimp wp: scheduleChooseNewThread_no_orphans ssa_no_orphans
                       hoare_vcg_all_lift ThreadDecls_H_switchToThread_no_orphans)+
      apply (rule_tac Q="\<lambda>_ s. (t = candidate \<longrightarrow> ksCurThread s = candidate) \<and>
@@ -1081,56 +859,43 @@ proof -
 
   have abort_switch_to_enq:
     "\<And>candidate.
-     \<lbrace>\<lambda>s. no_orphans s \<and> invs' s \<and> valid_queues' s
+     \<lbrace>\<lambda>s. no_orphans s \<and> invs' s
           \<and> ksSchedulerAction s = SwitchToThread candidate
-          \<and> (st_tcb_at' runnable' (ksCurThread s) s
-               \<longrightarrow> (\<exists>d p. ksCurThread s \<in> set (ksReadyQueues s (d, p)))) \<rbrace>
-       do tcbSchedEnqueue candidate;
-          setSchedulerAction ChooseNewThread;
-          scheduleChooseNewThread
-       od
-     \<lbrace>\<lambda>rv. no_orphans\<rbrace>"
-     apply (rule hoare_pre)
-     apply (wp scheduleChooseNewThread_no_orphans ssa_no_orphans setSchedulerAction_direct)
+          \<and> (st_tcb_at' runnable' (ksCurThread s) s \<longrightarrow> ksCurThread s \<in> all_queued_tcb_ptrs s) \<rbrace>
+     do tcbSchedEnqueue candidate;
+        setSchedulerAction ChooseNewThread;
+        scheduleChooseNewThread
+     od
+     \<lbrace>\<lambda>_. no_orphans\<rbrace>"
+    apply (wpsimp wp: scheduleChooseNewThread_no_orphans ssa_no_orphans setSchedulerAction_direct)
       apply (wpsimp wp: hoare_vcg_imp_lift' hoare_vcg_ex_lift
-                    simp: is_active_tcb_ptr_runnable' all_queued_tcb_ptrs_def
-             | rule hoare_lift_Pf2[where f=ksCurThread, OF setSchedulerAction_ksQ])+
-     apply (wp tcbSchedEnqueue_in_ksQ' tcbSchedEnqueue_no_orphans hoare_vcg_all_lift hoare_vcg_imp_lift' hoare_vcg_disj_lift)
-      apply (wp hoare_lift_Pf2[where f=ksCurThread, OF tcbSchedEnqueue_pred_tcb_at']
-                hoare_lift_Pf2[where f=ksCurThread, OF tcbSchedEnqueue_in_ksQ_already_queued]
-                tcbSchedEnqueue_no_orphans
-             | strengthen not_pred_tcb_at'_strengthen
-             | wp (once) hoare_vcg_imp_lift')+
-    apply (clarsimp)
-    apply (frule invs_sch_act_wf', clarsimp simp: pred_tcb_at')
-    apply (simp add: st_tcb_at_neg' tcb_at_invs')
+                  simp: is_active_tcb_ptr_runnable' all_queued_tcb_ptrs_def
+             | rule hoare_lift_Pf2[where f=ksCurThread, OF setSchedulerAction_tcbQueued])+
+     apply (wp hoare_vcg_all_lift hoare_vcg_imp_lift' hoare_vcg_disj_lift
+            | strengthen not_pred_tcb_at'_strengthen
+            | rule hoare_lift_Pf2[where f=ksCurThread])+
+    apply (simp add: st_tcb_at_neg' tcb_at_invs' all_queued_tcb_ptrs_def)
     done
 
   have abort_switch_to_app:
     "\<And>candidate.
-     \<lbrace>\<lambda>s. no_orphans s \<and> invs' s \<and> valid_queues' s
+     \<lbrace>\<lambda>s. no_orphans s \<and> invs' s
           \<and> ksSchedulerAction s = SwitchToThread candidate
           \<and> (st_tcb_at' runnable' (ksCurThread s) s
-             \<longrightarrow> (\<exists>d p. ksCurThread s \<in> set (ksReadyQueues s (d, p))) ) \<rbrace>
-       do tcbSchedAppend candidate;
-          setSchedulerAction ChooseNewThread;
-          scheduleChooseNewThread
-       od
-     \<lbrace>\<lambda>rv. no_orphans\<rbrace>"
-     apply (rule hoare_pre)
-     apply (wp scheduleChooseNewThread_no_orphans ssa_no_orphans setSchedulerAction_direct)
+             \<longrightarrow> ksCurThread s \<in> all_queued_tcb_ptrs s ) \<rbrace>
+     do tcbSchedAppend candidate;
+        setSchedulerAction ChooseNewThread;
+        scheduleChooseNewThread
+     od
+     \<lbrace>\<lambda>_. no_orphans\<rbrace>"
+    apply (wpsimp wp: scheduleChooseNewThread_no_orphans ssa_no_orphans setSchedulerAction_direct)
       apply (wpsimp wp: hoare_vcg_imp_lift' hoare_vcg_ex_lift
-                    simp: is_active_tcb_ptr_runnable' all_queued_tcb_ptrs_def
-             | rule hoare_lift_Pf2[where f=ksCurThread, OF setSchedulerAction_ksQ])+
-     apply (wp tcbSchedAppend_in_ksQ'' tcbSchedAppend_no_orphans hoare_vcg_all_lift hoare_vcg_imp_lift' hoare_vcg_disj_lift)
-      apply (wp hoare_lift_Pf2[where f=ksCurThread, OF tcbSchedAppend_pred_tcb_at']
-                hoare_lift_Pf2[where f=ksCurThread, OF tcbSchedAppend_in_ksQ_already_queued]
-                tcbSchedAppend_no_orphans
-             | strengthen not_pred_tcb_at'_strengthen
-             | wp (once) hoare_vcg_imp_lift')+
-    apply (clarsimp)
-    apply (frule invs_sch_act_wf', clarsimp simp: pred_tcb_at')
-    apply (simp add: st_tcb_at_neg' tcb_at_invs')
+                  simp: is_active_tcb_ptr_runnable' all_queued_tcb_ptrs_def
+             | rule hoare_lift_Pf2[where f=ksCurThread, OF setSchedulerAction_tcbQueued])+
+     apply (wp hoare_vcg_all_lift hoare_vcg_imp_lift' hoare_vcg_disj_lift
+            | strengthen not_pred_tcb_at'_strengthen
+            | rule hoare_lift_Pf2[where f=ksCurThread])+
+    apply (simp add: st_tcb_at_neg' tcb_at_invs' all_queued_tcb_ptrs_def)
     done
 
   show ?thesis
@@ -1144,24 +909,20 @@ proof -
         apply (wp ssa_no_orphans hoare_vcg_all_lift)
             apply (wp hoare_disjI1 chooseThread_nosch)
            apply (wp nextDomain_invs_no_cicd' hoare_vcg_imp_lift
-                     hoare_lift_Pf2 [OF ksQ_all_queued_tcb_ptrs_lift
-                                        [OF nextDomain_ksQ]
-                                        nextDomain_ct']
+                     hoare_lift_Pf2 [OF tcbQueued_all_queued_tcb_ptrs_lift
+                                      [OF nextDomain_tcbQueued]
+                                      nextDomain_ct']
                      hoare_lift_Pf2 [OF st_tcb_at'_is_active_tcb_ptr_lift
                                       [OF nextDomain_st_tcb_at']
                                       nextDomain_ct']
                      hoare_vcg_all_lift getDomainTime_wp)[2]
-          apply ((wp tcbSchedEnqueue_no_orphans tcbSchedEnqueue_in_ksQ'
-                     hoare_drop_imp
-                | clarsimp simp: all_queued_tcb_ptrs_def
-                | strengthen all_invs_but_ct_idle_or_in_cur_domain'_strg
-                | wps tcbSchedEnqueue_ct')+)[1]
-         apply ((wp tcbSchedEnqueue_no_orphans tcbSchedEnqueue_in_ksQ'
+          apply wpsimp
+         apply ((wp tcbSchedEnqueue_no_orphans tcbSchedEnqueue_all_queued_tcb_ptrs'
                     hoare_drop_imp
-               | clarsimp simp: all_queued_tcb_ptrs_def
-               | strengthen all_invs_but_ct_idle_or_in_cur_domain'_strg
-               | wps tcbSchedEnqueue_ct')+)[1]
-        apply wp[1]
+                 | clarsimp simp: all_queued_tcb_ptrs_def
+                 | strengthen all_invs_but_ct_idle_or_in_cur_domain'_strg
+                 | wps)+)[1]
+        apply wpsimp
        \<comment> \<open>action = SwitchToThread candidate\<close>
        apply (clarsimp)
        apply (rename_tac candidate)
@@ -1170,14 +931,11 @@ proof -
               apply (wp hoare_drop_imps)
              apply (wp add: tcbSchedEnqueue_no_orphans)+
         apply (clarsimp simp: conj_comms cong: conj_cong imp_cong split del: if_split)
-        apply (wp hoare_lift_Pf2[where f=ksCurThread, OF tcbSchedEnqueue_pred_tcb_at']
-                  hoare_lift_Pf2[where f=ksCurThread, OF tcbSchedEnqueue_in_ksQ']
-                  hoare_vcg_imp_lift'
+        apply (wp hoare_vcg_imp_lift'
                | strengthen not_pred_tcb_at'_strengthen)+
-    apply (clarsimp simp: comp_def)
-    apply (frule invs_queues)
-    apply (clarsimp simp: invs_valid_queues' tcb_at_invs' st_tcb_at_neg' is_active_tcb_ptr_runnable')
-    apply (fastforce simp: all_invs_but_ct_idle_or_in_cur_domain'_strg invs_switchToThread_runnable')
+        apply (wps | wpsimp wp: tcbSchedEnqueue_all_queued_tcb_ptrs')+
+    apply (fastforce simp: is_active_tcb_ptr_runnable' all_invs_but_ct_idle_or_in_cur_domain'_strg
+                           invs_switchToThread_runnable')
     done
 qed
 
@@ -1194,36 +952,32 @@ crunch no_orphans [wp]: completeSignal "no_orphans"
   (simp: crunch_simps wp: crunch_wps)
 
 lemma possibleSwitchTo_almost_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. almost_no_orphans target s \<and> valid_queues' s \<and> st_tcb_at' runnable' target s
-         \<and> weak_sch_act_wf (ksSchedulerAction s) s \<rbrace>
+  "\<lbrace>\<lambda>s. almost_no_orphans target s \<and> st_tcb_at' runnable' target s
+        \<and> weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
    possibleSwitchTo target
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding possibleSwitchTo_def
-  by (wpsimp wp: rescheduleRequired_valid_queues'_weak tcbSchedEnqueue_almost_no_orphans
+  by (wpsimp wp: tcbSchedEnqueue_almost_no_orphans
                  ssa_almost_no_orphans hoare_weak_lift_imp
      | wp (once) hoare_drop_imp)+
 
 lemma possibleSwitchTo_almost_no_orphans':
-  "\<lbrace> \<lambda>s. almost_no_orphans target s \<and> valid_queues' s \<and> st_tcb_at' runnable' target s
-         \<and> sch_act_wf (ksSchedulerAction s) s \<rbrace>
+  "\<lbrace>\<lambda>s. almost_no_orphans target s \<and> st_tcb_at' runnable' target s
+        \<and> sch_act_wf (ksSchedulerAction s) s \<rbrace>
    possibleSwitchTo target
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   by wp (strengthen sch_act_wf_weak, assumption)
 
+crunches tcbQueueAppend, tcbQueuePrepend
+  for almost_no_orphans[wp]: "almost_no_orphans tcbPtr"
+
 lemma tcbSchedAppend_almost_no_orphans:
-  "\<lbrace> \<lambda>s. almost_no_orphans thread s \<and> valid_queues' s \<rbrace>
+  "\<lbrace>almost_no_orphans thread\<rbrace>
    tcbSchedAppend thread
-   \<lbrace> \<lambda>_ s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding tcbSchedAppend_def
-  apply (wp setQueue_almost_no_orphans_enq[where tcb_ptr=thread] threadSet_no_orphans
-            | clarsimp simp: unless_def | simp only: subset_insertI)+
-  apply (unfold threadGet_def)
-  apply (wp getObject_tcb_wp | clarsimp)+
-  apply (drule obj_at_ko_at', clarsimp)
-  apply (rule_tac x=ko in exI)
-  apply (clarsimp simp: almost_no_orphans_def no_orphans_def)
-  apply (drule queued_in_queue | simp)+
-  apply (auto simp: all_queued_tcb_ptrs_def)
+  apply (wpsimp wp: tcbQueued_update_True_no_orphans threadGet_wp)
+  apply (fastforce simp: almost_no_orphans_def no_orphans_def all_queued_tcb_ptrs_def obj_at'_def)
   done
 
 lemma no_orphans_is_almost[simp]:
@@ -1232,7 +986,6 @@ lemma no_orphans_is_almost[simp]:
 
 crunches decDomainTime
   for no_orphans[wp]: no_orphans
-  and valid_queues'[wp]:  valid_queues'
   (wp: no_orphans_lift)
 
 lemma timerTick_no_orphans [wp]:
@@ -1242,23 +995,15 @@ lemma timerTick_no_orphans [wp]:
   unfolding timerTick_def getDomainTime_def
   supply if_split[split del]
   apply (subst threadState_case_if)
-  apply (wpsimp wp: threadSet_no_orphans threadSet_valid_queues'
-                    threadSet_valid_queues' tcbSchedAppend_almost_no_orphans threadSet_sch_act
+  apply (wpsimp wp: threadSet_no_orphans tcbSchedAppend_almost_no_orphans
                     threadSet_almost_no_orphans threadSet_no_orphans tcbSchedAppend_sch_act_wf
                     hoare_drop_imp
                 simp: if_apply_def2
          | strengthen sch_act_wf_weak)+
-      apply (rule_tac Q="\<lambda>rv s. no_orphans s \<and> valid_queues' s \<and> tcb_at' thread s
-                                \<and> sch_act_wf  (ksSchedulerAction s) s" in hoare_post_imp)
-       apply (clarsimp simp: inQ_def)
-      apply (wp hoare_drop_imps | clarsimp)+
-  apply (auto split: if_split)
   done
 
 lemma handleDoubleFault_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<rbrace>
-   handleDoubleFault tptr ex1 ex2
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+  "\<lbrace>no_orphans\<rbrace> handleDoubleFault tptr ex1 ex2 \<lbrace>\<lambda>_. no_orphans \<rbrace>"
   unfolding handleDoubleFault_def
   by (wpsimp wp: setThreadState_not_active_no_orphans
              simp: is_active_thread_state_def isRestart_def isRunning_def)
@@ -1271,21 +1016,25 @@ crunches cteInsert, getThreadCallerSlot, getThreadReplySlot
   (wp: crunch_wps)
 
 lemma setupCallerCap_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<rbrace>
-   setupCallerCap sender receiver gr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+  "setupCallerCap sender receiver gr \<lbrace>no_orphans\<rbrace>"
   unfolding setupCallerCap_def
   by (wpsimp wp: setThreadState_not_active_no_orphans hoare_drop_imps
              simp: is_active_thread_state_def isRestart_def isRunning_def)
 
 lemma setupCallerCap_almost_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. almost_no_orphans tcb_ptr s \<and> valid_queues' s \<rbrace>
+  "\<lbrace>almost_no_orphans tcb_ptr\<rbrace>
    setupCallerCap sender receiver gr
-   \<lbrace> \<lambda>rv s. almost_no_orphans tcb_ptr s \<rbrace>"
+   \<lbrace>\<lambda>_. almost_no_orphans tcb_ptr\<rbrace>"
   unfolding setupCallerCap_def
   by (wpsimp wp: setThreadState_not_active_almost_no_orphans hoare_drop_imps
              simp: is_active_thread_state_def isRestart_def isRunning_def)
 
+crunches cteInsert, setExtraBadge, setMessageInfo, transferCaps, copyMRs,
+         doNormalTransfer, doFaultTransfer,
+         invalidateVMIDEntry, invalidateASID, invalidateASIDEntry
+  for tcbQueued[wp]: "obj_at' (\<lambda>tcb. P (tcbQueued tcb)) tcb_ptr"
+  (wp: crunch_wps simp: crunch_simps)
+
 crunches doIPCTransfer, setMRs
   for no_orphans [wp]: "no_orphans"
   (wp: no_orphans_lift)
@@ -1297,64 +1046,35 @@ crunch no_orphans [wp]: setEndpoint "no_orphans"
   (wp: no_orphans_lift)
 
 lemma sendIPC_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s \<rbrace>
+  "\<lbrace>\<lambda>s. no_orphans s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s\<rbrace>
    sendIPC blocking call badge canGrant canGrantReply thread epptr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding sendIPC_def
   apply (wp hoare_drop_imps setThreadState_not_active_no_orphans sts_st_tcb'
             possibleSwitchTo_almost_no_orphans'
          | wpc
          | clarsimp simp: is_active_thread_state_def isRestart_def isRunning_def)+
-
-  apply (rule_tac Q="\<lambda>rv. no_orphans and valid_queues' and valid_objs' and ko_at' rv epptr
-                          and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)" in hoare_post_imp)
-   apply (fastforce simp: valid_objs'_def valid_obj'_def valid_ep'_def obj_at'_def)
-  apply (wp get_ep_sp' | clarsimp)+
+   apply (rule_tac Q="\<lambda>rv. no_orphans and valid_objs' and ko_at' rv epptr
+                           and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)" in hoare_post_imp)
+    apply (fastforce simp: valid_objs'_def valid_obj'_def valid_ep'_def obj_at'_def)
+   apply (wp get_ep_sp' | clarsimp)+
   done
 
 lemma sendFaultIPC_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s \<rbrace>
+  "\<lbrace>\<lambda>s. no_orphans s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s\<rbrace>
    sendFaultIPC tptr fault
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
-  unfolding sendFaultIPC_def
-  apply (wpsimp wp: threadSet_valid_queues' threadSet_no_orphans threadSet_valid_objs'
-                    threadSet_sch_act)
-    apply (rule_tac Q'="\<lambda>handlerCap s. no_orphans s \<and> valid_queues' s
-                                         \<and> valid_objs' s
-                                         \<and> sch_act_wf (ksSchedulerAction s) s"
-                    in hoare_post_imp_R)
-     apply (wpsimp simp: inQ_def valid_tcb'_def tcb_cte_cases_def)+
-  done
-
-lemma sendIPC_valid_queues' [wp]:
-  "\<lbrace> \<lambda>s. valid_queues' s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s \<rbrace>
-   sendIPC blocking call badge canGrant canGrantReply thread epptr
-   \<lbrace> \<lambda>rv s. valid_queues' s \<rbrace>"
-  unfolding sendIPC_def
-  apply (wpsimp wp: hoare_drop_imps)
-        apply (wpsimp | wp (once) sts_st_tcb' hoare_drop_imps)+
-  apply (rule_tac Q="\<lambda>rv. valid_queues' and valid_objs' and ko_at' rv epptr
-                          and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)" in hoare_post_imp)
-   apply (clarsimp)
-  apply (wp get_ep_sp' | clarsimp)+
-  done
-
-lemma sendFaultIPC_valid_queues' [wp]:
-  "\<lbrace> \<lambda>s. valid_queues' s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s \<rbrace>
-   sendFaultIPC tptr fault
-   \<lbrace> \<lambda>rv s. valid_queues' s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding sendFaultIPC_def
-  apply (wpsimp wp: threadSet_valid_queues' threadSet_valid_objs' threadSet_sch_act)
-    apply (rule_tac Q'="\<lambda>handlerCap s. valid_queues' s \<and> valid_objs' s
-                                         \<and> sch_act_wf (ksSchedulerAction s) s"
+  apply (wpsimp wp: threadSet_no_orphans threadSet_valid_objs' threadSet_sch_act)
+    apply (rule_tac Q'="\<lambda>_ s. no_orphans s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s"
                     in hoare_post_imp_R)
-     apply (wpsimp simp: inQ_def valid_tcb'_def tcb_cte_cases_def)+
+     apply wpsimp+
   done
 
-lemma handleFault_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s \<rbrace>
+lemma handleFault_no_orphans[wp]:
+  "\<lbrace>\<lambda>s. no_orphans s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s\<rbrace>
    handleFault tptr ex1
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding handleFault_def
   by wpsimp
 
@@ -1362,27 +1082,22 @@ lemma replyFromKernel_no_orphans [wp]:
   "\<lbrace> \<lambda>s. no_orphans s \<rbrace>
    replyFromKernel thread r
    \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
-  by (cases r, wpsimp simp: replyFromKernel_def)
+  by (wpsimp simp: replyFromKernel_def)
 
 crunch inv [wp]: alignError "P"
 
-lemma createObjects_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> pspace_aligned' s \<and> pspace_no_overlap' ptr sz s \<and> pspace_distinct' s
-      \<and> n \<noteq> 0 \<and> range_cover ptr sz (objBitsKO val + gbits) n
-      \<and> \<not> case_option False (is_active_thread_state \<circ> tcbState) (projectKO_opt val) \<rbrace>
+lemma createObjects_no_orphans[wp]:
+  "\<lbrace>\<lambda>s. no_orphans s \<and> pspace_aligned' s \<and> pspace_no_overlap' ptr sz s \<and> pspace_distinct' s
+        \<and> n \<noteq> 0 \<and> range_cover ptr sz (objBitsKO val + gbits) n
+        \<and> \<not> case_option False (is_active_thread_state \<circ> tcbState) (projectKO_opt val)
+        \<and> \<not> case_option False tcbQueued (projectKO_opt val)\<rbrace>
    createObjects ptr n val gbits
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_ s. no_orphans s\<rbrace>"
   apply (clarsimp simp: no_orphans_def all_active_tcb_ptrs_def
                         is_active_tcb_ptr_def all_queued_tcb_ptrs_def)
   apply (simp only: imp_conv_disj pred_tcb_at'_def createObjects_def)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift createObjects_orig_obj_at2')
-  apply clarsimp
-  apply (erule(1) impE)
-  apply clarsimp
-  apply (drule_tac x = x in spec)
-  apply (erule impE)
-   apply (clarsimp simp: obj_at'_def split: option.splits)
-  apply simp
+  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift createObjects_orig_obj_at2'[where sz=sz])
+  apply (clarsimp split: option.splits)
   done
 
 crunch no_orphans [wp]: insertNewCap "no_orphans"
@@ -1516,11 +1231,9 @@ lemma invokeUntyped_no_orphans [wp]:
   done
 
 lemma setInterruptState_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<rbrace>
-   setInterruptState a
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+  "setInterruptState a \<lbrace>no_orphans\<rbrace>"
   unfolding no_orphans_disj all_queued_tcb_ptrs_def
-  by (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
+  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift)
 
 crunch no_orphans [wp]: emptySlot "no_orphans"
 
@@ -1529,43 +1242,45 @@ lemma mapM_x_match:
   by assumption
 
 lemma cancelAllIPC_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<rbrace>
-    cancelAllIPC epptr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+  "\<lbrace>\<lambda>s. no_orphans s \<and> valid_objs' s \<and> pspace_aligned' s \<and> pspace_distinct' s\<rbrace>
+   cancelAllIPC epptr
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding cancelAllIPC_def
   apply (wp sts_valid_objs' set_ep_valid_objs' sts_st_tcb'
             hoare_vcg_const_Ball_lift tcbSchedEnqueue_almost_no_orphans
              | wpc
              | rule mapM_x_match,
                rename_tac list,
-               rule_tac V="\<lambda>_. valid_queues' and valid_objs'"
+               rule_tac V="\<lambda>_. valid_objs' and pspace_aligned' and pspace_distinct'"
                     and I="no_orphans and (\<lambda>s. \<forall>t\<in>set list. tcb_at' t s)"
                      in mapM_x_inv_wp2
              | clarsimp simp: valid_tcb_state'_def)+
-  apply (rule_tac Q="\<lambda>rv. no_orphans and valid_objs' and valid_queues' and ko_at' rv epptr"
+  apply (rule_tac Q="\<lambda>rv. no_orphans and valid_objs' and pspace_aligned' and pspace_distinct' and
+                          ko_at' rv epptr"
                  in hoare_post_imp)
    apply (fastforce simp: valid_obj'_def valid_ep'_def obj_at'_def)
   apply (wp get_ep_sp' | clarsimp)+
   done
 
 lemma cancelAllSignals_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<rbrace>
+  "\<lbrace>\<lambda>s. no_orphans s \<and> valid_objs' s \<and> pspace_aligned' s \<and> pspace_distinct' s\<rbrace>
     cancelAllSignals ntfn
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding cancelAllSignals_def
   apply (wp sts_valid_objs' set_ntfn_valid_objs' sts_st_tcb'
             hoare_vcg_const_Ball_lift tcbSchedEnqueue_almost_no_orphans
              | wpc
              | clarsimp simp: valid_tcb_state'_def)+
     apply (rename_tac list)
-    apply (rule_tac V="\<lambda>_. valid_queues' and valid_objs'"
+    apply (rule_tac V="\<lambda>_. valid_objs' and pspace_aligned' and pspace_distinct'"
                 and I="no_orphans and (\<lambda>s. \<forall>t\<in>set list. tcb_at' t s)"
                 in mapM_x_inv_wp2)
     apply simp
    apply (wp sts_valid_objs' set_ntfn_valid_objs' sts_st_tcb'
             hoare_vcg_const_Ball_lift tcbSchedEnqueue_almost_no_orphans|
           clarsimp simp: valid_tcb_state'_def)+
-  apply (rule_tac Q="\<lambda>rv. no_orphans and valid_objs' and valid_queues' and ko_at' rv ntfn"
+  apply (rule_tac Q="\<lambda>rv. no_orphans and valid_objs' and pspace_aligned' and pspace_distinct' and
+                          ko_at' rv ntfn"
                  in hoare_post_imp)
    apply (fastforce simp: valid_obj'_def valid_ntfn'_def obj_at'_def)
   apply (wp get_ntfn_sp' | clarsimp)+
@@ -1575,47 +1290,48 @@ crunches setBoundNotification, unbindNotification, unbindMaybeNotification
   for no_orphans[wp]: no_orphans
 
 lemma finaliseCapTrue_standin_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<rbrace>
+  "\<lbrace>\<lambda>s. no_orphans s \<and> valid_objs' s \<and> pspace_aligned' s \<and> pspace_distinct' s\<rbrace>
     finaliseCapTrue_standin cap final
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding finaliseCapTrue_standin_def Let_def
   by wpsimp
 
 lemma cteDeleteOne_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<rbrace>
+  "\<lbrace>\<lambda>s. no_orphans s \<and> valid_objs' s \<and> pspace_aligned' s \<and> pspace_distinct' s\<rbrace>
    cteDeleteOne slot
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding cteDeleteOne_def
   by (wpsimp wp: assert_inv haskell_assert_inv isFinalCapability_inv weak_if_wp)
 
 crunch valid_objs' [wp]: getThreadReplySlot "valid_objs'"
 
 lemma cancelSignal_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<rbrace>
+  "\<lbrace>\<lambda>s. no_orphans s \<and> valid_objs' s\<rbrace>
    cancelSignal t ntfn
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding cancelSignal_def Let_def
   by (wpsimp wp: hoare_drop_imps setThreadState_not_active_no_orphans
              simp: is_active_thread_state_def isRestart_def isRunning_def)
 
 lemma cancelIPC_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<rbrace>
+  "\<lbrace>\<lambda>s. no_orphans s \<and> valid_objs' s \<and> pspace_aligned' s \<and> pspace_distinct' s\<rbrace>
    cancelIPC t
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding cancelIPC_def Let_def
   by (wpsimp wp: setThreadState_not_active_no_orphans hoare_drop_imps weak_if_wp
-                 threadSet_valid_queues' threadSet_valid_objs' threadSet_no_orphans
+                 threadSet_valid_objs' threadSet_no_orphans
              simp: is_active_thread_state_def isRestart_def isRunning_def inQ_def)
 
 lemma asUser_almost_no_orphans:
   "\<lbrace>almost_no_orphans t\<rbrace> asUser a f \<lbrace>\<lambda>_. almost_no_orphans t\<rbrace>"
   unfolding almost_no_orphans_disj all_queued_tcb_ptrs_def
-  by (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
+  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift)
 
 lemma sendSignal_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s\<rbrace>
+  "\<lbrace>\<lambda>s. no_orphans s  \<and> valid_objs' s \<and> pspace_aligned' s \<and> pspace_distinct' s \<and>
+        sch_act_wf (ksSchedulerAction s) s\<rbrace>
    sendSignal ntfnptr badge
-   \<lbrace> \<lambda>_ s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding sendSignal_def
   by (wpsimp wp: sts_st_tcb' gts_wp' getNotification_wp asUser_almost_no_orphans
                  cancelIPC_weak_sch_act_wf
@@ -1627,15 +1343,13 @@ crunches vgicUpdateLR
 
 crunch not_pred_tcb_at'[wp]: vgicUpdateLR,doMachineOp "\<lambda>s. \<not> (pred_tcb_at' proj P' t) s"
 
-crunch valid_queues' [wp]: vgicUpdateLR valid_queues'
-
 crunches vcpuUpdate, vgicUpdateLR, doMachineOp
   for no_orphans[wp]: no_orphans
   and tcb_in_cur_domain'[wp]: "tcb_in_cur_domain' t"
   (wp: no_orphans_lift tcb_in_cur_domain'_lift)
 
 lemma vgicMaintenance_no_orphans[wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s \<rbrace>
+  "\<lbrace>\<lambda>s. no_orphans s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s\<rbrace>
    vgicMaintenance
    \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding vgicMaintenance_def Let_def
@@ -1644,7 +1358,7 @@ lemma vgicMaintenance_no_orphans[wp]:
                  hoare_drop_imp[where f="doMachineOp f" for f])
 
 lemma vppiEvent_no_orphans[wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s \<rbrace>
+  "\<lbrace>\<lambda>s. no_orphans s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s\<rbrace>
    vppiEvent irq
    \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding vppiEvent_def Let_def
@@ -1657,7 +1371,7 @@ lemma irqVPPIEventIndex_irqVGICMaintenance_None[simp]:
   by simp
 
 lemma handleReservedIRQ_no_orphans[wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s \<rbrace>
+  "\<lbrace>\<lambda>s. no_orphans s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s\<rbrace>
    handleReservedIRQ irq
    \<lbrace>\<lambda>_. no_orphans \<rbrace>"
   unfolding handleReservedIRQ_def
@@ -1672,6 +1386,7 @@ lemma handleInterrupt_no_orphans [wp]:
   apply (wp hoare_drop_imps hoare_vcg_all_lift getIRQState_inv
          | wpc | clarsimp simp: invs'_def valid_state'_def maskIrqSignal_def
                                 if_apply_def2)+
+  apply fastforce
   done
 
 lemma updateRestartPC_no_orphans[wp]:
@@ -1680,20 +1395,6 @@ lemma updateRestartPC_no_orphans[wp]:
    \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
   by (wpsimp simp: updateRestartPC_def asUser_no_orphans)
 
-lemma updateRestartPC_valid_queues'[wp]:
-  "\<lbrace> \<lambda>s. valid_queues' s \<rbrace>
-   updateRestartPC t
-   \<lbrace> \<lambda>rv s. valid_queues' s \<rbrace>"
-  unfolding updateRestartPC_def
-  apply (rule asUser_valid_queues')
-  done
-
-lemma updateRestartPC_no_orphans_invs'_valid_queues'[wp]:
-  "\<lbrace>\<lambda>s. no_orphans s \<and> invs' s \<and> valid_queues' s \<rbrace>
-   updateRestartPC t
-   \<lbrace>\<lambda>rv s. no_orphans s \<and> valid_queues' s \<rbrace>"
-  by (wpsimp simp: updateRestartPC_def asUser_no_orphans)
-
 lemma suspend_no_orphans [wp]:
   "\<lbrace> \<lambda>s. no_orphans s \<and> invs' s \<and> sch_act_simple s \<and> tcb_at' t s \<rbrace>
    suspend t
@@ -1726,9 +1427,19 @@ lemma deleteASIDPool_no_orphans [wp]:
 lemma storePTE_no_orphans [wp]:
   "storePTE ptr val \<lbrace> no_orphans \<rbrace>"
   unfolding no_orphans_disj all_queued_tcb_ptrs_def
-  by (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
+  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift)
+
+lemma archThreadSet_tcbQueued_inv[wp]:
+  "archThreadSet f t \<lbrace>\<lambda>s. obj_at' (\<lambda>tcb. P (tcbQueued tcb)) tcb_ptr s\<rbrace>"
+  unfolding archThreadSet_def
+  by (wp setObject_tcb_strongest getObject_tcb_wp) (fastforce simp: obj_at'_def)
 
-crunch no_orphans [wp]: modifyArchState, vcpuUpdate, archThreadSet, dissociateVCPUTCB, vcpuFinalise "no_orphans"
+crunches dissociateVCPUTCB
+  for tcbQueued_inv[wp]: "\<lambda>s. obj_at' (\<lambda>tcb. P (tcbQueued tcb)) t s"
+  (wp: threadGet_wp crunch_wps asUser_tcbQueued_inv simp: crunch_simps)
+
+crunches modifyArchState, vcpuUpdate, archThreadSet, dissociateVCPUTCB, vcpuFinalise
+  for no_orphans[wp]: "no_orphans"
   (wp: no_orphans_lift crunch_wps)
 
 crunch no_orphans [wp]: unmapPage "no_orphans"
@@ -1741,7 +1452,7 @@ crunches unmapPageTable, prepareThreadDelete
 lemma setASIDPool_no_orphans [wp]:
   "setObject p (ap :: asidpool) \<lbrace> no_orphans \<rbrace>"
   unfolding no_orphans_disj all_queued_tcb_ptrs_def
-  by (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
+  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift)
 
 crunches deleteASID, Arch.finaliseCap
   for no_orphans [wp]: "no_orphans"
@@ -1809,9 +1520,7 @@ lemma cteRevoke_no_orphans [wp]:
   done
 
 lemma cancelBadgedSends_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<rbrace>
-   cancelBadgedSends epptr badge
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+  "cancelBadgedSends epptr badge \<lbrace>no_orphans\<rbrace>"
   unfolding cancelBadgedSends_def
   by (wpsimp wp: filterM_preserved tcbSchedEnqueue_almost_no_orphans gts_wp' sts_st_tcb'
       | wp (once) hoare_drop_imps)+
@@ -1824,10 +1533,10 @@ lemma doReplyTransfer_no_orphans[wp]:
    \<lbrace>\<lambda>rv. no_orphans\<rbrace>"
   unfolding doReplyTransfer_def
   apply (wp sts_st_tcb' setThreadState_not_active_no_orphans threadSet_no_orphans
-            threadSet_valid_queues' threadSet_weak_sch_act_wf
+            threadSet_weak_sch_act_wf
          | wpc | clarsimp simp: is_active_thread_state_def isRunning_def isRestart_def
          | wp (once) hoare_drop_imps
-         | strengthen sch_act_wf_weak invs_valid_queues')+
+         | strengthen sch_act_wf_weak)+
               apply (rule_tac Q="\<lambda>rv. invs' and no_orphans" in hoare_post_imp)
                apply (fastforce simp: inQ_def)
               apply (wp hoare_drop_imps | clarsimp)+
@@ -1845,7 +1554,6 @@ lemma restart_no_orphans [wp]:
   apply (wp tcbSchedEnqueue_almost_no_orphans sts_st_tcb' cancelIPC_weak_sch_act_wf
          | clarsimp simp: o_def if_apply_def2
          | strengthen no_orphans_strg_almost
-         | strengthen invs_valid_queues'
          | wp (once) hoare_drop_imps)+
   apply auto
   done
@@ -1864,7 +1572,7 @@ lemma writereg_no_orphans[wp]:
    \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
   unfolding invokeTCB_def performTransfer_def postModifyRegisters_def
   by (wp hoare_vcg_if_lift hoare_vcg_conj_lift restart_invs' hoare_weak_lift_imp
-      | strengthen invs_valid_queues'
+      | strengthen
       | clarsimp  simp: invs'_def valid_state'_def dest!: global'_no_ex_cap )+
 
 lemma copyreg_no_orphans[wp]:
@@ -1876,8 +1584,8 @@ lemma copyreg_no_orphans[wp]:
   apply simp
   apply (wp hoare_vcg_if_lift hoare_weak_lift_imp)
       apply (wp hoare_weak_lift_imp hoare_vcg_conj_lift hoare_drop_imp mapM_x_wp' restart_invs'
-             restart_no_orphans asUser_no_orphans suspend_nonz_cap_to_tcb
-             | strengthen invs_valid_queues' | wpc | simp add: if_apply_def2)+
+                restart_no_orphans asUser_no_orphans suspend_nonz_cap_to_tcb
+             | wpc | simp add: if_apply_def2)+
   apply (fastforce simp: invs'_def valid_state'_def dest!: global'_no_ex_cap)
   done
 
@@ -1896,22 +1604,19 @@ lemma almost_no_orphans_no_orphans':
   "\<lbrakk> almost_no_orphans t s; ksCurThread s = t\<rbrakk> \<Longrightarrow> no_orphans s"
   by (auto simp: almost_no_orphans_def no_orphans_def all_active_tcb_ptrs_def)
 
-lemma setPriority_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> invs' s \<and> tcb_at' tptr s \<rbrace>
+lemma setPriority_no_orphans[wp]:
+  "\<lbrace>no_orphans and invs' and tcb_at' tptr\<rbrace>
    setPriority tptr prio
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding setPriority_def
   apply wpsimp
-    apply (rule_tac Q="\<lambda>rv s. almost_no_orphans tptr s \<and> valid_queues' s \<and> weak_sch_act_wf (ksSchedulerAction s) s" in hoare_post_imp)
+    apply (rule_tac Q="\<lambda>_ s. almost_no_orphans tptr s \<and> weak_sch_act_wf (ksSchedulerAction s) s" in hoare_post_imp)
      apply clarsimp
      apply (clarsimp simp: is_active_tcb_ptr_runnable' pred_tcb_at'_def obj_at'_def
                            almost_no_orphans_no_orphans elim!: almost_no_orphans_no_orphans')
-    apply (wp threadSet_almost_no_orphans threadSet_valid_queues' | clarsimp simp: inQ_def)+
+    apply (wp threadSet_almost_no_orphans | clarsimp simp: inQ_def)+
     apply (wpsimp wp: threadSet_weak_sch_act_wf)
    apply (wp tcbSchedDequeue_almost_no_orphans| clarsimp)+
-   apply (rule_tac Q="\<lambda>rv. obj_at' (Not \<circ> tcbQueued) tptr and invs' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)" in hoare_post_imp)
-    apply (clarsimp simp: obj_at'_def inQ_def)
-   apply (wp tcbSchedDequeue_not_queued | clarsimp)+
   done
 
 crunches bindNotification, setMCPriority
@@ -1958,7 +1663,6 @@ lemma tc_no_orphans:
                checkCap_inv[where P=no_orphans] checkCap_inv[where P="tcb_at' a"]
                threadSet_cte_wp_at' hoare_vcg_all_lift_R hoare_vcg_all_lift threadSet_no_orphans
                hoare_vcg_const_imp_lift_R hoare_weak_lift_imp hoare_drop_imp threadSet_ipcbuffer_invs
-          | strengthen invs_valid_queues'
           | (simp add: locateSlotTCB_def locateSlotBasic_def objBits_def
                      objBitsKO_def tcbIPCBufferSlot_def tcb_cte_cases_def,
            wp hoare_return_sp)
@@ -1979,13 +1683,12 @@ lemma invokeTCB_no_orphans [wp]:
   done
 
 lemma invokeCNode_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> invs' s \<and> valid_cnode_inv' cinv s \<and> sch_act_simple s \<rbrace>
+  "\<lbrace>no_orphans and invs' and valid_cnode_inv' cinv and sch_act_simple\<rbrace>
    invokeCNode cinv
-   \<lbrace> \<lambda>rv. no_orphans \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding invokeCNode_def
   apply (rule hoare_pre)
    apply (wp hoare_drop_imps unless_wp | wpc | clarsimp split del: if_split)+
-  apply (simp add: invs_valid_queues')
   done
 
 crunches performIRQControl, InterruptDecls_H.invokeIRQHandler, performPageTableInvocation,
@@ -1994,7 +1697,7 @@ crunches performIRQControl, InterruptDecls_H.invokeIRQHandler, performPageTableI
   (wp: crunch_wps)
 
 lemma handleHypervisorFault_no_orphans[wp]:
-  "\<lbrace>\<lambda>s. valid_queues' s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s \<and> no_orphans s\<rbrace>
+  "\<lbrace>\<lambda>s. valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s \<and> no_orphans s\<rbrace>
    handleHypervisorFault w f
    \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding handleHypervisorFault_def isFpuEnable_def
@@ -2095,17 +1798,15 @@ lemma arch_performInvocation_no_orphans [wp]:
   by (wpsimp simp: valid_arch_inv'_def)
 
 lemma setDomain_no_orphans [wp]:
-  "\<lbrace>no_orphans and valid_queues and valid_queues' and cur_tcb'\<rbrace>
-     setDomain tptr newdom
+  "\<lbrace>no_orphans and cur_tcb' and tcb_at' tptr\<rbrace>
+   setDomain tptr newdom
    \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   apply (simp add: setDomain_def when_def)
   apply (wp tcbSchedEnqueue_almost_no_orphans hoare_vcg_imp_lift threadSet_almost_no_orphans
-            threadSet_valid_queues'_no_state threadSet_st_tcb_at2 hoare_vcg_disj_lift
+            threadSet_st_tcb_at2 hoare_vcg_disj_lift
             threadSet_no_orphans
-       | clarsimp simp: st_tcb_at_neg2 not_obj_at')+
-   apply (auto simp: tcb_at_typ_at' st_tcb_at_neg' is_active_tcb_ptr_runnable'
-                     cur_tcb'_def obj_at'_def
-               dest: pred_tcb_at')
+         | clarsimp simp: st_tcb_at_neg2 not_obj_at')+
+  apply (fastforce simp: tcb_at_typ_at'  is_active_tcb_ptr_runnable')
   done
 
 lemma performInvocation_no_orphans [wp]:
@@ -2123,8 +1824,6 @@ lemma getThreadState_restart [wp]:
   apply (clarsimp simp add: pred_tcb_at'_def obj_at'_def isRestart_def)
   done
 
-crunch valid_queues' [wp]: replyFromKernel "valid_queues'"
-
 lemma handleInvocation_no_orphans [wp]:
   "\<lbrace> \<lambda>s. no_orphans s \<and> invs' s \<and>
          ct_active' s \<and> ksSchedulerAction s = ResumeCurrentThread \<rbrace>
@@ -2142,20 +1841,12 @@ lemma handleInvocation_no_orphans [wp]:
                   ct_in_state'_set setThreadState_st_tcb
                   hoare_vcg_all_lift
                 | simp add: split_def split del: if_split)+
-         apply (wps setThreadState_ct')
-         apply (wp sts_ksQ
-                   setThreadState_current_no_orphans sts_invs_minor'
-                   ct_in_state'_set setThreadState_st_tcb
-                 | simp add: split_def split del: if_split)+
   apply (clarsimp simp: if_apply_def2)
-  apply (frule(1) ct_not_ksQ)
   by (auto simp: ct_in_state'_def pred_tcb_at'_def obj_at'_def invs'_def
                     cur_tcb'_def valid_state'_def valid_idle'_def)
 
 lemma receiveSignal_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<rbrace>
-   receiveSignal thread cap isBlocking
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+  "receiveSignal thread cap isBlocking \<lbrace>no_orphans\<rbrace>"
   unfolding receiveSignal_def
   apply (wp hoare_drop_imps setThreadState_not_active_no_orphans | wpc
          | clarsimp simp: is_active_thread_state_def isRunning_def isRestart_def
@@ -2173,7 +1864,7 @@ lemma receiveIPC_no_orphans [wp]:
              hoare_vcg_all_lift sts_st_tcb'
           | wpc
           | clarsimp simp: is_active_thread_state_def isRunning_def isRestart_def
-                           doNBRecvFailedTransfer_def invs_valid_queues'
+                           doNBRecvFailedTransfer_def
           | strengthen sch_act_wf_weak)+
   done
 
@@ -2251,7 +1942,7 @@ lemma handleEvent_no_orphans [wp]:
               cong: event.case_cong syscall.case_cong)
   apply (rule hoare_pre)
    apply (wp hoare_drop_imps | wpc | clarsimp simp: handleHypervisorFault_def
-          | strengthen invs_valid_queues' invs_valid_objs' invs_sch_act_wf')+
+          | strengthen invs_valid_objs' invs_sch_act_wf')+
   apply (auto simp: activatable_from_running' active_from_running')
   done
 
diff --git a/proof/refine/ARM/ADT_H.thy b/proof/refine/ARM/ADT_H.thy
index 158ddb5aba..ad198a9a6e 100644
--- a/proof/refine/ARM/ADT_H.thy
+++ b/proof/refine/ARM/ADT_H.thy
@@ -622,7 +622,7 @@ proof -
     apply (intro conjI impI allI)
            apply (erule pspace_dom_relatedE[OF _ pspace_relation])
            apply clarsimp
-           apply (case_tac ko, simp_all add: other_obj_relation_def)
+           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)
@@ -636,7 +636,7 @@ proof -
            apply (clarsimp split: if_split_asm)+
 
           apply (erule pspace_dom_relatedE[OF _ pspace_relation])
-          apply (case_tac ko, simp_all add: other_obj_relation_def)
+          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)
@@ -649,7 +649,7 @@ proof -
           apply (clarsimp split: if_split_asm)+
 
          apply (erule pspace_dom_relatedE[OF _ pspace_relation])
-         apply (case_tac ko, simp_all add: other_obj_relation_def)
+         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)
@@ -658,7 +658,7 @@ proof -
          apply (clarsimp split: if_split_asm)+
 
         apply (erule pspace_dom_relatedE[OF _ pspace_relation])
-        apply (case_tac ko, simp_all add: other_obj_relation_def)
+        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)
@@ -684,7 +684,7 @@ proof -
         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: other_obj_relation_def)
+        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)
@@ -710,7 +710,7 @@ proof -
         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: other_obj_relation_def)
+       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)
@@ -738,7 +738,7 @@ proof -
                                  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: other_obj_relation_def
+      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)
@@ -805,7 +805,7 @@ proof -
     (* mapping architecture-specific objects *)
     apply clarsimp
     apply (erule pspace_dom_relatedE[OF _ pspace_relation])
-    apply (case_tac ko, simp_all add: other_obj_relation_def)
+    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
@@ -949,7 +949,7 @@ shows
    apply (case_tac "ksPSpace s' x", clarsimp)
     apply (erule_tac x=x in allE, clarsimp)
    apply clarsimp
-   apply (case_tac a, simp_all add: other_obj_relation_def)
+   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)
@@ -1018,7 +1018,7 @@ lemma TCB_implies_KOTCB:
   apply (clarsimp simp add: pspace_relation_def pspace_dom_def
                             dom_def UNION_eq Collect_eq)
   apply (erule_tac x=a in allE)+
-  apply (clarsimp simp add: other_obj_relation_def
+  apply (clarsimp simp add: tcb_relation_cut_def
                   split: Structures_H.kernel_object.splits)
   apply (drule iffD1)
    apply (fastforce simp add: dom_def image_def)
@@ -1802,7 +1802,7 @@ definition
       domain_index_internal = ksDomScheduleIdx s,
       cur_domain_internal = ksCurDomain s,
       domain_time_internal = ksDomainTime s,
-      ready_queues_internal = curry (ksReadyQueues 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:
@@ -1810,12 +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 absEkheap_correct
-                           absCDTList_correct[THEN fun_cong] state_relation_def invs_def valid_state_def
-                           ready_queues_relation_def invs'_def valid_state'_def
-                           valid_pspace_def valid_sched_def valid_pspace'_def curry_def fun_eq_iff)
-      apply (fastforce simp: absEkheap_correct)
+           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
 
 
diff --git a/proof/refine/ARM/ArchAcc_R.thy b/proof/refine/ARM/ArchAcc_R.thy
index 5212765530..5ddf93aedb 100644
--- a/proof/refine/ARM/ArchAcc_R.thy
+++ b/proof/refine/ARM/ArchAcc_R.thy
@@ -125,16 +125,6 @@ lemma getObject_ASIDPool_corres [corres]:
   apply (clarsimp simp: other_obj_relation_def asid_pool_relation_def)
   done
 
-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 simp
-  done
-
 lemmas aligned_distinct_asid_pool_atI'
     = aligned_distinct_obj_atI'[where 'a=asidpool,
                                 simplified, OF _ _ _ refl]
@@ -758,18 +748,21 @@ lemma setObject_PD_corres [@lift_corres_args, corres]:
    apply (drule(1) ekheap_kheap_dom)
    apply clarsimp
    apply (drule_tac x=p in bspec, erule domI)
-   apply (simp add: other_obj_relation_def
-           split: Structures_A.kernel_object.splits)
-  apply (rule conjI)
+   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
+  apply (extract_conjunct \<open>match conclusion in "ready_queues_relation_2 _ _ _ _ _" \<Rightarrow> -\<close>)
+   apply (prop_tac "typ_at' (koTypeOf (injectKO pde')) p b")
+    apply (simp add: typ_at'_def ko_wp_at'_def)
+   subgoal by (fastforce dest: tcbs_of'_non_tcb_update)
   apply (simp add: map_to_ctes_upd_other)
   apply (simp add: fun_upd_def)
   apply (simp add: caps_of_state_after_update obj_at_def swp_cte_at_caps_of)
   done
 
-
 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)
@@ -835,12 +828,16 @@ lemma setObject_PT_corres [@lift_corres_args, corres]:
    apply (drule(1) ekheap_kheap_dom)
    apply clarsimp
    apply (drule_tac x=p in bspec, erule domI)
-   apply (simp add: other_obj_relation_def
-           split: Structures_A.kernel_object.splits)
-  apply (rule conjI)
+   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
+  apply (extract_conjunct \<open>match conclusion in "ready_queues_relation_2 _ _ _ _ _" \<Rightarrow> -\<close>)
+   apply (prop_tac "typ_at' (koTypeOf (injectKO pte')) p b")
+    apply (simp add: typ_at'_def ko_wp_at'_def)
+   subgoal by (fastforce dest: tcbs_of'_non_tcb_update)
   apply (simp add: map_to_ctes_upd_other)
   apply (simp add: fun_upd_def)
   apply (simp add: caps_of_state_after_update obj_at_def swp_cte_at_caps_of)
@@ -1433,5 +1430,161 @@ lemma dmo_clearMemory_invs'[wp]:
   apply fastforce
   done
 
+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>TCB\<close>
+      apply (clarsimp simp: tcbBlockSizeBits_def elim!: is_aligned_weaken)
+
+     \<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 (rule pbfs_atleast_pageBits)
+   apply (fastforce intro: is_aligned_shift is_aligned_mult_triv2)
+
+  \<comment>\<open>other_obj_relation\<close>
+  apply (simp add: other_obj_relation_def)
+  by (clarsimp simp: 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)
+
+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 bit_simps 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_def2)
+       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=tcbBlockSizeBits in exI)
+      apply (simp add: tcbBlockSizeBits_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
+                         pbfs_atleast_pageBits[simplified bit_simps] archObjSize_def pteBits_def
+                         pdeBits_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 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 (rule ps_clearI, assumption)
+   apply (case_tac ko'; simp add: objBits_simps objBits_defs obj_at_simps)
+   apply (simp split: arch_kernel_object.splits add: obj_at_simps pteBits_def pdeBits_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_def2 objBits_simps)
+       apply (rule_tac n=cte_level_bits in is_aligned_add_step_le'; assumption?)
+         apply (rule is_aligned_add; (rule is_aligned_shift)?)
+         apply (erule is_aligned_weaken, simp add: cte_level_bits_def)
+        apply (rule is_aligned_add; (rule is_aligned_shift)?)
+        apply (erule is_aligned_weaken, simp add: cte_level_bits_def)
+       apply (simp add: cte_level_bits_def cteSizeBits_def)
+      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 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)
+  done
+
 end
 end
diff --git a/proof/refine/ARM/Arch_R.thy b/proof/refine/ARM/Arch_R.thy
index 33e79a0476..dd1fb9875d 100644
--- a/proof/refine/ARM/Arch_R.thy
+++ b/proof/refine/ARM/Arch_R.thy
@@ -263,11 +263,10 @@ lemma performASIDControlInvocation_corres:
               deleteObjects_cte_wp_at'
               deleteObjects_null_filter[where p="makePoolParent i'"])
    apply (clarsimp simp:invs_mdb max_free_index_def invs_untyped_children)
-   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 (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)
@@ -339,7 +338,7 @@ lemma performASIDControlInvocation_corres:
      apply (simp add:pageBits_def)
     apply clarsimp
     apply (drule(1) cte_cap_in_untyped_range)
-         apply (fastforce simp:cte_wp_at_ctes_of)
+         apply (fastforce simp: cte_wp_at_ctes_of)
         apply assumption+
      apply fastforce
     apply simp
@@ -1290,7 +1289,7 @@ lemma tcbSchedEnqueue_vs_entry_align[wp]:
  "\<lbrace>\<lambda>s. ko_wp_at' (\<lambda>ko. P (vs_entry_align ko)) p s\<rbrace>
    tcbSchedEnqueue pa
   \<lbrace>\<lambda>rv. ko_wp_at' (\<lambda>ko. P (vs_entry_align ko)) p\<rbrace>"
-  apply (clarsimp simp: tcbSchedEnqueue_def setQueue_def)
+  apply (clarsimp simp: tcbSchedEnqueue_def tcbQueuePrepend_def setQueue_def)
   by (wp unless_wp | simp)+
 
 crunch vs_entry_align[wp]:
diff --git a/proof/refine/ARM/Bits_R.thy b/proof/refine/ARM/Bits_R.thy
index 278b3c5b43..5023c5e46e 100644
--- a/proof/refine/ARM/Bits_R.thy
+++ b/proof/refine/ARM/Bits_R.thy
@@ -78,6 +78,10 @@ lemma projectKO_tcb:
   "(projectKO_opt ko = Some t) = (ko = KOTCB t)"
   by (cases ko) (auto simp: projectKO_opts_defs)
 
+lemma tcb_of'_TCB[simp]:
+  "tcb_of' (KOTCB tcb) = Some tcb"
+  by (simp add: projectKO_tcb)
+
 lemma projectKO_cte:
   "(projectKO_opt ko = Some t) = (ko = KOCTE t)"
   by (cases ko) (auto simp: projectKO_opts_defs)
diff --git a/proof/refine/ARM/CNodeInv_R.thy b/proof/refine/ARM/CNodeInv_R.thy
index 3459ade0a2..f91f9e3469 100644
--- a/proof/refine/ARM/CNodeInv_R.thy
+++ b/proof/refine/ARM/CNodeInv_R.thy
@@ -5042,8 +5042,6 @@ crunch irq_states'[wp]: cteSwap "valid_irq_states'"
 
 crunch pde_mappings'[wp]: cteSwap "valid_pde_mappings'"
 
-crunch vq'[wp]: cteSwap "valid_queues'"
-
 crunch ksqsL1[wp]: cteSwap "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
 
 crunch ksqsL2[wp]: cteSwap "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
@@ -5058,6 +5056,12 @@ crunch ct_not_inQ[wp]: cteSwap "ct_not_inQ"
 
 crunch ksDomScheduleIdx [wp]: cteSwap "\<lambda>s. P (ksDomScheduleIdx s)"
 
+crunches cteSwap
+  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: valid_bitmaps_lift)
+
 lemma cteSwap_invs'[wp]:
   "\<lbrace>invs' and valid_cap' c and valid_cap' c' and
     ex_cte_cap_to' c1 and ex_cte_cap_to' c2 and
@@ -5514,6 +5518,10 @@ lemma updateCap_untyped_ranges_zero_simple:
 crunch tcb_in_cur_domain'[wp]: updateCap "tcb_in_cur_domain' t"
   (wp: crunch_wps simp: crunch_simps rule: tcb_in_cur_domain'_lift)
 
+crunches updateCap
+  for valid_bitmaps[wp]: valid_bitmaps
+  (rule: valid_bitmaps_lift)
+
 lemma make_zombie_invs':
   "\<lbrace>\<lambda>s. invs' s \<and> s \<turnstile>' cap \<and>
     cte_wp_at' (\<lambda>cte. isFinal (cteCap cte) sl (cteCaps_of s)) sl s \<and>
@@ -5530,7 +5538,8 @@ lemma make_zombie_invs':
                             st_tcb_at' ((=) Inactive) p s
                              \<and> bound_tcb_at' ((=) None) p s
                              \<and> obj_at' (Not \<circ> tcbQueued) p s
-                             \<and> (\<forall>pr. p \<notin> set (ksReadyQueues s pr)))) sl s\<rbrace>
+                             \<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_state'_def valid_pspace'_def valid_mdb'_def
@@ -5567,7 +5576,9 @@ lemma make_zombie_invs':
    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_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
@@ -8498,6 +8509,15 @@ lemma cteMove_urz [wp]:
   apply auto
   done
 
+crunches updateMDB
+  for valid_bitmaps[wp]: valid_bitmaps
+  (rule: valid_bitmaps_lift)
+
+(* FIXME: arch_split *)
+lemma haskell_assert_inv:
+  "haskell_assert Q L \<lbrace>P\<rbrace>"
+  by wpsimp
+
 lemma cteMove_invs' [wp]:
   "\<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>
diff --git a/proof/refine/ARM/CSpace1_R.thy b/proof/refine/ARM/CSpace1_R.thy
index f60dd64bc3..ee4898d676 100644
--- a/proof/refine/ARM/CSpace1_R.thy
+++ b/proof/refine/ARM/CSpace1_R.thy
@@ -236,7 +236,7 @@ lemma pspace_relation_cte_wp_at:
    apply (clarsimp elim!: cte_wp_at_weakenE')
   apply clarsimp
   apply (drule(1) pspace_relation_absD)
-  apply (clarsimp simp: other_obj_relation_def)
+  apply (clarsimp simp: tcb_relation_cut_def)
   apply (simp split: kernel_object.split_asm)
   apply (drule(2) aligned_distinct_obj_atI'[where 'a=tcb])
    apply simp
@@ -1597,10 +1597,10 @@ lemma cte_map_pulls_tcb_to_abstract:
      \<Longrightarrow> \<exists>tcb'. kheap s x = Some (TCB tcb') \<and> tcb_relation tcb' tcb
                   \<and> (z = (x, tcb_cnode_index (unat ((y - x) >> cte_level_bits))))"
   apply (rule pspace_dom_relatedE, assumption+)
-  apply (erule(1) obj_relation_cutsE, simp_all split: if_split_asm)
-  apply (clarsimp simp: other_obj_relation_def
+  apply (erule(1) obj_relation_cutsE;
+         clarsimp simp: other_obj_relation_def
                  split: Structures_A.kernel_object.split_asm
-                        ARM_A.arch_kernel_obj.split_asm)
+                        ARM_A.arch_kernel_obj.split_asm if_split_asm)
   apply (drule tcb_cases_related2)
   apply clarsimp
   apply (frule(1) cte_wp_at_tcbI [OF _ _ TrueI, where t="(a, b)" for a b, simplified])
@@ -1616,8 +1616,7 @@ lemma pspace_relation_update_tcbs:
               del: dom_fun_upd)
   apply (erule conjE)
   apply (rule ballI, drule(1) bspec)
-  apply (rule conjI, simp add: other_obj_relation_def)
-  apply (clarsimp split: Structures_A.kernel_object.split_asm)
+  apply (clarsimp simp: tcb_relation_cut_def split: Structures_A.kernel_object.split_asm)
   apply (drule bspec, fastforce)
   apply clarsimp
   apply (erule(1) obj_relation_cutsE, simp_all split: if_split_asm)
@@ -1838,6 +1837,27 @@ lemma descendants_of_eq':
   apply simp
   done
 
+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
+
+lemma setObject_cte_tcbSchedNexts_of_use_valid_ksPSpace:
+  assumes step: "(x, s\<lparr>ksPSpace := ps\<rparr>) \<in> fst (setObject p (cte :: cte) s)"
+  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_inQ_of_use_valid_ksPSpace:
+  assumes step: "(x, s\<lparr>ksPSpace := ps\<rparr>) \<in> fst (setObject p (cte :: cte) s)"
+  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>
@@ -1851,7 +1871,12 @@ lemma updateCap_stuff:
          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'')" using assms
+         (pspace_distinct' s' \<longrightarrow> pspace_distinct' s'') \<and>
+         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)
@@ -1860,8 +1885,11 @@ lemma updateCap_stuff:
   apply (frule setCTE_pspace_only)
   apply (clarsimp simp: setCTE_def)
   apply (intro conjI impI)
-   apply (erule(1) use_valid [OF _ setObject_aligned])
-  apply (erule(1) use_valid [OF _ setObject_distinct])
+      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 *)
@@ -1878,16 +1906,16 @@ lemma pspace_relation_cte_wp_atI':
    apply (simp split: if_split_asm)
   apply (erule(1) pspace_dom_relatedE)
   apply (erule(1) obj_relation_cutsE, simp_all split: if_split_asm)
+   apply (subgoal_tac "n = x - y", clarsimp)
+    apply (drule tcb_cases_related2, clarsimp)
+    apply (intro exI, rule conjI)
+     apply (erule(1) cte_wp_at_tcbI[where t="(a, b)" for a b, simplified])
+     apply fastforce
+    apply simp
+   apply clarsimp
   apply (simp add: other_obj_relation_def
             split: Structures_A.kernel_object.split_asm
                    ARM_A.arch_kernel_obj.split_asm)
-  apply (subgoal_tac "n = x - y", clarsimp)
-   apply (drule tcb_cases_related2, clarsimp)
-   apply (intro exI, rule conjI)
-    apply (erule(1) cte_wp_at_tcbI[where t="(a, b)" for a b, simplified])
-    apply fastforce
-   apply simp
-  apply clarsimp
   done
 
 lemma pspace_relation_cte_wp_atI:
@@ -2287,7 +2315,7 @@ lemma updateCap_corres:
   apply (clarsimp simp: in_set_cap_cte_at_swp pspace_relations_def)
   apply (drule updateCap_stuff)
   apply simp
-  apply (rule conjI)
+  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 (rule conjI)
    prefer 2
@@ -2375,9 +2403,9 @@ lemma updateMDB_pspace_relation:
     apply (clarsimp simp: tcb_ctes_clear cte_level_bits_def objBits_defs)
    apply clarsimp
    apply (rule pspace_dom_relatedE, assumption+)
-   apply (rule obj_relation_cutsE, assumption+, simp_all split: if_split_asm)[1]
-   apply (clarsimp split: Structures_A.kernel_object.split_asm
-                          ARM_A.arch_kernel_obj.split_asm
+   apply (rule obj_relation_cutsE, assumption+;
+          clarsimp split: Structures_A.kernel_object.split_asm
+                          ARM_A.arch_kernel_obj.split_asm if_split_asm
                     simp: other_obj_relation_def)
    apply (frule(1) tcb_cte_cases_aligned_helpers(1))
    apply (frule(1) tcb_cte_cases_aligned_helpers(2))
@@ -2439,6 +2467,25 @@ lemma updateMDB_ctes_of:
 
 crunch aligned[wp]: updateMDB "pspace_aligned'"
 crunch pdistinct[wp]: updateMDB "pspace_distinct'"
+crunch tcbSchedPrevs_of[wp]: updateMDB "\<lambda>s. P (tcbSchedPrevs_of s)"
+crunch tcbSchedNexts_of[wp]: updateMDB "\<lambda>s. P (tcbSchedNexts_of s)"
+crunch inQ_opt_pred[wp]: updateMDB "\<lambda>s. P (inQ d p |< tcbs_of' s)"
+crunch inQ_opt_pred'[wp]: updateMDB "\<lambda>s. P (\<lambda>d p. inQ d p |< tcbs_of' s)"
+crunch ksReadyQueues[wp]: updateMDB "\<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
+
+crunches 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')"
@@ -2461,7 +2508,11 @@ lemma updateMDB_the_lot:
          ksDomScheduleIdx s'' = ksDomScheduleIdx s' \<and>
          ksDomSchedule s''    = ksDomSchedule s' \<and>
          ksCurDomain s''      = ksCurDomain s' \<and>
-         ksDomainTime s''     = ksDomainTime s'"
+         ksDomainTime s''     = ksDomainTime s' \<and>
+         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)
@@ -2470,9 +2521,8 @@ using assms
    apply (erule use_valid)
     apply wp
    apply simp
-  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:
@@ -3665,6 +3715,9 @@ lemma updateUntypedCap_descendants_of:
   apply (clarsimp simp:mdb_next_rel_def mdb_next_def split:if_splits)
   done
 
+crunches setCTE
+  for tcbQueued[wp]: "\<lambda>s. P (tcbQueued |< tcbs_of' s)"
+
 lemma setCTE_UntypedCap_corres:
   "\<lbrakk>cap_relation cap (cteCap cte); is_untyped_cap cap; idx' = idx\<rbrakk>
    \<Longrightarrow> corres dc (cte_wp_at ((=) cap) src and valid_objs and
@@ -3694,10 +3747,19 @@ lemma setCTE_UntypedCap_corres:
    apply assumption
   apply (clarsimp simp: pspace_relations_def)
   apply (subst conj_assoc[symmetric])
+  apply clarsimp
   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)
@@ -4978,11 +5040,15 @@ lemma updateMDB_the_lot':
          ksDomScheduleIdx s'' = ksDomScheduleIdx s' \<and>
          ksDomSchedule s''    = ksDomSchedule s' \<and>
          ksCurDomain s''      = ksCurDomain s' \<and>
-         ksDomainTime s''     = ksDomainTime s'"
+         ksDomainTime s''     = ksDomainTime s' \<and>
+         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
+   done
 
 lemma cte_map_inj_eq':
   "\<lbrakk>(cte_map p = cte_map p');
@@ -5084,7 +5150,6 @@ lemma cteInsert_corres:
             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 "ksReadyQueues t = p" for p t)+
             apply (thin_tac "ksSchedulerAction t = p" for p t)+
             apply (clarsimp simp: pspace_relations_def)
 
diff --git a/proof/refine/ARM/CSpace_R.thy b/proof/refine/ARM/CSpace_R.thy
index 3e438cadef..f765387bad 100644
--- a/proof/refine/ARM/CSpace_R.thy
+++ b/proof/refine/ARM/CSpace_R.thy
@@ -1099,43 +1099,6 @@ lemma bitmapQ_no_L2_orphans_lift:
   apply (rule hoare_vcg_prop, assumption)
   done
 
-lemma valid_queues_lift_asm:
-  assumes tat1: "\<And>d p tcb. \<lbrace>obj_at' (inQ d p) tcb and Q \<rbrace> f \<lbrace>\<lambda>_. obj_at' (inQ d p) tcb\<rbrace>"
-  and     tat2: "\<And>tcb. \<lbrace>st_tcb_at' runnable' tcb and Q \<rbrace> f \<lbrace>\<lambda>_. st_tcb_at' runnable' tcb\<rbrace>"
-  and     prq: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueues s) \<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueues s)\<rbrace>"
-  and     prqL1: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueuesL1Bitmap s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueuesL1Bitmap s)\<rbrace>"
-  and     prqL2: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueuesL2Bitmap s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueuesL2Bitmap s)\<rbrace>"
-  shows   "\<lbrace>Invariants_H.valid_queues and Q\<rbrace> f \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  proof -
-    have tat:  "\<And>d p tcb. \<lbrace>obj_at' (inQ d p) tcb and st_tcb_at' runnable' tcb and Q\<rbrace> f
-                         \<lbrace>\<lambda>_. obj_at' (inQ d p) tcb and st_tcb_at' runnable' tcb\<rbrace>"
-      apply (rule hoare_chain [OF hoare_vcg_conj_lift [OF tat1 tat2]])
-       apply (fastforce)+
-       done
-    have tat_combined: "\<And>d p tcb. \<lbrace>obj_at' (inQ d p and runnable' \<circ> tcbState) tcb and Q\<rbrace> f
-                         \<lbrace>\<lambda>_. obj_at' (inQ d p and runnable' \<circ> tcbState) tcb\<rbrace>"
-      apply (rule hoare_chain [OF tat])
-       apply (fastforce simp add: obj_at'_and pred_tcb_at'_def o_def)+
-      done
-    show ?thesis unfolding valid_queues_def valid_queues_no_bitmap_def
-      by (wp tat_combined prq prqL1 prqL2 valid_bitmapQ_lift bitmapQ_no_L2_orphans_lift
-             bitmapQ_no_L1_orphans_lift hoare_vcg_all_lift hoare_vcg_conj_lift hoare_Ball_helper)
-         simp_all
-  qed
-
-lemmas valid_queues_lift = valid_queues_lift_asm[where Q="\<lambda>_. True", simplified]
-
-lemma valid_queues_lift':
-  assumes tat: "\<And>d p tcb. \<lbrace>\<lambda>s. \<not> obj_at' (inQ d p) tcb s\<rbrace> f \<lbrace>\<lambda>_ s. \<not> obj_at' (inQ d p) tcb s\<rbrace>"
-  and     prq: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueues s)\<rbrace>"
-  shows   "\<lbrace>valid_queues'\<rbrace> f \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  unfolding valid_queues'_def imp_conv_disj
-  by (wp hoare_vcg_all_lift hoare_vcg_disj_lift tat prq)
-
-lemma setCTE_norq [wp]:
-  "\<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace> setCTE ptr cte \<lbrace>\<lambda>r s. P (ksReadyQueues s) \<rbrace>"
-  by (clarsimp simp: valid_def dest!: setCTE_pspace_only)
-
 lemma setCTE_norqL1 [wp]:
   "\<lbrace>\<lambda>s. P (ksReadyQueuesL1Bitmap s)\<rbrace> setCTE ptr cte \<lbrace>\<lambda>r s. P (ksReadyQueuesL1Bitmap s) \<rbrace>"
   by (clarsimp simp: valid_def dest!: setCTE_pspace_only)
@@ -2784,12 +2747,6 @@ lemma setCTE_inQ[wp]:
    apply (simp_all add: inQ_def)
   done
 
-lemma setCTE_valid_queues'[wp]:
-  "\<lbrace>valid_queues'\<rbrace> setCTE p cte \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (simp only: valid_queues'_def imp_conv_disj)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-  done
-
 crunch inQ[wp]: cteInsert "\<lambda>s. P (obj_at' (inQ d p) t s)"
   (wp: crunch_wps)
 
@@ -3284,6 +3241,13 @@ lemma cteInsert_untyped_ranges_zero[wp]:
   apply blast
   done
 
+crunches cteInsert
+  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
   (\<lambda>s. src \<noteq> dest) and (\<lambda>s. cte_wp_at' (is_derived' (ctes_of s) src cap \<circ> cteCap) src s)
@@ -3292,9 +3256,9 @@ lemma cteInsert_invs:
   cteInsert cap src dest
   \<lbrace>\<lambda>rv. invs'\<rbrace>"
   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 CSpace_R.valid_queues_lift
-                    valid_irq_node_lift valid_queues_lift' irqs_masked_lift cteInsert_norq
-              simp: st_tcb_at'_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
 
@@ -3594,10 +3558,13 @@ lemma corres_caps_decomposition:
              "\<And>P. \<lbrace>\<lambda>s. P (new_ups' s)\<rbrace> g \<lbrace>\<lambda>rv s. P (gsUserPages s)\<rbrace>"
              "\<And>P. \<lbrace>\<lambda>s. P (new_cns s)\<rbrace> f \<lbrace>\<lambda>rv s. P (cns_of_heap (kheap s))\<rbrace>"
              "\<And>P. \<lbrace>\<lambda>s. P (new_cns' s)\<rbrace> g \<lbrace>\<lambda>rv s. P (gsCNodes s)\<rbrace>"
-             "\<And>P. \<lbrace>\<lambda>s. P (new_queues s)\<rbrace> f \<lbrace>\<lambda>rv s. P (ready_queues s)\<rbrace>"
+             "\<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_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>"
@@ -3613,7 +3580,9 @@ lemma corres_caps_decomposition:
              "\<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 (new_queues s) (new_rqs' s')"
+                       \<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>
@@ -3681,8 +3650,9 @@ proof -
     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 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 pspace_relations_def swp_cte_at))+
+    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
 
@@ -3794,7 +3764,7 @@ lemma create_reply_master_corres:
   apply clarsimp
   apply (rule corres_caps_decomposition)
                                  defer
-                                 apply (wp|simp)+
+                                 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)
@@ -4166,6 +4136,9 @@ crunches setupReplyMaster
   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]:
@@ -4194,7 +4167,8 @@ lemma setupReplyMaster_invs'[wp]:
   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 valid_queues_lift' hoare_vcg_disj_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
@@ -4455,8 +4429,8 @@ lemma arch_update_setCTE_invs:
   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
+             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)
@@ -5811,7 +5785,7 @@ lemma cteInsert_simple_invs:
   apply (rule hoare_pre)
    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' irqs_masked_lift
+             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
@@ -5950,6 +5924,21 @@ lemma arch_update_updateCap_invs:
   apply clarsimp
   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
@@ -5981,6 +5970,8 @@ lemma updateCap_same_master:
         apply 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
@@ -6207,8 +6198,9 @@ lemma updateFreeIndex_forward_invs':
        apply (simp add:updateCap_def)
        apply (wp setCTE_irq_handlers' getCTE_wp)
       apply (simp add:updateCap_def)
-      apply (wp irqs_masked_lift valid_queues_lift' cur_tcb_lift ct_idle_or_in_cur_domain'_lift
+      apply (wp irqs_masked_lift cur_tcb_lift ct_idle_or_in_cur_domain'_lift
                 hoare_vcg_disj_lift untyped_ranges_zero_lift getCTE_wp
+                sym_heap_sched_pointers_lift valid_bitmaps_lift
                | wp (once) hoare_use_eq[where f="gsUntypedZeroRanges"]
                | simp add: getSlotCap_def)+
   apply (clarsimp simp: cte_wp_at_ctes_of fun_upd_def[symmetric])
diff --git a/proof/refine/ARM/Detype_R.thy b/proof/refine/ARM/Detype_R.thy
index e9dbf8de1e..abd93e2cc6 100644
--- a/proof/refine/ARM/Detype_R.thy
+++ b/proof/refine/ARM/Detype_R.thy
@@ -567,7 +567,6 @@ lemma sym_refs_ko_wp_atD:
 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 =
@@ -585,8 +584,9 @@ context delete_locale begin interpretation Arch . (*FIXME: arch_split*)
 lemma valid_objs: "valid_objs' s'"
   and        pa: "pspace_aligned' s'"
   and        pd: "pspace_distinct' s'"
-  and        vq: "valid_queues s'"
-  and       vq': "valid_queues' s'"
+  and       vbm: "valid_bitmaps s'"
+  and sym_sched: "sym_heap_sched_pointers s'"
+  and       vsp: "valid_sched_pointers s'"
   and  sym_refs: "sym_refs (state_refs_of' s')"
   and    iflive: "if_live_then_nonz_cap' s'"
   and  ifunsafe: "if_unsafe_then_cap' s'"
@@ -792,7 +792,6 @@ lemma refs_notRange:
   apply (rule refs_of_live')
   apply clarsimp
   done
-
 end
 
 context begin interpretation Arch . (*FIXME: arch_split*)
@@ -888,6 +887,70 @@ crunches doMachineOp
   for deletionIsSafe_delete_locale[wp]: "deletionIsSafe_delete_locale base magnitude"
   (simp: deletionIsSafe_delete_locale_def)
 
+lemma detype_tcbSchedNexts_of:
+  "\<lbrakk>pspace_aligned' s'; pspace_distinct' 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) |> tcb_of' |> tcbSchedNext)
+       = tcbSchedNexts_of s'"
+  using pspace_alignedD' pspace_distinctD'
+  apply (clarsimp simp: opt_map_def)
+  apply (rule ext)
+  apply (rename_tac s)
+  apply (clarsimp simp: ko_wp_at'_def projectKOs split: option.splits)
+  apply (drule_tac x=s in spec)
+  apply force
+  done
+
+lemma detype_tcbSchedPrevs_of:
+  "\<lbrakk>pspace_aligned' s'; pspace_distinct' 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) |> tcb_of' |> tcbSchedPrev)
+       = tcbSchedPrevs_of s'"
+  using pspace_alignedD' pspace_distinctD'
+  using pspace_alignedD' pspace_distinctD'
+  apply (clarsimp simp: opt_map_def)
+  apply (rule ext)
+  apply (rename_tac s)
+  apply (clarsimp simp: ko_wp_at'_def projectKOs split: option.splits)
+  apply (drule_tac x=s in spec)
+  apply force
+  done
+
+lemma detype_inQ:
+  "\<lbrakk>pspace_aligned' s'; pspace_distinct' s'; \<forall>p. p \<in> S \<longrightarrow> \<not> ko_wp_at' live' p s'\<rbrakk>
+   \<Longrightarrow> \<forall>d p. (inQ d p |< ((\<lambda>x. if x \<in> S then None else ksPSpace s' x) |> tcb_of'))
+             = (inQ d p |< tcbs_of' s')"
+  using pspace_alignedD' pspace_distinctD'
+  using pspace_alignedD' pspace_distinctD'
+  apply (clarsimp simp: opt_map_def)
+  apply (rule ext)
+  apply (rename_tac s)
+  apply (clarsimp simp: inQ_def opt_pred_def ko_wp_at'_def projectKOs split: option.splits)
+  apply (drule_tac x=s in spec)
+  apply force
+  done
+
+lemma detype_ready_queues_relation:
+  "\<lbrakk>pspace_aligned' s'; pspace_distinct' s';
+    \<forall>p. p \<in> {lower..upper} \<longrightarrow> \<not> ko_wp_at' live' p s';
+    ready_queues_relation s s'; upper = upper'\<rbrakk>
+   \<Longrightarrow> ready_queues_relation_2
+        (ready_queues (detype {lower..upper'} s))
+        (ksReadyQueues s')
+        ((\<lambda>x. if lower \<le> x \<and> x \<le> upper then None
+              else ksPSpace s' x) |>
+         tcb_of' |>
+         tcbSchedNext)
+        ((\<lambda>x. if lower \<le> x \<and> x \<le> upper then None
+              else ksPSpace s' x) |>
+         tcb_of' |>
+         tcbSchedPrev)
+        (\<lambda>d p. inQ d p |< ((\<lambda>x. if lower \<le> x \<and> x \<le> upper then None else ksPSpace s' x) |> tcb_of'))"
+  apply (clarsimp simp: detype_ext_def ready_queues_relation_def Let_def)
+  apply (frule (1) detype_tcbSchedNexts_of[where S="{lower..upper}"]; simp)
+  apply (frule (1) detype_tcbSchedPrevs_of[where S="{lower..upper}"]; simp)
+  apply (frule (1) detype_inQ[where S="{lower..upper}"]; simp)
+  apply (fastforce simp add: detype_def detype_ext_def)
+  done
+
 lemma deleteObjects_corres:
   "is_aligned base magnitude \<Longrightarrow> magnitude \<ge> 2 \<Longrightarrow>
    corres dc
@@ -908,11 +971,10 @@ lemma deleteObjects_corres:
   apply (rule corres_stateAssert_implied[where P'=\<top>, simplified])
    prefer 2
    apply clarsimp
-   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 p_assoc_help invs_valid_pspace)[1]
-   apply (simp add:valid_cap_simps)
+   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)
@@ -939,15 +1001,16 @@ lemma deleteObjects_corres:
                              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>
-           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
-         Q'="\<lambda>_ s. s \<turnstile>' capability.UntypedCap d base magnitude idx \<and>
-                        valid_pspace' s" in corres_underlying_split)
+                           (\<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>
+                           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 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])
        apply (rule corres_split[OF _ cNodeNoPartialOverlap])
@@ -960,52 +1023,70 @@ lemma deleteObjects_corres:
     apply (simp add: valid_pspace'_def)
     apply (rule state_relation_null_filterE, assumption,
            simp_all add: pspace_aligned'_cut pspace_distinct'_cut)[1]
-           apply (simp add: detype_def, rule state.equality; simp add: detype_ext_def)
-          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 (drule(4) cte_map_not_null_outside')
-          apply (fastforce simp add: cte_wp_at_caps_of_state)
+         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 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 (fastforce simp add: detype_def detype_ext_def intro!: ekheap_relation_detype)
-     apply (clarsimp simp: state_relation_def ghost_relation_of_heap
-                           detype_def)
+        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 add: ups_of_heap_def cns_of_heap_def ext
-                 split: option.splits kernel_object.splits)[1]
+                    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 | wp (once) hoare_drop_imps)+
   apply fastforce
   done
-
 end
 
 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"
+  apply (case_tac "ko_wp_at' live' 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 invs_valid_idle'[OF invs])
+  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 mask_eq_exp_minus_1)
+  by fastforce
+
+lemma untyped_range_live_idle':
+  "p \<in> base_bits \<Longrightarrow> \<not> (ko_wp_at' live' p s' \<or> p = idle_thread_ptr)"
+  using live_idle_untyped_range' by blast
+
 lemma valid_obj':
-  "\<lbrakk> valid_obj' obj s'; ko_wp_at' ((=) obj) p s' \<rbrakk> \<Longrightarrow> valid_obj' obj state'"
+  "\<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 (rename_tac endpoint)
       apply (case_tac endpoint, simp_all add: valid_ep'_def)[1]
@@ -1032,10 +1113,23 @@ lemma valid_obj':
      apply (erule(2) cte_wp_at_tcbI')
       apply fastforce
      apply simp
-    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 (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])
@@ -1051,6 +1145,40 @@ lemma valid_obj':
   apply (case_tac pde, simp_all add: valid_mapping'_def)
   done
 
+lemma tcbSchedNexts_of_pspace':
+  "\<lbrakk>pspace_aligned' s'; pspace_distinct' s'; pspace_distinct' state'\<rbrakk>
+   \<Longrightarrow> (pspace' |> tcb_of' |> tcbSchedNext) = tcbSchedNexts_of s'"
+  supply projectKOs[simp]
+  apply (rule ext)
+  apply (rename_tac p)
+  apply (case_tac "p \<in> base_bits")
+   apply (frule untyped_range_live_idle')
+   apply (clarsimp simp: opt_map_def)
+   apply (case_tac "ksPSpace s' p"; clarsimp)
+   apply (rename_tac obj)
+   apply (case_tac "tcb_of' obj"; clarsimp)
+   apply (clarsimp simp: ko_wp_at'_def obj_at'_def)
+   apply (fastforce dest: pspace_alignedD' pspace_distinctD')
+  apply (clarsimp simp: opt_map_def split: option.splits)
+  done
+
+lemma tcbSchedPrevs_of_pspace':
+  "\<lbrakk>pspace_aligned' s'; pspace_distinct' s'; pspace_distinct' state'\<rbrakk>
+   \<Longrightarrow> (pspace' |> tcb_of' |> tcbSchedPrev) = tcbSchedPrevs_of s'"
+  supply projectKOs[simp]
+  apply (rule ext)
+  apply (rename_tac p)
+  apply (case_tac "p \<in> base_bits")
+   apply (frule untyped_range_live_idle')
+   apply (clarsimp simp: opt_map_def)
+   apply (case_tac "ksPSpace s' p"; clarsimp)
+   apply (rename_tac obj)
+   apply (case_tac "tcb_of' obj"; clarsimp)
+   apply (clarsimp simp: ko_wp_at'_def obj_at'_def)
+   apply (fastforce simp: pspace_alignedD' pspace_distinctD')
+  apply (clarsimp simp: opt_map_def split: option.splits)
+  done
+
 lemma st_tcb:
   "\<And>P p. \<lbrakk> st_tcb_at' P p s'; \<not> P Inactive; \<not> P IdleThreadState \<rbrakk> \<Longrightarrow> st_tcb_at' P p state'"
   by (fastforce simp: pred_tcb_at'_def obj_at'_real_def projectKOs dest: live_notRange)
@@ -1257,17 +1385,18 @@ proof (simp add: invs'_def valid_state'_def valid_pspace'_def
   show "pspace_aligned' ?s" using pa
     by (simp add: pspace_aligned'_def dom_def)
 
-  show "pspace_distinct' ?s" using pd
+  show pspace_distinct'_state': "pspace_distinct' ?s" using pd
     by (clarsimp simp add: pspace_distinct'_def ps_clear_def
                            dom_if_None Diff_Int_distrib)
 
-  show "valid_objs' ?s" using valid_objs
+  show "valid_objs' ?s" using valid_objs sym_sched
     apply (clarsimp simp: valid_objs'_def ran_def)
     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
+     apply (frule pspace_alignedD'[OF _ pa])
+     apply (frule pspace_distinctD'[OF _ pd])
+     apply (clarsimp simp: ko_wp_at'_def)
+    apply fastforce
     done
 
   from sym_refs show "sym_refs (state_refs_of' ?s)"
@@ -1279,19 +1408,6 @@ proof (simp add: invs'_def valid_state'_def valid_pspace'_def
     apply (simp add: refs_notRange[simplified] state_refs_ko_wp_at_eq)
     done
 
-  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)
-    done
-
-  from vq' show "valid_queues' ?s"
-    by (simp add: valid_queues'_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)
@@ -1550,6 +1666,20 @@ proof (simp add: invs'_def valid_state'_def valid_pspace'_def
     apply simp
     done
 
+  from vbm
+  show "valid_bitmaps state'"
+    by (simp add: valid_bitmaps_def bitmapQ_defs)
+
+  from sym_sched
+  show "sym_heap (pspace' |> tcb_of' |> tcbSchedNext) (pspace' |> tcb_of' |> tcbSchedPrev)"
+    using pa pd pspace_distinct'_state'
+    by (fastforce simp: tcbSchedNexts_of_pspace' tcbSchedPrevs_of_pspace')
+
+  from vsp show "valid_sched_pointers_2 (pspace' |> tcb_of' |> tcbSchedPrev)
+                                        (pspace' |> tcb_of' |> tcbSchedNext)
+                                        (tcbQueued |< (pspace' |> tcb_of'))"
+    by (clarsimp simp: valid_sched_pointers_def opt_pred_def opt_map_def)
+
 qed (clarsimp)
 
 lemma (in delete_locale) delete_ko_wp_at':
@@ -4670,7 +4800,6 @@ lemma createTCBs_tcb_at':
     apply simp
    apply simp
   apply (clarsimp simp: retype_obj_at_disj')
-  apply (clarsimp simp: projectKO_opt_tcb)
   apply (clarsimp simp: new_cap_addrs_def image_def)
   apply (drule_tac x = "unat x" in bspec)
    apply (simp add:objBits_simps' shiftl_t2n)
diff --git a/proof/refine/ARM/Finalise_R.thy b/proof/refine/ARM/Finalise_R.thy
index 1ccfbae968..4a7d071453 100644
--- a/proof/refine/ARM/Finalise_R.thy
+++ b/proof/refine/ARM/Finalise_R.thy
@@ -76,20 +76,10 @@ crunch ksRQL1[wp]: emptySlot "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
 crunch ksRQL2[wp]: emptySlot "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
 crunch obj_at'[wp]: postCapDeletion "obj_at' P p"
 
-lemmas postCapDeletion_valid_queues[wp] =
-    valid_queues_lift [OF postCapDeletion_obj_at'
-                          postCapDeletion_pred_tcb_at'
-                          postCapDeletion_ksRQ]
-
 crunch inQ[wp]: clearUntypedFreeIndex "\<lambda>s. P (obj_at' (inQ d p) t s)"
 crunch tcbDomain[wp]: clearUntypedFreeIndex "obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t"
 crunch tcbPriority[wp]: clearUntypedFreeIndex "obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t"
 
-lemma emptySlot_queues [wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> emptySlot sl opt \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  unfolding emptySlot_def
-  by (wp | wpcw | wp valid_queues_lift | simp)+
-
 crunch nosch[wp]: emptySlot "\<lambda>s. P (ksSchedulerAction s)"
 crunch ksCurDomain[wp]: emptySlot "\<lambda>s. P (ksCurDomain s)"
 
@@ -1162,8 +1152,7 @@ definition
  "removeable' sl \<equiv> \<lambda>s cap.
     (\<exists>p. p \<noteq> sl \<and> cte_wp_at' (\<lambda>cte. capMasterCap (cteCap cte) = capMasterCap cap) p s)
     \<or> ((\<forall>p \<in> cte_refs' cap (irq_node' s). p \<noteq> sl \<longrightarrow> cte_wp_at' (\<lambda>cte. cteCap cte = NullCap) p s)
-         \<and> (\<forall>p \<in> zobj_refs' cap. ko_wp_at' (Not \<circ> live') p s)
-         \<and> (\<forall>t \<in> threadCapRefs cap. \<forall>p. t \<notin> set (ksReadyQueues s p)))"
+         \<and> (\<forall>p \<in> zobj_refs' cap. ko_wp_at' (Not \<circ> live') p s))"
 
 lemma not_Final_removeable:
   "\<not> isFinal cap sl (cteCaps_of s)
@@ -1354,11 +1343,6 @@ crunch irq_states' [wp]: emptySlot valid_irq_states'
 crunch no_0_obj' [wp]: emptySlot no_0_obj'
  (wp: crunch_wps)
 
-crunch valid_queues'[wp]: setInterruptState "valid_queues'"
-  (simp: valid_queues'_def)
-
-crunch valid_queues'[wp]: emptySlot "valid_queues'"
-
 crunch pde_mappings'[wp]: emptySlot "valid_pde_mappings'"
 end
 
@@ -1445,6 +1429,13 @@ lemma emptySlot_untyped_ranges[wp]:
   apply (simp add: untypedZeroRange_def isCap_simps)
   done
 
+crunches emptySlot
+  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>
@@ -2240,6 +2231,14 @@ 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)
 
+crunches 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]:
   "\<lbrace>invs'\<rbrace> unbindNotification tcb \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (simp add: unbindNotification_def invs'_def valid_state'_def)
@@ -2248,8 +2247,8 @@ lemma unbindNotification_invs[wp]:
   apply clarsimp
   apply (rule hoare_seq_ext[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
+  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 (clarsimp elim!: obj_atE'
@@ -2291,7 +2290,7 @@ lemma unbindMaybeNotification_invs[wp]:
   apply (simp add: unbindMaybeNotification_def invs'_def valid_state'_def)
   apply (rule hoare_seq_ext[OF _ get_ntfn_sp'])
   apply (rule hoare_pre)
-   apply (wp sbn'_valid_pspace'_inv sbn_sch_act' sbn_valid_queues valid_irq_node_lift
+   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)+
@@ -2486,7 +2485,6 @@ lemma cteDeleteOne_isFinal:
 
 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 setQueue_cteCaps_of[wp] = ctes_of_cteCaps_of_lift [OF setQueue_ctes_of]
 lemmas threadSet_cteCaps_of = ctes_of_cteCaps_of_lift [OF threadSet_ctes_of]
 
 crunch isFinal: suspend, prepareThreadDelete "\<lambda>s. isFinal cap slot (cteCaps_of s)"
@@ -2570,16 +2568,6 @@ lemma unbindNotification_valid_objs'_helper':
   by (clarsimp simp: valid_bound_tcb'_def valid_ntfn'_def
                   split: option.splits ntfn.splits)
 
-lemma typ_at'_valid_tcb'_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_tcb' tcb s\<rbrace> f \<lbrace>\<lambda>rv s. valid_tcb' tcb s\<rbrace>"
-  including no_pre
-  apply (simp add: valid_tcb'_def)
-  apply (case_tac "tcbState tcb", simp_all add: valid_tcb_state'_def split_def valid_bound_ntfn'_def)
-         apply (wp hoare_vcg_const_Ball_lift typ_at_lifts[OF P]
-               | case_tac "tcbBoundNotification tcb", simp_all)+
-  done
-
 lemmas setNotification_valid_tcb' = typ_at'_valid_tcb'_lift [OF setNotification_typ_at']
 
 lemma unbindNotification_valid_objs'[wp]:
@@ -2702,10 +2690,6 @@ lemma unbindNotification_bound_tcb_at':
   apply (wp setBoundNotification_bound_tcb gbn_wp' | wpc | simp)+
   done
 
-crunches unbindNotification, unbindMaybeNotification
-  for valid_queues[wp]: "Invariants_H.valid_queues"
-  (wp: sbn_valid_queues)
-
 crunches unbindNotification, unbindMaybeNotification
   for weak_sch_act_wf[wp]: "\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s"
 
@@ -2725,8 +2709,42 @@ crunch cte_wp_at'[wp]: prepareThreadDelete "cte_wp_at' P p"
 crunch valid_cap'[wp]: prepareThreadDelete "valid_cap' cap"
 crunch invs[wp]: prepareThreadDelete "invs'"
 
+crunches prepareThreadDelete
+  for sched_projs_obj_at'[wp]:
+    "\<lambda>s. obj_at' (\<lambda>tcb. tcbSchedNext tcb = None \<and> tcbSchedPrev tcb = None) t s"
+
 end
 
+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)
+
+crunches updateRestartPC, cancelIPC
+  for valid_sched_pointers[wp]: valid_sched_pointers
+  (simp: crunch_simps wp: crunch_wps)
+
+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)))
@@ -2746,21 +2764,22 @@ 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))))\<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 (wp prepares_delete_helper'' [OF cancelAllIPC_unlive]
              prepares_delete_helper'' [OF cancelAllSignals_unlive]
-             suspend_isFinal prepareThreadDelete_unqueued prepareThreadDelete_nonq
+             suspend_isFinal prepareThreadDelete_unqueued
              prepareThreadDelete_inactive prepareThreadDelete_isFinal
-             suspend_makes_inactive suspend_nonq
+             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]],
@@ -2828,7 +2847,9 @@ lemma cancelIPC_cte_wp_at':
   apply (clarsimp simp: cteCaps_of_def cte_wp_at_ctes_of x)
   done
 
-crunch cte_wp_at'[wp]: tcbSchedDequeue "cte_wp_at' P p"
+crunches tcbSchedDequeue
+  for cte_wp_at'[wp]: "cte_wp_at' P p"
+  (wp: crunch_wps)
 
 lemma suspend_cte_wp_at':
   assumes x: "\<And>cap final. P cap \<Longrightarrow> finaliseCap cap final True = fail"
@@ -2954,25 +2975,6 @@ crunch sch_act_not[wp]: cteDeleteOne "sch_act_not t"
   (simp: crunch_simps case_Null_If unless_def
    wp: crunch_wps getObject_inv loadObject_default_inv)
 
-lemma cancelAllIPC_mapM_x_valid_queues:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. \<forall>t\<in>set q. tcb_at' t s)\<rbrace>
-   mapM_x (\<lambda>t. do
-                 y \<leftarrow> setThreadState Structures_H.thread_state.Restart t;
-                 tcbSchedEnqueue t
-               od) q
-   \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (rule_tac R="\<lambda>_ s. (\<forall>t\<in>set q. tcb_at' t s) \<and> valid_objs' s"
-               in hoare_post_add)
-  apply (rule hoare_pre)
-  apply (rule mapM_x_wp')
-  apply (rule hoare_name_pre_state)
-  apply (wp hoare_vcg_const_Ball_lift
-            tcbSchedEnqueue_valid_queues tcbSchedEnqueue_not_st
-            sts_valid_queues sts_st_tcb_at'_cases setThreadState_not_st
-       | simp
-       | ((elim conjE)?, drule (1) bspec, clarsimp elim!: obj_at'_weakenE simp: valid_tcb_state'_def))+
-  done
-
 lemma cancelAllIPC_mapM_x_weak_sch_act:
   "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
    mapM_x (\<lambda>t. do
@@ -2986,13 +2988,15 @@ lemma cancelAllIPC_mapM_x_weak_sch_act:
   done
 
 lemma cancelAllIPC_mapM_x_valid_objs':
-  "\<lbrace>valid_objs'\<rbrace>
+  "\<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 (wpsimp wp: mapM_x_wp' sts_valid_objs')
+  apply (rule hoare_strengthen_post)
+   apply (rule mapM_x_wp')
+  apply (wpsimp wp: sts_valid_objs')
    apply (clarsimp simp: valid_tcb_state'_def)+
   done
 
@@ -3003,18 +3007,12 @@ lemma cancelAllIPC_mapM_x_tcbDomain_obj_at':
                  tcbSchedEnqueue t
                od) q
   \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
-apply (wp mapM_x_wp' tcbSchedEnqueue_not_st setThreadState_oa_queued | simp)+
-done
+  by (wpsimp wp: mapM_x_wp')
 
 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)
-apply (wp tcbSchedEnqueue_not_st
-     | wpc
-     | simp)+
-done
+  "rescheduleRequired \<lbrace>obj_at' (\<lambda>tcb. Q (tcbDomain tcb) (tcbPriority tcb)) t\<rbrace>"
+  unfolding rescheduleRequired_def tcbSchedEnqueue_def tcbQueuePrepend_def
+  by wpsimp
 
 lemma cancelAllIPC_tcbDomain_obj_at':
   "\<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>
@@ -3028,21 +3026,6 @@ apply (wp hoare_vcg_conj_lift hoare_vcg_const_Ball_lift
      | simp)+
 done
 
-lemma cancelAllIPC_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)\<rbrace>
-   cancelAllIPC ep_ptr
-   \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: cancelAllIPC_def ep'_Idle_case_helper)
-  apply (wp hoare_vcg_conj_lift hoare_vcg_const_Ball_lift
-            cancelAllIPC_mapM_x_valid_queues cancelAllIPC_mapM_x_valid_objs' cancelAllIPC_mapM_x_weak_sch_act
-            set_ep_valid_objs' getEndpoint_wp)
-  apply (clarsimp simp: valid_ep'_def)
-  apply (drule (1) ko_at_valid_objs')
-  apply (auto simp: valid_obj'_def valid_ep'_def valid_tcb'_def projectKOs
-             split: endpoint.splits
-              elim: valid_objs_valid_tcbE)
-  done
-
 lemma cancelAllSignals_tcbDomain_obj_at':
   "\<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>
      cancelAllSignals epptr
@@ -3059,41 +3042,8 @@ 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>"
-  apply (simp add: unbindMaybeNotification_def)
-  apply (wp setBoundNotification_oa_queued getNotification_wp gbn_wp' | wpc | simp)+
-  done
-
-lemma cancelAllSignals_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)\<rbrace>
-   cancelAllSignals ntfn
-   \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: cancelAllSignals_def)
-  apply (rule hoare_seq_ext [OF _ get_ntfn_sp'])
-  apply (case_tac "ntfnObj ntfna", simp_all)
-    apply (wp, simp)+
-    apply (wp hoare_vcg_conj_lift hoare_vcg_const_Ball_lift
-              cancelAllIPC_mapM_x_valid_queues cancelAllIPC_mapM_x_valid_objs' cancelAllIPC_mapM_x_weak_sch_act
-              set_ntfn_valid_objs'
-          | simp)+
-  apply (clarsimp simp: valid_ep'_def)
-  apply (drule (1) ko_at_valid_objs')
-  apply (auto simp: valid_obj'_def valid_ntfn'_def valid_tcb'_def projectKOs
-             split: endpoint.splits
-              elim: valid_objs_valid_tcbE)
-  done
-
-lemma finaliseCapTrue_standin_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)\<rbrace>
-   finaliseCapTrue_standin cap final
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: finaliseCapTrue_standin_def Let_def)
-  apply (safe)
-       apply (wp | clarsimp | wpc)+
-  done
-
-
-crunch valid_queues[wp]: isFinalCapability "Invariants_H.valid_queues"
-  (simp: crunch_simps)
+  unfolding unbindMaybeNotification_def
+  by (wpsimp wp: getNotification_wp gbn_wp' simp: setBoundNotification_def)+
 
 crunch sch_act[wp]: isFinalCapability "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
   (simp: crunch_simps)
@@ -3102,96 +3052,6 @@ crunch weak_sch_act[wp]:
   isFinalCapability "\<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. \<lbrace>obj_at' (inQ d p) tcb\<rbrace> f \<lbrace>\<lambda>_. obj_at' (inQ d p) tcb\<rbrace>"
-  and     prq: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueues s)\<rbrace>"
-  shows   "\<lbrace>valid_inQ_queues\<rbrace> f \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  proof -
-    show ?thesis
-      apply (clarsimp simp: valid_def valid_inQ_queues_def)
-      apply safe
-       apply (rule use_valid [OF _ tat], assumption)
-       apply (drule spec, drule spec, erule conjE, erule bspec)
-       apply (rule ccontr)
-       apply (erule notE[rotated], erule(1) use_valid [OF _ prq])
-      apply (erule use_valid [OF _ prq])
-      apply simp
-      done
-  qed
-
-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)+
-
-crunch valid_inQ_queues[wp]: emptySlot valid_inQ_queues
-  (simp: crunch_simps)
-
-lemma cancelAllIPC_mapM_x_valid_inQ_queues:
-  "\<lbrace>valid_inQ_queues\<rbrace>
-   mapM_x (\<lambda>t. do
-                 y \<leftarrow> setThreadState Structures_H.thread_state.Restart t;
-                 tcbSchedEnqueue t
-               od) q
-   \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (rule mapM_x_wp_inv)
-  apply (wp sts_valid_queues [where st="Structures_H.thread_state.Restart", simplified]
-            setThreadState_st_tcb)
-   done
-
-lemma cancelAllIPC_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace>
-   cancelAllIPC ep_ptr
-   \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (simp add: cancelAllIPC_def ep'_Idle_case_helper)
-  apply (wp cancelAllIPC_mapM_x_valid_inQ_queues)
-  apply (wp hoare_conjI hoare_drop_imp | simp)+
-  done
-
-lemma cancelAllSignals_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace>
-   cancelAllSignals ntfn
-   \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (simp add: cancelAllSignals_def)
-  apply (rule hoare_seq_ext [OF _ get_ntfn_sp'])
-  apply (case_tac "ntfnObj ntfna", simp_all)
-    apply (wp, simp)+
-    apply (wp cancelAllIPC_mapM_x_valid_inQ_queues)+
-   apply (simp)
-  done
-
-crunches unbindNotification, unbindMaybeNotification
-  for valid_inQ_queues[wp]: "valid_inQ_queues"
-
-lemma finaliseCapTrue_standin_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace>
-   finaliseCapTrue_standin cap final
-   \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  apply (simp add: finaliseCapTrue_standin_def Let_def)
-  apply (safe)
-       apply (wp | clarsimp | wpc)+
-  done
-
-crunch valid_inQ_queues[wp]: isFinalCapability valid_inQ_queues
-  (simp: crunch_simps)
-
-lemma cteDeleteOne_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<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)
-  done
-
 crunch ksCurDomain[wp]: cteDeleteOne "\<lambda>s. P (ksCurDomain s)"
   (wp: crunch_wps simp: crunch_simps unless_def)
 
@@ -3435,10 +3295,9 @@ lemma arch_finaliseCap_corres:
 lemma unbindNotification_corres:
   "corres dc
       (invs and tcb_at t)
-      (invs' and tcb_at' t)
+      invs'
       (unbind_notification t)
       (unbindNotification t)"
-  supply option.case_cong_weak[cong]
   apply (simp add: unbind_notification_def unbindNotification_def)
   apply (rule corres_guard_imp)
     apply (rule corres_split[OF getBoundNotification_corres])
@@ -3453,12 +3312,12 @@ lemma unbindNotification_corres:
          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
-                          valid_tcb_def valid_bound_ntfn_def
+                    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
-                         tcb_ntfn_is_bound'_def
+                   simp: valid_obj'_def valid_tcb'_def valid_bound_ntfn'_def tcb_ntfn_is_bound'_def
+                         projectKOs
                   split: option.splits)
   done
 
@@ -3479,11 +3338,11 @@ lemma unbindMaybeNotification_corres:
        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
+                    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 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 valid_ntfn'_def
                   split: option.splits)
   done
@@ -3618,12 +3477,6 @@ lemma arch_recycleCap_improve_cases:
          \<not> isASIDControlCap cap \<rbrakk> \<Longrightarrow> (if isASIDPoolCap cap then v else undefined) = v"
   by (cases cap, simp_all add: isCap_simps)
 
-crunch queues[wp]: copyGlobalMappings "Invariants_H.valid_queues"
-  (wp: crunch_wps ignore: storePDE)
-
-crunch queues'[wp]: copyGlobalMappings "Invariants_H.valid_queues'"
-  (wp: crunch_wps ignore: storePDE)
-
 crunch ifunsafe'[wp]: copyGlobalMappings "if_unsafe_then_cap'"
   (wp: crunch_wps ignore: storePDE)
 
@@ -3672,178 +3525,6 @@ lemma cteCaps_of_ctes_of_lift:
 
 lemmas final_matters'_simps = final_matters'_def [split_simps capability.split arch_capability.split]
 
-definition set_thread_all :: "obj_ref \<Rightarrow> Structures_A.tcb \<Rightarrow> etcb
-                                \<Rightarrow> unit det_ext_monad" where
-  "set_thread_all ptr tcb etcb \<equiv>
-     do s \<leftarrow> get;
-       kh \<leftarrow> return $ (kheap s)(ptr \<mapsto> (TCB tcb));
-       ekh \<leftarrow> return $ (ekheap s)(ptr \<mapsto> etcb);
-       put (s\<lparr>kheap := kh, ekheap := ekh\<rparr>)
-     od"
-
-definition thread_gets_the_all :: "obj_ref \<Rightarrow> (Structures_A.tcb \<times> etcb) det_ext_monad" where
-  "thread_gets_the_all tptr \<equiv>
-          do tcb \<leftarrow> gets_the $ get_tcb tptr;
-             etcb \<leftarrow> gets_the $ get_etcb tptr;
-             return $ (tcb, etcb) od"
-
-definition thread_set_all :: "(Structures_A.tcb \<Rightarrow> Structures_A.tcb) \<Rightarrow> (etcb \<Rightarrow> etcb)
-                  \<Rightarrow> obj_ref \<Rightarrow> unit det_ext_monad" where
-  "thread_set_all f g tptr \<equiv>
-     do (tcb, etcb) \<leftarrow> thread_gets_the_all tptr;
-        set_thread_all tptr (f tcb) (g etcb)
-     od"
-
-lemma set_thread_all_corres:
-  fixes ob' :: "'a :: pspace_storable"
-  assumes x: "updateObject ob' = updateObject_default ob'"
-  assumes z: "\<And>s. obj_at' P ptr s
-               \<Longrightarrow> map_to_ctes ((ksPSpace s) (ptr \<mapsto> injectKO ob')) = map_to_ctes (ksPSpace s)"
-  assumes b: "\<And>ko. P ko \<Longrightarrow> objBits ko = objBits ob'"
-  assumes P: "\<And>(v::'a::pspace_storable). (1 :: word32) < 2 ^ (objBits v)"
-  assumes e: "etcb_relation etcb tcb'"
-  assumes is_t: "injectKO (ob' :: 'a :: pspace_storable) = KOTCB tcb'"
-  shows      "other_obj_relation (TCB tcb) (injectKO (ob' :: 'a :: pspace_storable)) \<Longrightarrow>
-  corres dc (obj_at (same_caps (TCB tcb)) ptr and is_etcb_at ptr)
-            (obj_at' (P :: 'a \<Rightarrow> bool) ptr)
-            (set_thread_all ptr tcb etcb) (setObject ptr ob')"
-  apply (rule corres_no_failI)
-   apply (rule no_fail_pre)
-    apply wp
-    apply (rule x)
-   apply (clarsimp simp: b elim!: obj_at'_weakenE)
-  apply (unfold set_thread_all_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
-                        updateObject_default_def in_magnitude_check [OF _ P])
-  apply (clarsimp simp add: state_relation_def z)
-  apply (simp add: trans_state_update'[symmetric] trans_state_update[symmetric]
-         del: trans_state_update)
-  apply (clarsimp simp add: swp_def fun_upd_def obj_at_def is_etcb_at_def)
-  apply (subst cte_wp_at_after_update,fastforce simp add: obj_at_def)
-  apply (subst caps_of_state_after_update,fastforce simp add: obj_at_def)
-  apply clarsimp
-  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
-                   split: Structures_A.kernel_object.splits if_split_asm)
-
-  apply (fold fun_upd_def)
-  apply (simp only: pspace_relation_def dom_fun_upd2 simp_thms)
-  apply (subst pspace_dom_update)
-    apply assumption
-   apply simp
-  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: is_other_obj_relation_type)
-   apply (drule(1) bspec)
-   apply clarsimp
-   apply (frule_tac ko'="TCB tcb'" and x'=ptr in obj_relation_cut_same_type,
-           (fastforce simp add: is_other_obj_relation_type)+)[1]
-  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 (clarsimp simp: projectKOs)
-  apply (insert e is_t)
-  by (clarsimp simp: other_obj_relation_def etcb_relation_def is_other_obj_relation_type split: Structures_A.kernel_object.splits Structures_H.kernel_object.splits ARM_A.arch_kernel_obj.splits)
-
-lemma tcb_update_all_corres':
-  assumes tcbs: "tcb_relation tcb tcb' \<Longrightarrow> tcb_relation tcbu tcbu'"
-  assumes tables: "\<forall>(getF, v) \<in> ran tcb_cap_cases. getF tcbu = getF tcb"
-  assumes tables': "\<forall>(getF, v) \<in> ran tcb_cte_cases. getF tcbu' = getF tcb'"
-  assumes r: "r () ()"
-  assumes e: "etcb_relation etcb tcb' \<Longrightarrow> etcb_relation etcbu tcbu'"
-  shows "corres r (ko_at (TCB tcb) add and (\<lambda>s. ekheap s add = Some etcb))
-                  (ko_at' tcb' add)
-                  (set_thread_all add tcbu etcbu) (setObject add tcbu')"
-  apply (rule_tac F="tcb_relation tcb tcb' \<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 (force simp: projectKOs other_obj_relation_def ekheap_relation_def e)
-  apply (erule conjE)
-  apply (rule corres_guard_imp)
-    apply (rule corres_rel_imp)
-     apply (rule set_thread_all_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 simp: is_etcb_at_def 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
-  done
-
-lemma thread_gets_the_all_corres:
-  shows      "corres (\<lambda>(tcb, etcb) tcb'. tcb_relation tcb tcb' \<and> etcb_relation etcb tcb')
-                (tcb_at t and is_etcb_at t) (tcb_at' t)
-                (thread_gets_the_all t) (getObject t)"
-  apply (rule corres_no_failI)
-   apply wp
-  apply (clarsimp simp add: gets_def get_def return_def bind_def get_tcb_def thread_gets_the_all_def threadGet_def ethread_get_def gets_the_def assert_opt_def get_etcb_def is_etcb_at_def tcb_at_def liftM_def split: option.splits Structures_A.kernel_object.splits)
-  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 ko)
-   apply (simp_all add: fail_def return_def)
-  apply (clarsimp simp add: state_relation_def pspace_relation_def ekheap_relation_def)
-  apply (drule bspec)
-   apply clarsimp
-   apply blast
-  apply (drule bspec, erule domI)
-  apply (clarsimp simp add: other_obj_relation_def
-                            lookupAround2_known1)
-  done
-
-lemma thread_set_all_corresT:
-  assumes x: "\<And>tcb tcb'. tcb_relation tcb tcb' \<Longrightarrow>
-                         tcb_relation (f tcb) (f' tcb')"
-  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"
-  assumes e: "\<And>etcb tcb'. etcb_relation etcb tcb' \<Longrightarrow>
-                         etcb_relation (g etcb) (f' tcb')"
-  shows      "corres dc (tcb_at t and valid_etcbs)
-                        (tcb_at' t)
-                    (thread_set_all f g t) (threadSet f' t)"
-  apply (simp add: thread_set_all_def threadSet_def bind_assoc)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF thread_gets_the_all_corres])
-      apply (simp add: split_def)
-      apply (rule tcb_update_all_corres')
-          apply (erule x)
-         apply (rule y)
-        apply (clarsimp simp: bspec_split [OF spec [OF z]])
-       apply fastforce
-      apply (erule e)
-     apply (simp add: thread_gets_the_all_def, wp+)
-   apply clarsimp
-   apply (frule(1) tcb_at_is_etcb_at)
-   apply (clarsimp simp add: tcb_at_def get_etcb_def obj_at_def)
-   apply (drule get_tcb_SomeD)
-   apply fastforce
-  apply simp
-  done
-
-lemmas thread_set_all_corres =
-    thread_set_all_corresT [OF _ _ all_tcbI, OF _ ball_tcb_cap_casesI ball_tcb_cte_casesI]
-
 crunch idle_thread[wp]: deleteCallerCap "\<lambda>s. P (ksIdleThread s)"
   (wp: crunch_wps)
 crunch sch_act_simple: deleteCallerCap sch_act_simple
@@ -3861,89 +3542,6 @@ lemma setEndpoint_sch_act_not_ct[wp]:
    setEndpoint ptr val \<lbrace>\<lambda>_ s. sch_act_not (ksCurThread s) s\<rbrace>"
   by (rule hoare_weaken_pre, wps setEndpoint_ct', wp, simp)
 
-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
-
-lemma cancelAllIPC_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>
-   cancelAllIPC epptr
-   \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  (is "\<lbrace>?PRE\<rbrace> _ \<lbrace>\<lambda>_. ?POST\<rbrace>")
-  apply (simp add: cancelAllIPC_def)
-  apply (wp, wpc, wp)
-        apply (wps rescheduleRequired_ct')
-        apply (wp rescheduleRequired_ksQ')
-       apply clarsimp
-       apply (wp cancelAll_ct_not_ksQ_helper mapM_x_wp_inv)
-      apply (wp hoare_lift_Pf2 [OF setEndpoint_ksQ setEndpoint_ct'])+
-      apply (wps rescheduleRequired_ct')
-      apply (wp rescheduleRequired_ksQ')
-     apply clarsimp
-     apply (wp cancelAll_ct_not_ksQ_helper mapM_x_wp_inv)
-    apply (wp hoare_lift_Pf2 [OF setEndpoint_ksQ setEndpoint_ct'])+
-   prefer 2
-   apply assumption
-  apply (rule_tac Q="\<lambda>ep. ?PRE and ko_at' ep epptr" in hoare_post_imp)
-   apply (clarsimp)
-   apply (rule conjI)
-    apply ((clarsimp simp: invs'_def valid_state'_def
-                           sch_act_sane_def
-            | drule(1) ct_not_in_epQueue)+)[2]
-  apply (wp get_ep_sp')
-  done
-
-lemma cancelAllSignals_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>
-   cancelAllSignals ntfnptr
-   \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  (is "\<lbrace>?PRE\<rbrace> _ \<lbrace>\<lambda>_. ?POST\<rbrace>")
-  apply (simp add: cancelAllSignals_def)
-  apply (wp, wpc, wp+)
-      apply (wps rescheduleRequired_ct')
-      apply (wp rescheduleRequired_ksQ')
-     apply clarsimp
-     apply (wp cancelAll_ct_not_ksQ_helper mapM_x_wp_inv)
-    apply (wp hoare_lift_Pf2 [OF setNotification_ksQ setNotification_ksCurThread])
-    apply (wps setNotification_ksCurThread, wp)
-   prefer 2
-   apply assumption
-  apply (rule_tac Q="\<lambda>ep. ?PRE and ko_at' ep ntfnptr" in hoare_post_imp)
-   apply ((clarsimp simp: invs'_def valid_state'_def sch_act_sane_def
-          | drule(1) ct_not_in_ntfnQueue)+)[1]
-  apply (wp get_ntfn_sp')
-  done
-
-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 hoare_seq_ext[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 setNotification_ksCurThread, wp)
-  apply clarsimp
-  done
-
 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)
@@ -3976,37 +3574,6 @@ crunches unbindNotification, unbindMaybeNotification
   for sch_act_sane[wp]: "sch_act_sane"
 end
 
-lemma finaliseCapTrue_standin_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>
-   finaliseCapTrue_standin cap final
-   \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: finaliseCapTrue_standin_def Let_def)
-  apply (safe)
-      apply (wp cancelAllIPC_ct_not_ksQ cancelAllSignals_ct_not_ksQ
-                hoare_drop_imps unbindMaybeNotification_ct_not_ksQ
-             | wpc
-             | clarsimp simp: isNotificationCap_def isReplyCap_def split:capability.splits)+
-  done
-
-lemma cteDeleteOne_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>
-   cteDeleteOne slot
-   \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: cteDeleteOne_def unless_def split_def)
-  apply (rule hoare_seq_ext [OF _ getCTE_sp])
-  apply (case_tac "\<forall>final. finaliseCap (cteCap cte) final True = fail")
-   apply (simp add: finaliseCapTrue_standin_simple_def)
-   apply wp
-   apply (clarsimp)
-  apply (wp emptySlot_cteCaps_of hoare_lift_Pf2 [OF emptySlot_ksRQ emptySlot_ct])
-    apply (simp add: cteCaps_of_def)
-    apply (wp (once) hoare_drop_imps)
-    apply (wp finaliseCapTrue_standin_ct_not_ksQ isFinalCapability_inv)+
-  apply (clarsimp)
-  done
-
 end
 
 end
diff --git a/proof/refine/ARM/Init_R.thy b/proof/refine/ARM/Init_R.thy
index 0a530b3998..6192b6c601 100644
--- a/proof/refine/ARM/Init_R.thy
+++ b/proof/refine/ARM/Init_R.thy
@@ -95,7 +95,7 @@ definition zeroed_intermediate_state ::
     ksDomSchedule = [],
     ksCurDomain = 0,
     ksDomainTime = 0,
-    ksReadyQueues = K [],
+    ksReadyQueues = K (TcbQueue None None),
     ksReadyQueuesL1Bitmap = K 0,
     ksReadyQueuesL2Bitmap = K 0,
     ksCurThread = 0,
@@ -116,9 +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: ekheap_relation_def)
-         apply (clarsimp simp: ready_queues_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 5d5bd979c7..d01a725e25 100644
--- a/proof/refine/ARM/InterruptAcc_R.thy
+++ b/proof/refine/ARM/InterruptAcc_R.thy
@@ -52,14 +52,13 @@ lemma setIRQState_invs[wp]:
   apply (simp add: setIRQState_def setInterruptState_def getInterruptState_def)
   apply (wp dmo_maskInterrupt)
   apply (clarsimp simp: invs'_def valid_state'_def cur_tcb'_def
-                        Invariants_H.valid_queues_def valid_queues'_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)
+                        bitmapQ_defs valid_bitmaps_def)
   apply (rule conjI, clarsimp)
   apply (clarsimp simp: irqs_masked'_def ct_not_inQ_def)
   apply (rule conjI)
@@ -149,8 +148,7 @@ lemma invs'_irq_state_independent [simp, intro!]:
           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_queues_no_bitmap_def
-          valid_queues'_def valid_pde_mappings'_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
diff --git a/proof/refine/ARM/Interrupt_R.thy b/proof/refine/ARM/Interrupt_R.thy
index 7394b96018..cd04d7b08d 100644
--- a/proof/refine/ARM/Interrupt_R.thy
+++ b/proof/refine/ARM/Interrupt_R.thy
@@ -617,13 +617,6 @@ lemma decDomainTime_corres:
   apply (clarsimp simp:state_relation_def)
   done
 
-lemma tcbSchedAppend_valid_objs':
-  "\<lbrace>valid_objs'\<rbrace>tcbSchedAppend t \<lbrace>\<lambda>r. valid_objs'\<rbrace>"
-  apply (simp add:tcbSchedAppend_def)
-  apply (wpsimp wp: unless_wp threadSet_valid_objs' threadGet_wp)
-  apply (clarsimp simp add:obj_at'_def typ_at'_def)
-  done
-
 lemma thread_state_case_if:
  "(case state of Structures_A.thread_state.Running \<Rightarrow> f | _ \<Rightarrow> g) =
   (if state = Structures_A.thread_state.Running then f else g)"
@@ -634,35 +627,27 @@ lemma threadState_case_if:
   (if state = Structures_H.thread_state.Running then f else g)"
   by (case_tac state,auto)
 
-lemma tcbSchedAppend_invs_but_ct_not_inQ':
-  "\<lbrace>invs' and st_tcb_at' runnable' t \<rbrace>
-   tcbSchedAppend t \<lbrace>\<lambda>_. all_invs_but_ct_not_inQ'\<rbrace>"
-  apply (simp add: invs'_def valid_state'_def)
-  apply (rule hoare_pre)
-   apply (wp 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
-        | fastforce elim!: st_tcb_ex_cap'' split: thread_state.split_asm)+
-  done
+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 timerTick_corres:
-  "corres dc (cur_tcb and valid_sched)
-             invs'
-             timer_tick timerTick"
-  supply if_weak_cong[cong]
+  "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="\<top> and (cur_tcb and valid_sched)" and Q'="\<top> and invs'" in corres_guard_imp)
+  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_split[where r' = dc])
              apply (rule corres_if[where Q = \<top> and Q' = \<top>])
                apply (case_tac state,simp_all)[1]
-              apply (simp add: Let_def)
               apply (rule_tac r'="(=)" in corres_split[OF ethreadget_corres])
                  apply (simp add:etcb_relation_def)
                 apply (rename_tac ts ts')
@@ -672,55 +657,53 @@ lemma timerTick_corres:
                  apply (rule ethread_set_corres, simp+)
                  apply (clarsimp simp: etcb_relation_def)
                 apply simp
-                apply (rule corres_split)
-                   apply (rule ethread_set_corres; simp)
-                   apply (simp add: etcb_relation_def)
-                  apply (rule corres_split[OF tcbSchedAppend_corres])
+                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)[1]
-                  apply (rule hoare_strengthen_post)
-                   apply (rule tcbSchedAppend_invs_but_ct_not_inQ',
-                          clarsimp simp: sch_act_wf_weak)
-                 apply (wp threadSet_timeslice_invs threadSet_valid_queues
-                           threadSet_valid_queues' threadSet_pred_tcb_at_state)+
-             apply simp
-            apply simp
-            apply (rule corres_when,simp)
+                   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 (simp add:dec_domain_time_def)
-             apply wp+
-            apply (simp add:decDomainTime_def)
-            apply wp
-           apply (wp|wpc|unfold Let_def|simp)+
-              apply (wp hoare_weak_lift_imp threadSet_timeslice_invs threadSet_valid_queues  threadSet_valid_queues'
-                 threadSet_pred_tcb_at_state threadSet_weak_sch_act_wf tcbSchedAppend_valid_objs'
-                 rescheduleRequired_weak_sch_act_wf tcbSchedAppend_valid_queues| simp)+
-              apply (strengthen sch_act_wf_weak)
-              apply (clarsimp simp:conj_comms)
-              apply (wp tcbSchedAppend_valid_queues tcbSchedAppend_sch_act_wf)
-             apply simp
-             apply (wp threadSet_valid_queues threadSet_pred_tcb_at_state threadSet_sch_act
-              threadSet_tcbDomain_triv threadSet_valid_queues' threadSet_valid_objs'| simp)+
-           apply (wp threadGet_wp gts_wp gts_wp')+
-     apply (clarsimp simp: cur_tcb_def tcb_at_is_etcb_at valid_sched_def valid_sched_action_def)
-    prefer 2
-    apply clarsimp
-   apply (clarsimp simp add:cur_tcb_def valid_sched_def
-       valid_sched_action_def valid_etcbs_def is_tcb_def
-       is_etcb_at_def st_tcb_at_def obj_at_def
-       dest!:get_tcb_SomeD)
-   apply (clarsimp simp: invs'_def valid_state'_def
-   sch_act_wf_weak
-   cur_tcb'_def inQ_def
-   ct_in_state'_def obj_at'_def)
-   apply (clarsimp simp:st_tcb_at'_def
-      valid_idle'_def ct_idle_or_in_cur_domain'_def
-      obj_at'_def projectKO_eq)
-  apply simp
+             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]
@@ -772,7 +755,7 @@ lemma handleInterrupt_corres:
       apply (rule corres_machine_op)
       apply (rule corres_eq_trivial, (simp add: no_fail_ackInterrupt)+)
      apply wp+
-   apply clarsimp
+   apply fastforce
   apply clarsimp
   done
 
@@ -801,16 +784,6 @@ lemma updateTimeSlice_sch_act_wf[wp]:
    \<lbrace>\<lambda>r s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
   by (wp threadSet_sch_act,simp)
 
-
-lemma updateTimeSlice_valid_queues[wp]:
-  "\<lbrace>\<lambda>s. Invariants_H.valid_queues s \<rbrace>
-   threadSet (tcbTimeSlice_update (\<lambda>_. ts')) thread
-   \<lbrace>\<lambda>r s. Invariants_H.valid_queues s\<rbrace>"
-  apply (wp threadSet_valid_queues,simp)
-  apply (clarsimp simp:obj_at'_def inQ_def)
-  done
-
-
 (* catch up tcbSchedAppend to tcbSchedEnqueue, which has these from crunches on possibleSwitchTo *)
 crunch irq_handlers'[wp]: tcbSchedAppend valid_irq_handlers'
   (simp: unless_def tcb_cte_cases_def wp: crunch_wps)
@@ -820,29 +793,29 @@ crunch ct[wp]: tcbSchedAppend cur_tcb'
   (wp: cur_tcb_lift crunch_wps)
 
 lemma timerTick_invs'[wp]:
-  "\<lbrace>invs'\<rbrace> timerTick \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  "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
-                    tcbSchedAppend_invs_but_ct_not_inQ'
-                simp: tcb_cte_cases_def)
-     apply (rule_tac Q="\<lambda>rv. invs'" in hoare_post_imp)
-     apply (clarsimp simp add:invs'_def valid_state'_def)
+              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'
-                          del: tcbSchedAppend_sch_act_wf)+
-             apply (rule hoare_strengthen_post[OF tcbSchedAppend_invs_but_ct_not_inQ'])
-             apply (wpsimp simp: valid_pspace'_def sch_act_wf_weak)+
-           apply (wpsimp wp: threadSet_pred_tcb_no_state threadSet_tcbDomain_triv
-                             threadSet_valid_objs' threadSet_timeslice_invs)+
-       apply (wp threadGet_wp)
+            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 (clarsimp simp: invs'_def st_tcb_at'_def obj_at'_def valid_state'_def)
+  apply (auto simp: invs'_def st_tcb_at'_def obj_at'_def valid_state'_def cong: conj_cong)
   done
 
 lemma resetTimer_invs'[wp]:
diff --git a/proof/refine/ARM/InvariantUpdates_H.thy b/proof/refine/ARM/InvariantUpdates_H.thy
index 938a45b494..1e6db0685c 100644
--- a/proof/refine/ARM/InvariantUpdates_H.thy
+++ b/proof/refine/ARM/InvariantUpdates_H.thy
@@ -38,8 +38,9 @@ lemma invs'_machine:
 proof -
   show ?thesis
     apply (cases "ksSchedulerAction s")
-    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_queues_def valid_queues_no_bitmap_def bitmapQ_defs
+    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
@@ -56,12 +57,13 @@ lemma invs_no_cicd'_machine:
 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_queues_def valid_queues_no_bitmap_def bitmapQ_defs
-                    vms ct_not_inQ_def
-                    state_refs_of'_def ps_clear_def
-                    valid_irq_node'_def mask
-              cong: option.case_cong)
+    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)
     done
 qed
 
@@ -98,14 +100,9 @@ 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_queues_ksSchedulerAction_update[simp]:
-  "valid_queues (ksSchedulerAction_update f s) = valid_queues s"
- unfolding valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs
- by simp
-
-lemma valid_queues'_ksSchedulerAction_update[simp]:
-  "valid_queues' (ksSchedulerAction_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_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'"
@@ -140,45 +137,25 @@ lemma tcb_in_cur_domain_ct[simp]:
   "tcb_in_cur_domain' t  (ksCurThread_update f s) = tcb_in_cur_domain' t s"
   by (fastforce simp: tcb_in_cur_domain'_def)
 
-lemma valid_queues'_ksCurDomain[simp]:
-  "valid_queues' (ksCurDomain_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
-
-lemma valid_queues'_ksDomScheduleIdx[simp]:
-  "valid_queues' (ksDomScheduleIdx_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
+lemma valid_bitmaps_ksCurDomain[simp]:
+  "valid_bitmaps (ksCurDomain_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
 
-lemma valid_queues'_ksDomSchedule[simp]:
-  "valid_queues' (ksDomSchedule_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
+lemma valid_bitmaps_ksDomScheduleIdx[simp]:
+  "valid_bitmaps (ksDomScheduleIdx_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
 
-lemma valid_queues'_ksDomainTime[simp]:
-  "valid_queues' (ksDomainTime_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
+lemma valid_bitmaps_ksDomSchedule[simp]:
+   "valid_bitmaps (ksDomSchedule_update f s) = valid_bitmaps s"
+   by (simp add: valid_bitmaps_def bitmapQ_defs)
 
-lemma valid_queues'_ksWorkUnitsCompleted[simp]:
-  "valid_queues' (ksWorkUnitsCompleted_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
+lemma valid_bitmaps_ksDomainTime[simp]:
+  "valid_bitmaps (ksDomainTime_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
 
-lemma valid_queues_ksCurDomain[simp]:
-  "valid_queues (ksCurDomain_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
-
-lemma valid_queues_ksDomScheduleIdx[simp]:
-  "valid_queues (ksDomScheduleIdx_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
-
-lemma valid_queues_ksDomSchedule[simp]:
-  "valid_queues (ksDomSchedule_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
-
-lemma valid_queues_ksDomainTime[simp]:
-  "valid_queues (ksDomainTime_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
-
-lemma valid_queues_ksWorkUnitsCompleted[simp]:
-  "valid_queues (ksWorkUnitsCompleted_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
+lemma valid_bitmaps_ksWorkUnitsCompleted[simp]:
+  "valid_bitmaps (ksWorkUnitsCompleted_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
 
 lemma valid_irq_node'_ksCurDomain[simp]:
   "valid_irq_node' w (ksCurDomain_update f s) = valid_irq_node' w s"
@@ -255,6 +232,10 @@ lemma valid_mdb_interrupts'[simp]:
   "valid_mdb' (ksInterruptState_update f s) = valid_mdb' s"
   by (simp add: valid_mdb'_def)
 
+lemma valid_mdb'_ksReadyQueues_update[simp]:
+  "valid_mdb' (ksReadyQueues_update f s) = valid_mdb' s"
+  by (simp add: valid_mdb'_def)
+
 lemma vms_ksReadyQueues_update[simp]:
   "valid_machine_state' (ksReadyQueues_update f s) = valid_machine_state' s"
   by (simp add: valid_machine_state'_def)
@@ -279,10 +260,10 @@ lemma ct_in_state_ksSched[simp]:
 
 lemma invs'_wu [simp]:
   "invs' (ksWorkUnitsCompleted_update f s) = invs' s"
-  apply (simp add: invs'_def cur_tcb'_def valid_state'_def Invariants_H.valid_queues_def
-                   valid_queues'_def valid_irq_node'_def valid_machine_state'_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 valid_queues_no_bitmap_def)
+                   bitmapQ_defs)
   done
 
 lemma valid_arch_state'_interrupt[simp]:
@@ -334,9 +315,8 @@ lemma sch_act_simple_ksReadyQueuesL2Bitmap[simp]:
 
 lemma ksDomainTime_invs[simp]:
   "invs' (ksDomainTime_update f s) = invs' s"
-  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)
+  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"
@@ -364,9 +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 valid_state'_def valid_queues_def valid_queues'_def
-                      valid_irq_node'_def cur_tcb'_def ct_idle_or_in_cur_domain'_def
-                      tcb_in_cur_domain'_def valid_queues_no_bitmap_def
-                      bitmapQ_no_L2_orphans_def bitmapQ_no_L1_orphans_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
\ No newline at end of file
diff --git a/proof/refine/ARM/Invariants_H.thy b/proof/refine/ARM/Invariants_H.thy
index 70718807a6..cd883e784f 100644
--- a/proof/refine/ARM/Invariants_H.thy
+++ b/proof/refine/ARM/Invariants_H.thy
@@ -10,6 +10,7 @@ imports
   "AInvs.Deterministic_AI"
   "AInvs.AInvs"
   "Lib.AddUpdSimps"
+  Lib.Heap_List
 begin
 
 context Arch begin
@@ -158,6 +159,21 @@ definition
 abbreviation
   "cte_at' \<equiv> cte_wp_at' \<top>"
 
+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 tcbSchedPrevs_of :: "kernel_state \<Rightarrow> obj_ref \<Rightarrow> obj_ref option" where
+   "tcbSchedPrevs_of s \<equiv> tcbs_of' s |> tcbSchedPrev"
+
+abbreviation tcbSchedNexts_of :: "kernel_state \<Rightarrow> obj_ref \<Rightarrow> obj_ref option" where
+  "tcbSchedNexts_of s \<equiv> tcbs_of' s |> tcbSchedNext"
+
+abbreviation sym_heap_sched_pointers :: "global.kernel_state \<Rightarrow> bool" where
+  "sym_heap_sched_pointers s \<equiv> sym_heap (tcbSchedNexts_of s) (tcbSchedPrevs_of s)"
+
 definition
   tcb_cte_cases :: "word32 \<rightharpoonup> ((tcb \<Rightarrow> cte) \<times> ((cte \<Rightarrow> cte) \<Rightarrow> tcb \<Rightarrow> tcb))"
 where
@@ -232,13 +248,14 @@ where
                                then refs_of' ko
                                else {}))"
 
-
 primrec
   live' :: "Structures_H.kernel_object \<Rightarrow> bool"
 where
   "live' (KOTCB tcb) =
-     (bound (tcbBoundNotification 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)     = (bound (ntfnBoundTCB ntfn) \<or> (\<exists>ts. ntfnObj ntfn = WaitingNtfn ts))"
@@ -479,6 +496,11 @@ 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' :: "Structures_H.tcb \<Rightarrow> kernel_state \<Rightarrow> bool"
 where
@@ -488,7 +510,9 @@ where
                   \<and> valid_bound_ntfn' (tcbBoundNotification t) s
                   \<and> tcbDomain t \<le> maxDomain
                   \<and> tcbPriority t \<le> maxPriority
-                  \<and> tcbMCP 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"
@@ -866,10 +890,15 @@ where
 | "runnable' (Structures_H.BlockedOnSend a b c d e) = False"
 | "runnable' (Structures_H.BlockedOnNotification x) = False"
 
-definition
-  inQ :: "domain \<Rightarrow> priority \<Rightarrow> tcb \<Rightarrow> bool"
-where
- "inQ d p tcb \<equiv> tcbQueued tcb \<and> tcbPriority tcb = p \<and> tcbDomain tcb = d"
+definition inQ :: "domain \<Rightarrow> priority \<Rightarrow> tcb \<Rightarrow> bool" where
+  "inQ d p tcb \<equiv> tcbQueued tcb \<and> tcbPriority tcb = p \<and> tcbDomain tcb = d"
+
+lemma inQ_implies_tcbQueueds_of:
+  "(inQ domain priority |< tcbs_of' s') tcbPtr \<Longrightarrow> (tcbQueued |< tcbs_of' s') tcbPtr"
+  by (clarsimp simp: opt_map_def opt_pred_def inQ_def split: option.splits)
+
+defs ready_qs_runnable_def:
+  "ready_qs_runnable s \<equiv> \<forall>t. obj_at' tcbQueued t s \<longrightarrow> st_tcb_at' runnable' t s"
 
 definition
   (* for given domain and priority, the scheduler bitmap indicates a thread is in the queue *)
@@ -879,15 +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
-  valid_queues_no_bitmap :: "kernel_state \<Rightarrow> bool"
-where
- "valid_queues_no_bitmap \<equiv> \<lambda>s.
-   (\<forall>d p. (\<forall>t \<in> set (ksReadyQueues s (d, p)). obj_at' (inQ d p and runnable' \<circ> tcbState) t s)
-    \<and>  distinct (ksReadyQueues s (d, p))
-    \<and> (d > maxDomain \<or> p > maxPriority \<longrightarrow> ksReadyQueues s (d,p) = []))"
-
 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
@@ -911,31 +931,62 @@ where
     \<forall>d i. ksReadyQueuesL1Bitmap s d !! i \<longrightarrow> ksReadyQueuesL2Bitmap s (d, invertL1Index i) \<noteq> 0 \<and>
                                              i < l2BitmapSize"
 
-definition
-  valid_bitmapQ :: "kernel_state \<Rightarrow> bool"
-where
-  "valid_bitmapQ \<equiv> \<lambda>s. (\<forall>d p. bitmapQ d p s \<longleftrightarrow> ksReadyQueues s (d,p) \<noteq> [])"
+definition valid_bitmapQ :: "kernel_state \<Rightarrow> bool" where
+  "valid_bitmapQ \<equiv> \<lambda>s. \<forall>d p. bitmapQ d p s \<longleftrightarrow> \<not> tcbQueueEmpty (ksReadyQueues s (d,p))"
 
-definition
-  valid_queues :: "kernel_state \<Rightarrow> bool"
-where
- "valid_queues \<equiv> \<lambda>s. valid_queues_no_bitmap s \<and> valid_bitmapQ s \<and>
-                     bitmapQ_no_L2_orphans s \<and> bitmapQ_no_L1_orphans s"
+definition valid_bitmaps :: "kernel_state \<Rightarrow> bool" where
+  "valid_bitmaps \<equiv> \<lambda>s. valid_bitmapQ s \<and> bitmapQ_no_L2_orphans s \<and> bitmapQ_no_L1_orphans s"
 
-definition
-  (* when a thread gets added to / removed from a queue, but before bitmap updated *)
-  valid_bitmapQ_except :: "domain \<Rightarrow> priority \<Rightarrow> kernel_state \<Rightarrow> bool"
-where
+lemma valid_bitmaps_valid_bitmapQ[elim!]:
+  "valid_bitmaps s \<Longrightarrow> valid_bitmapQ s"
+  by (simp add: valid_bitmaps_def)
+
+lemma valid_bitmaps_bitmapQ_no_L2_orphans[elim!]:
+  "valid_bitmaps s \<Longrightarrow> bitmapQ_no_L2_orphans s"
+  by (simp add: valid_bitmaps_def)
+
+lemma valid_bitmaps_bitmapQ_no_L1_orphans[elim!]:
+  "valid_bitmaps s \<Longrightarrow> bitmapQ_no_L1_orphans s"
+  by (simp add: valid_bitmaps_def)
+
+lemma valid_bitmaps_lift:
+  assumes prq: "\<And>P. f \<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace>"
+  assumes prqL1: "\<And>P. f \<lbrace>\<lambda>s. P (ksReadyQueuesL1Bitmap s)\<rbrace>"
+  assumes prqL2: "\<And>P. f \<lbrace>\<lambda>s. P (ksReadyQueuesL2Bitmap s)\<rbrace>"
+  shows "f \<lbrace>valid_bitmaps\<rbrace>"
+  unfolding valid_bitmaps_def valid_bitmapQ_def bitmapQ_def
+            bitmapQ_no_L1_orphans_def bitmapQ_no_L2_orphans_def
+  apply (rule hoare_pre)
+   apply (wps assms | wpsimp)+
+  done
+
+(* when a thread gets added to / removed from a queue, but before bitmap updated *)
+definition valid_bitmapQ_except :: "domain \<Rightarrow> priority \<Rightarrow> kernel_state \<Rightarrow> bool" where
   "valid_bitmapQ_except d' p' \<equiv> \<lambda>s.
-    (\<forall>d p. (d \<noteq> d' \<or> p \<noteq> p') \<longrightarrow> (bitmapQ d p s \<longleftrightarrow> ksReadyQueues s (d,p) \<noteq> []))"
+    \<forall>d p. (d \<noteq> d' \<or> p \<noteq> p') \<longrightarrow> (bitmapQ d p s \<longleftrightarrow> \<not> tcbQueueEmpty (ksReadyQueues s (d,p)))"
 
 lemmas bitmapQ_defs = valid_bitmapQ_def valid_bitmapQ_except_def bitmapQ_def
                        bitmapQ_no_L2_orphans_def bitmapQ_no_L1_orphans_def
 
-definition
-  valid_queues' :: "kernel_state \<Rightarrow> bool"
-where
- "valid_queues' \<equiv> \<lambda>s. \<forall>d p t. obj_at' (inQ d p) t s \<longrightarrow> t \<in> set (ksReadyQueues s (d, p))"
+\<comment> \<open>
+  The tcbSchedPrev and tcbSchedNext fields of a TCB are used only to indicate membership in
+  one of the ready queues. \<close>
+definition valid_sched_pointers_2 ::
+  "(obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> (obj_ref \<Rightarrow> bool) \<Rightarrow> bool "
+  where
+  "valid_sched_pointers_2 prevs nexts ready \<equiv>
+     \<forall>ptr. prevs ptr \<noteq> None \<or> nexts ptr \<noteq> None \<longrightarrow> ready ptr"
+
+abbreviation valid_sched_pointers :: "kernel_state \<Rightarrow> bool" where
+  "valid_sched_pointers s \<equiv>
+     valid_sched_pointers_2 (tcbSchedPrevs_of s) (tcbSchedNexts_of s) (tcbQueued |< tcbs_of' s)"
+
+lemmas valid_sched_pointers_def = valid_sched_pointers_2_def
+
+lemma valid_sched_pointersD:
+  "\<lbrakk>valid_sched_pointers s; \<not> (tcbQueued |< tcbs_of' s) t\<rbrakk>
+   \<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 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"
@@ -1152,7 +1203,7 @@ definition
   valid_state' :: "kernel_state \<Rightarrow> bool"
 where
   "valid_state' \<equiv> \<lambda>s. valid_pspace' s \<and> sch_act_wf (ksSchedulerAction s) s
-                      \<and> valid_queues s \<and> sym_refs (state_refs_of' 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
@@ -1161,7 +1212,9 @@ where
                       \<and> valid_irq_states' s
                       \<and> valid_machine_state' s
                       \<and> irqs_masked' s
-                      \<and> valid_queues' 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
@@ -1213,6 +1266,11 @@ definition
 abbreviation
   "active' st \<equiv> st = Structures_H.Running \<or> st = Structures_H.Restart"
 
+lemma runnable_eq_active': "runnable' = active'"
+  apply (rule ext)
+  apply (case_tac st, simp_all)
+  done
+
 abbreviation
   "simple' st \<equiv> st = Structures_H.Inactive \<or>
                 st = Structures_H.Running \<or>
@@ -1228,11 +1286,12 @@ abbreviation
 abbreviation(input)
  "all_invs_but_sym_refs_ct_not_inQ'
     \<equiv> \<lambda>s. valid_pspace' s \<and> sch_act_wf (ksSchedulerAction s) s
-           \<and> valid_queues s \<and> if_live_then_nonz_cap' s \<and> if_unsafe_then_cap' 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> cur_tcb' s \<and> valid_queues' s \<and> ct_idle_or_in_cur_domain' s \<and> valid_pde_mappings' 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"
@@ -1240,12 +1299,13 @@ abbreviation(input)
 abbreviation(input)
  "all_invs_but_ct_not_inQ'
     \<equiv> \<lambda>s. valid_pspace' s \<and> sch_act_wf (ksSchedulerAction s) s
-           \<and> valid_queues s \<and> sym_refs (state_refs_of' 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> cur_tcb' s \<and> valid_queues' s \<and> ct_idle_or_in_cur_domain' s \<and> valid_pde_mappings' 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"
@@ -1261,12 +1321,13 @@ lemma all_invs_but_not_ct_inQ_check':
 definition
   "all_invs_but_ct_idle_or_in_cur_domain'
     \<equiv> \<lambda>s. valid_pspace' s \<and> sch_act_wf (ksSchedulerAction s) s
-           \<and> valid_queues s \<and> sym_refs (state_refs_of' 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> cur_tcb' s \<and> valid_queues' s \<and> ct_not_inQ s \<and> valid_pde_mappings' 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"
@@ -2990,9 +3051,9 @@ lemma sch_act_wf_arch [simp]:
   "sch_act_wf sa (ksArchState_update f s) = sch_act_wf sa s"
   by (cases sa) (simp_all add: ct_in_state'_def  tcb_in_cur_domain'_def)
 
-lemma valid_queues_arch [simp]:
-  "valid_queues (ksArchState_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
+lemma valid_bitmaps_arch[simp]:
+  "valid_bitmaps (ksArchState_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
 
 lemma if_unsafe_then_cap_arch' [simp]:
   "if_unsafe_then_cap' (ksArchState_update f s) = if_unsafe_then_cap' s"
@@ -3010,22 +3071,14 @@ lemma sch_act_wf_machine_state [simp]:
   "sch_act_wf sa (ksMachineState_update f s) = sch_act_wf sa s"
   by (cases sa) (simp_all add: ct_in_state'_def  tcb_in_cur_domain'_def)
 
-lemma valid_queues_machine_state [simp]:
-  "valid_queues (ksMachineState_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
-
-lemma valid_queues_arch' [simp]:
-  "valid_queues' (ksArchState_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
-
-lemma valid_queues_machine_state' [simp]:
-  "valid_queues' (ksMachineState_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
-
 lemma valid_irq_node'_machine_state [simp]:
   "valid_irq_node' x (ksMachineState_update f s) = valid_irq_node' x s"
   by (simp add: valid_irq_node'_def)
 
+lemma valid_bitmaps_machine_state[simp]:
+  "valid_bitmaps (ksMachineState_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
+
 (* these should be reasonable safe for automation because of the 0 pattern *)
 lemma no_0_ko_wp' [elim!]:
   "\<lbrakk> ko_wp_at' Q 0 s; no_0_obj' s \<rbrakk> \<Longrightarrow> P"
@@ -3099,19 +3152,6 @@ lemma objBitsT_koTypeOf :
                                                 pteBits_def pdeBits_def)
   done
 
-lemma valid_queues_obj_at'D:
-   "\<lbrakk> t \<in> set (ksReadyQueues s (d, p)); valid_queues s \<rbrakk>
-        \<Longrightarrow> obj_at' (inQ d p) t s"
-  apply (unfold valid_queues_def valid_queues_no_bitmap_def)
-  apply (elim conjE)
-  apply (drule_tac x=d in spec)
-  apply (drule_tac x=p in spec)
-  apply (clarsimp)
-  apply (drule(1) bspec)
-  apply (erule obj_at'_weakenE)
-  apply (clarsimp)
-  done
-
 lemma obj_at'_and:
   "obj_at' (P and P') t s = (obj_at' P t s \<and> obj_at' P' t s)"
   by (rule iffI, (clarsimp simp: obj_at'_def)+)
@@ -3149,16 +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 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> st_tcb_at' runnable' t s) \<and>
-                  distinct (ksReadyQueues s (d, p)) \<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)
@@ -3239,8 +3269,16 @@ 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_queues [elim!]:
-  "invs' s \<Longrightarrow> valid_queues s"
+lemma invs_valid_bitmaps[elim!]:
+  "invs' s \<Longrightarrow> valid_bitmaps s"
+  by (simp add: invs'_def valid_state'_def)
+
+lemma invs_sym_heap_sched_pointers[elim!]:
+  "invs' s \<Longrightarrow> sym_heap_sched_pointers s"
+  by (simp add: invs'_def valid_state'_def)
+
+lemma invs_valid_sched_pointers[elim!]:
+  "invs' s \<Longrightarrow> valid_sched_pointers s"
   by (simp add: invs'_def valid_state'_def)
 
 lemma invs_valid_idle'[elim!]:
@@ -3257,7 +3295,7 @@ lemma invs'_invs_no_cicd:
 
 lemma invs'_bitmapQ_no_L1_orphans:
   "invs' s \<Longrightarrow> bitmapQ_no_L1_orphans s"
-  by (drule invs_queues, simp add: valid_queues_def)
+  by (simp add: invs'_def valid_state'_def valid_bitmaps_def)
 
 lemma invs_ksCurDomain_maxDomain' [elim!]:
   "invs' s \<Longrightarrow> ksCurDomain s \<le> maxDomain"
@@ -3282,24 +3320,22 @@ lemma invs_no_0_obj'[elim!]:
 
 lemma invs'_gsCNodes_update[simp]:
   "invs' (gsCNodes_update f s') = invs' s'"
-  apply (clarsimp simp: invs'_def valid_state'_def valid_queues_def valid_queues_no_bitmap_def
-             bitmapQ_defs
-             valid_queues'_def 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'")
-  apply (simp_all add: ct_in_state'_def tcb_in_cur_domain'_def  ct_idle_or_in_cur_domain'_def ct_not_inQ_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_state'_def valid_queues_def valid_queues_no_bitmap_def
-             bitmapQ_defs
-             valid_queues'_def 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'")
-  apply (simp_all add: ct_in_state'_def ct_idle_or_in_cur_domain'_def   tcb_in_cur_domain'_def ct_not_inQ_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:
@@ -3315,7 +3351,7 @@ lemma invs'_ksDomScheduleIdx:
 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> ksReadyQueues s (d,p) \<noteq> []) ;
+  "\<lbrakk> valid_bitmapQ_except d p s; bitmapQ d p s \<longleftrightarrow> \<not> tcbQueueEmpty (ksReadyQueues s (d,p));
      bitmapQ_no_L2_orphans s \<rbrakk>
    \<Longrightarrow> valid_bitmapQ s"
   unfolding valid_bitmapQ_def valid_bitmapQ_except_def
diff --git a/proof/refine/ARM/IpcCancel_R.thy b/proof/refine/ARM/IpcCancel_R.thy
index aaf563b9a8..b2ffe21508 100644
--- a/proof/refine/ARM/IpcCancel_R.thy
+++ b/proof/refine/ARM/IpcCancel_R.thy
@@ -48,25 +48,6 @@ lemma set_ep_pred_tcb_at' [wp]:
   apply (simp add: updateObject_default_def in_monad projectKOs)
   done
 
-(* valid_queues is too strong *)
-definition valid_inQ_queues :: "KernelStateData_H.kernel_state \<Rightarrow> bool" where
-  "valid_inQ_queues \<equiv>
-     \<lambda>s. \<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s) \<and> distinct (ksReadyQueues s (d, p))"
-
-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_inQ_queues_ksReadyQueuesL1Bitmap_upd[simp]:
-  "valid_inQ_queues (ksReadyQueuesL1Bitmap_update f s) = valid_inQ_queues s"
-  unfolding valid_inQ_queues_def
-  by simp
-
-lemma valid_inQ_queues_ksReadyQueuesL2Bitmap_upd[simp]:
-  "valid_inQ_queues (ksReadyQueuesL2Bitmap_update f s) = valid_inQ_queues s"
-  unfolding valid_inQ_queues_def
-  by simp
-
 defs capHasProperty_def:
   "capHasProperty ptr P \<equiv> cte_wp_at' (\<lambda>c. P (cteCap c)) ptr"
 end
@@ -83,11 +64,6 @@ locale delete_one_conc_pre =
     "\<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_queues:
-    "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)\<rbrace>
-     cteDeleteOne sl \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  assumes delete_one_inQ_queues:
-    "\<lbrace>valid_inQ_queues\<rbrace> cteDeleteOne sl \<lbrace>\<lambda>rv. valid_inQ_queues\<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:
@@ -343,6 +319,7 @@ lemma cancelSignal_corres:
     apply fastforce
    apply (clarsimp simp: valid_obj_def valid_tcb_def valid_tcb_state_def)
    apply (drule sym, simp add: obj_at_def)
+   apply fastforce
   apply (clarsimp simp: conj_comms pred_tcb_at' cong: conj_cong)
   apply (rule conjI)
    apply (simp add: pred_tcb_at'_def)
@@ -547,12 +524,12 @@ lemma (in delete_one) cancelIPC_ReplyCap_corres:
               and Q'="\<lambda>_. invs' and st_tcb_at' awaiting_reply' t"
                in corres_underlying_split)
      apply (rule corres_guard_imp)
-       apply (rule threadset_corresT)
+       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 (clarsimp simp: st_tcb_at_tcb_at)
+      apply (fastforce simp: st_tcb_at_tcb_at)
      apply clarsimp
     defer
     apply (wp thread_set_invs_trivial thread_set_no_change_tcb_state
@@ -639,7 +616,7 @@ lemma (in delete_one) cancel_ipc_corres:
     apply (rule hoare_strengthen_post)
      apply (rule gts_sp'[where P="\<top>"])
     apply (clarsimp elim!: pred_tcb'_weakenE)
-   apply simp
+   apply fastforce
   apply simp
   done
 
@@ -671,16 +648,15 @@ lemma sch_act_simple_not_t[simp]: "sch_act_simple s \<Longrightarrow> sch_act_no
 
 context begin interpretation Arch . (*FIXME: arch_split*)
 
+crunches setNotification
+  for sym_heap_sched_pointers[wp]: sym_heap_sched_pointers
+  and valid_bitmaps[wp]: valid_bitmaps
+  (wp: valid_bitmaps_lift)
+
 lemma cancelSignal_invs':
   "\<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> Invariants_H.valid_queues s; st_tcb_at' (Not \<circ> runnable') t s \<rbrakk>
-                                         \<Longrightarrow> \<forall>x. t \<notin> set (ksReadyQueues s x)"
-      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>"
@@ -691,9 +667,9 @@ lemma cancelSignal_invs':
     show ?thesis
       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 setNotification_ksQ] sts_valid_queues
+                hoare_vcg_all_lift
                 setThreadState_ct_not_inQ NTFNSN
-                hoare_vcg_all_lift setNotification_ksQ
+                hoare_vcg_all_lift
               | simp add: valid_tcb_state'_def list_case_If split del: if_split)+
        prefer 2
        apply assumption
@@ -701,8 +677,6 @@ lemma cancelSignal_invs':
        apply (rule get_ntfn_sp')
       apply (rename_tac rv s)
       apply (clarsimp simp: pred_tcb_at')
-      apply (frule NIQ)
-       apply (clarsimp simp: pred_tcb_at'_def obj_at'_def)
       apply (rule conjI)
        apply (clarsimp simp: valid_ntfn'_def)
        apply (case_tac "ntfnObj rv", simp_all add: isWaitingNtfn_def)
@@ -742,9 +716,10 @@ lemma cancelSignal_invs':
                                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 r")
+       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)
@@ -810,23 +785,25 @@ lemma setEndpoint_ct_not_inQ[wp]:
   done
 
 lemma setEndpoint_ksDomScheduleIdx[wp]:
-  "\<lbrace>\<lambda>s. P (ksDomScheduleIdx s)\<rbrace> setEndpoint ptr ep \<lbrace>\<lambda>_ s. P (ksDomScheduleIdx s)\<rbrace>"
+  "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
 
+crunches 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 NIQ: "\<And>s. \<lbrakk> Invariants_H.valid_queues s; st_tcb_at' (Not \<circ> runnable') t s \<rbrakk>
-                                       \<Longrightarrow> \<forall>x. t \<notin> set (ksReadyQueues s x)"
-    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 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>"
@@ -851,8 +828,8 @@ proof -
     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]
-              sts_valid_queues setThreadState_ct_not_inQ EPSCHN
-              hoare_vcg_all_lift setNotification_ksQ
+              setThreadState_ct_not_inQ EPSCHN
+              hoare_vcg_all_lift
               | simp add: valid_tcb_state'_def split del: if_split
               | wpc)+
      prefer 2
@@ -860,14 +837,14 @@ proof -
     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 (frule NIQ)
-     apply (erule pred_tcb'_weakenE, fastforce)
     apply (clarsimp, rule conjI)
      apply (auto simp: pred_tcb_at'_def obj_at'_def)[1]
     apply (rule conjI)
@@ -1054,31 +1031,6 @@ apply (wp hoare_vcg_conj_lift delete_one_ksCurDomain
      | simp add: getThreadReplySlot_def o_def if_fun_split)+
 done
 
-(* FIXME move *)
-lemma tcbSchedEnqueue_not_st:
-  "(\<And>tcb st qd. P (tcb\<lparr>tcbState := st, tcbQueued := qd\<rparr>) \<longleftrightarrow> P tcb)
-     \<Longrightarrow> \<lbrace>obj_at' P t'\<rbrace> tcbSchedEnqueue t \<lbrace>\<lambda>_. obj_at' P t'\<rbrace>"
-apply (simp add: tcbSchedEnqueue_def unless_def)
-apply (wp threadGet_wp | simp)+
-apply (clarsimp simp: obj_at'_def)
-apply (case_tac obja)
-apply fastforce
-done
-
-(* FIXME move *)
-lemma setThreadState_not_st:
-  "(\<And>tcb st qd. P (tcb\<lparr>tcbState := st, tcbQueued := qd\<rparr>) \<longleftrightarrow> P tcb)
-     \<Longrightarrow> \<lbrace>obj_at' P t'\<rbrace> setThreadState st t \<lbrace>\<lambda>_. obj_at' P t'\<rbrace>"
-apply (simp add: setThreadState_def rescheduleRequired_def)
-apply (wp hoare_vcg_conj_lift tcbSchedEnqueue_not_st
-     | wpc
-     | rule hoare_drop_imps
-     | simp)+
-apply (clarsimp simp: obj_at'_def)
-apply (case_tac obj)
-apply fastforce
-done
-
 (* FIXME move *)
 lemma setBoundNotification_not_ntfn:
   "(\<And>tcb ntfn. P (tcb\<lparr>tcbBoundNotification := ntfn\<rparr>) \<longleftrightarrow> P tcb)
@@ -1090,15 +1042,6 @@ lemma setBoundNotification_not_ntfn:
      | simp)+
   done
 
-(* FIXME move *)
-lemma setThreadState_tcb_in_cur_domain'[wp]:
-  "\<lbrace>tcb_in_cur_domain' t'\<rbrace> setThreadState 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 setThreadState_not_st | simp)+
-done
-
 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)
@@ -1107,30 +1050,33 @@ lemma setBoundNotification_tcb_in_cur_domain'[wp]:
   apply (wp 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> \<lbrace>obj_at' P t'\<rbrace> cancelSignal t word \<lbrace>\<lambda>_. obj_at' P t'\<rbrace>"
-apply (simp add: cancelSignal_def setNotification_def)
-apply (wp setThreadState_not_st getNotification_wp | wpc | simp)+
-done
+
+lemma setThreadState_tcbDomain_obj_at'[wp]:
+  "setThreadState ts t \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  unfolding setThreadState_def
+  by wpsimp
+
+crunches 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 (simp add: cancelIPC_def Let_def)
-apply (wp hoare_vcg_conj_lift
-          setThreadState_not_st delete_one_tcbDomain_obj_at' cancelSignal_tcb_obj_at'
-     | wpc
-     | rule hoare_drop_imps
-     | simp add: getThreadReplySlot_def o_def if_fun_split)+
-done
+  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':
   "\<lbrace>tcb_in_cur_domain' t'\<rbrace> cancelIPC 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 cancelIPC_tcbDomain_obj_at' | simp)+
-done
+  apply (simp add: tcb_in_cur_domain'_def)
+  apply (rule hoare_pre)
+   apply wps
+   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>"
@@ -1225,190 +1171,54 @@ lemma setNotification_weak_sch_act_wf[wp]:
 lemmas ipccancel_weak_sch_act_wfs
     = weak_sch_act_wf_lift[OF _ setCTE_pred_tcb_at']
 
-lemma tcbSchedDequeue_corres':
-  "corres dc (is_etcb_at t) (tcb_at' t and valid_inQ_queues) (tcb_sched_action (tcb_sched_dequeue) t) (tcbSchedDequeue t)"
-  apply (simp only: tcbSchedDequeue_def tcb_sched_action_def)
-  apply (rule corres_symb_exec_r[OF _ _ threadGet_inv, where Q'="\<lambda>rv. tcb_at' t and valid_inQ_queues and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"])
-    defer
-    apply (wp threadGet_obj_at', simp, simp)
-   apply (wp, simp)
-  apply (case_tac queued)
-   defer
-   apply (simp add: unless_def when_def)
-   apply (rule corres_no_failI)
-    apply (wp)
-   apply (clarsimp simp: in_monad ethread_get_def get_etcb_def set_tcb_queue_def is_etcb_at_def state_relation_def gets_the_def gets_def get_def return_def bind_def assert_opt_def get_tcb_queue_def modify_def put_def)
-   apply (subgoal_tac "t \<notin> set (ready_queues a (tcb_domain y) (tcb_priority y))")
-    prefer 2
-    apply (force simp: tcb_sched_dequeue_def valid_inQ_queues_def
-           ready_queues_relation_def obj_at'_def inQ_def projectKO_eq project_inject)
-   apply (simp add: ready_queues_relation_def)
-  apply (simp add: unless_def when_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[where r'="(=)"])
-       apply (rule ethreadget_corres, simp add: etcb_relation_def)
-      apply (simp split del: if_split)
-      apply (rule corres_split_eqr)
-         apply (rule ethreadget_corres, simp add: etcb_relation_def)
-        apply (rule corres_split_eqr[OF getQueue_corres])
-          apply (simp split del: if_split)
-          apply (subst bind_return_unit, rule corres_split[where r'=dc])
-             apply (simp add: tcb_sched_dequeue_def)
-             apply (rule setQueue_corres)
-            apply (rule corres_split_noop_rhs)
-              apply (clarsimp, rule removeFromBitmap_corres_noop)
-             apply (simp add: dc_def[symmetric])
-             apply (rule threadSet_corres_noop, simp_all add: tcb_relation_def exst_same_def)[1]
-            apply (wp | simp)+
-  done
-
-lemma setQueue_valid_inQ_queues:
-  "\<lbrace>valid_inQ_queues
-      and (\<lambda>s. \<forall>t \<in> set ts. obj_at' (inQ d p) t s)
-      and K (distinct ts)\<rbrace>
-  setQueue d p ts
-  \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  apply (simp add: setQueue_def valid_inQ_queues_def)
-  apply wp
-  apply clarsimp
-  done
-
-lemma threadSet_valid_inQ_queues:
-  "\<lbrace>valid_inQ_queues and (\<lambda>s. \<forall>d p. (\<exists>tcb. (inQ d p tcb) \<and> \<not>(inQ d p (f tcb)))
-                        \<longrightarrow> obj_at' (\<lambda>tcb. (inQ d p tcb) \<and> \<not>(inQ d p (f tcb))) t s
-                        \<longrightarrow> t \<notin> set (ksReadyQueues s (d, p)))\<rbrace>
-     threadSet f t
-   \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (simp add: threadSet_def)
-  apply wp
-   apply (simp add: valid_inQ_queues_def pred_tcb_at'_def)
-   apply (wp setObject_queues_unchanged_tcb
-             hoare_Ball_helper
-             hoare_vcg_all_lift
-             setObject_tcb_strongest)[1]
-  apply (wp getObject_tcb_wp)
-  apply (clarsimp simp: valid_inQ_queues_def pred_tcb_at'_def)
-  apply (clarsimp simp: obj_at'_def projectKOs)
-  apply (fastforce)
-  done
-
-(* reorder the threadSet before the setQueue, useful for lemmas that don't refer to bitmap *)
-lemma setQueue_after_addToBitmap:
-  "(setQueue d p q >>= (\<lambda>rv. (when P (addToBitmap d p)) >>= (\<lambda>rv. threadSet f t))) =
-   (when P (addToBitmap d p) >>= (\<lambda>rv. (threadSet f t) >>= (\<lambda>rv. setQueue d p q)))"
-  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 (simp add: threadSet_def getObject_def setObject_def
-                   loadObject_default_def bitmap_fun_defs
-                   split_def projectKO_def2 alignCheck_assert
-                   magnitudeCheck_assert updateObject_default_def)
-  apply (intro oblivious_bind, simp_all)
-  apply (clarsimp simp: bind_assoc)
-  done
-
-lemma tcbSchedEnqueue_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> tcbSchedEnqueue t \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def setQueue_after_addToBitmap)
-  apply (rule hoare_pre)
-   apply (rule_tac B="\<lambda>rv. valid_inQ_queues and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"
-                in hoare_seq_ext)
-    apply (rename_tac queued)
-    apply (case_tac queued, simp_all add: unless_def)[1]
-     apply (wp setQueue_valid_inQ_queues threadSet_valid_inQ_queues threadGet_wp
-               hoare_vcg_const_Ball_lift
-          | simp add: inQ_def bitmap_fun_defs
-          | fastforce simp: valid_inQ_queues_def inQ_def obj_at'_def)+
-  done
-
- (* prevents wp from splitting on the when; stronger technique than hoare_when_weak_wp
-    FIXME: possible to replace with hoare_when_weak_wp?
- *)
-definition
-  "removeFromBitmap_conceal d p q t \<equiv> when (null [x\<leftarrow>q . x \<noteq> t]) (removeFromBitmap d p)"
-
-lemma rescheduleRequired_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> rescheduleRequired \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply wpsimp
-  done
-
-lemma sts_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> setThreadState st t \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (simp add: setThreadState_def)
-  apply (wp threadSet_valid_inQ_queues [THEN hoare_strengthen_post])
-   apply (clarsimp simp: sch_act_simple_def Invariants_H.valid_queues_def inQ_def)+
-  done
-
 lemma updateObject_ep_inv:
   "\<lbrace>P\<rbrace> updateObject (obj::endpoint) ko p q n \<lbrace>\<lambda>rv. P\<rbrace>"
   by simp (rule updateObject_default_inv)
 
-lemma sbn_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> setBoundNotification ntfn t \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (simp add: setBoundNotification_def)
-  apply (wp threadSet_valid_inQ_queues [THEN hoare_strengthen_post])
-   apply (clarsimp simp: sch_act_simple_def Invariants_H.valid_queues_def inQ_def)+
+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>"
+  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 setEndpoint_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> setEndpoint ptr ep \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (unfold setEndpoint_def)
-  apply (rule setObject_ep_pre)
-  apply (simp add: valid_inQ_queues_def)
-  apply (wp hoare_Ball_helper hoare_vcg_all_lift setObject_queues_unchanged[OF updateObject_ep_inv])
-  apply simp
-  done
+context begin interpretation Arch .
 
-lemma set_ntfn_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> setNotification ptr ntfn \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (unfold setNotification_def)
-  apply (rule setObject_ntfn_pre)
-  apply (simp add: valid_inQ_queues_def)
-  apply (wp hoare_Ball_helper hoare_vcg_all_lift)
-    apply (clarsimp simp: updateObject_default_def in_monad)
-    apply (wp updateObject_default_inv | simp)+
-    done
+crunches cancel_ipc
+  for pspace_aligned[wp]: "pspace_aligned :: det_state \<Rightarrow> _"
+  and pspace_distinct[wp]: "pspace_distinct :: det_state \<Rightarrow> _"
+  (simp: crunch_simps wp: crunch_wps)
 
-crunch valid_inQ_queues[wp]: cancelSignal valid_inQ_queues
-  (simp: updateObject_tcb_inv crunch_simps wp: crunch_wps)
+end
 
-lemma (in delete_one_conc_pre) cancelIPC_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> cancelIPC t \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  apply (simp add: cancelIPC_def Let_def getThreadReplySlot_def)
-  apply (wp hoare_drop_imps delete_one_inQ_queues threadSet_valid_inQ_queues | wpc | simp add:if_apply_def2 Fun.comp_def)+
-   apply (clarsimp simp: valid_inQ_queues_def inQ_def)+
-   done
+crunches asUser
+  for valid_sched_pointers[wp]: valid_sched_pointers
+  (wp: crunch_wps)
 
-lemma valid_queues_inQ_queues:
-  "Invariants_H.valid_queues s \<Longrightarrow> valid_inQ_queues s"
-  by (force simp: Invariants_H.valid_queues_def valid_inQ_queues_def obj_at'_def
-                  valid_queues_no_bitmap_def)
+crunches set_thread_state
+  for in_correct_ready_q[wp]: in_correct_ready_q
+  (ignore_del: set_thread_state_ext)
 
-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>"
-  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
+crunches set_thread_state_ext
+  for ready_qs_distinct[wp]: ready_qs_distinct
+  (wp: crunch_wps ignore_del: set_thread_state_ext)
 
-lemma asUser_valid_inQ_queues[wp]:
-  "\<lbrace> valid_inQ_queues \<rbrace> asUser t f \<lbrace>\<lambda>rv. valid_inQ_queues \<rbrace>"
-  unfolding valid_inQ_queues_def Ball_def
-  apply (wpsimp wp: hoare_vcg_all_lift)
-    defer
-    apply (wp asUser_ksQ)
-   apply assumption
-  apply (simp add: inQ_def[abs_def] obj_at'_conj)
-  apply (rule hoare_convert_imp)
-   apply (wp asUser_ksQ)
-  apply wp
-  done
+lemma set_thread_state_ready_qs_distinct[wp]:
+  "set_thread_state ref ts \<lbrace>ready_qs_distinct\<rbrace>"
+  unfolding set_thread_state_def
+  apply (wpsimp wp: set_object_wp)
+  by (clarsimp simp: ready_qs_distinct_def)
+
+lemma as_user_ready_qs_distinct[wp]:
+  "as_user tptr f \<lbrace>ready_qs_distinct\<rbrace>"
+  unfolding as_user_def
+  apply (wpsimp wp: set_object_wp)
+  by (clarsimp simp: ready_qs_distinct_def)
 
 lemma (in delete_one) suspend_corres:
   "corres dc (einvs and tcb_at t) (invs' and tcb_at' t)
         (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])
@@ -1426,17 +1236,19 @@ lemma (in delete_one) suspend_corres:
             apply (wpsimp simp: ARM.setRegister_def ARM.getRegister_def)
            apply (rule corres_return_trivial)
           apply (rule corres_split_nor[OF setThreadState_corres])
-             apply simp
-            apply (rule tcbSchedDequeue_corres')
-           apply (wpsimp simp: update_restart_pc_def updateRestartPC_def)+
-       apply (rule hoare_post_imp[where Q = "\<lambda>rv s. tcb_at t s \<and> is_etcb_at t s"])
-        apply simp
+             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>rv s. tcb_at' t s \<and> valid_inQ_queues s"])
-       apply (wpsimp simp: valid_queues_inQ_queues)
-      apply wp+
-   apply (force simp: valid_sched_def tcb_at_is_etcb_at)
-  apply (clarsimp simp add: invs'_def valid_state'_def valid_queues_inQ_queues)
+      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:
@@ -1461,248 +1273,8 @@ lemma (in delete_one_conc_pre) cancelIPC_it[wp]:
 
 crunch ksQ: threadGet "\<lambda>s. P (ksReadyQueues s p)"
 
-lemma tcbSchedDequeue_notksQ:
-  "\<lbrace>\<lambda>s. t' \<notin> set(ksReadyQueues s p)\<rbrace>
-    tcbSchedDequeue t
-   \<lbrace>\<lambda>_ s. t' \<notin> set(ksReadyQueues s p)\<rbrace>"
-  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+
-     apply clarsimp
-     apply (rule_tac Q="\<lambda>_ s. t' \<notin> set(ksReadyQueues s p)" in hoare_post_imp)
-      apply (wp | clarsimp)+
-  done
-
-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 B="\<lambda>rv s. (rv = ResumeCurrentThread \<or> rv = ChooseNewThread)
-                       \<and> ?OAQ t' p s" in hoare_seq_ext)
-   including classic_wp_pre
-   apply (wp | clarsimp)+
-   apply (case_tac x)
-     apply (wp | clarsimp)+
-  done
-
-lemma setThreadState_oa_queued:
-  "\<lbrace>\<lambda>s. P' (obj_at' (\<lambda>tcb. P (tcbQueued tcb) (tcbDomain tcb) (tcbPriority tcb)) t' s) \<rbrace>
-    setThreadState st 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> setThreadState st t \<lbrace>\<lambda>_. ?Q R \<rbrace>"
-      apply (simp add: setThreadState_def)
-      apply (wp rescheduleRequired_oa_queued)
-      apply (simp add: sch_act_simple_def)
-      apply (rule_tac Q="\<lambda>_. ?Q R" in hoare_post_imp, clarsimp)
-      apply (wp threadSet_obj_at'_strongish)
-      apply (clarsimp)
-      done
-    show "\<lbrace>\<lambda>s. \<not> ?Q P s\<rbrace> setThreadState st t \<lbrace>\<lambda>_ s. \<not> ?Q P s\<rbrace>"
-      by (simp add: not_obj_at' comp_def, wp hoare_convert_imp pos)
-  qed
-
-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 sts_valid_queues_partial:
-  "\<lbrace>Invariants_H.valid_queues and sch_act_simple\<rbrace>
-    setThreadState st t
-   \<lbrace>\<lambda>_ s. \<forall>t' d p.
-            (t' \<in> set(ksReadyQueues s (d, p)) \<longrightarrow>
-             (obj_at' (\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d \<and> tcbPriority tcb = p) t' s
-              \<and> (t' \<noteq> t \<longrightarrow> st_tcb_at' runnable' t' s)))
-            \<and> distinct (ksReadyQueues s (d, p))\<rbrace>"
-  (is "\<lbrace>_\<rbrace> _ \<lbrace>\<lambda>_ s. \<forall>t' d p. ?OA t' d p s \<and> ?DISTINCT d p s \<rbrace>")
-  apply (rule_tac Q="\<lambda>_ s. (\<forall>t' d p. ?OA t' d p s) \<and> (\<forall>d p. ?DISTINCT d p s)"
-           in hoare_post_imp)
-   apply (clarsimp)
-  apply (rule hoare_conjI)
-   apply (rule_tac Q="\<lambda>s. \<forall>t' d p.
-             ((t'\<in>set(ksReadyQueues s (d, p))
-               \<or> \<not> (sch_act_simple s))
-                  \<longrightarrow> (obj_at'(\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d \<and> tcbPriority tcb = p) t' s
-                       \<and> st_tcb_at' runnable' t' s))" in hoare_pre_imp)
-    apply (fastforce simp: Invariants_H.valid_queues_def valid_queues_no_bitmap_def
-                           pred_tcb_at'_def obj_at'_def inQ_def)
-   apply (rule hoare_vcg_all_lift)+
-    apply (rule hoare_convert_imp)
-     including classic_wp_pre
-     apply (wp sts_ksQ setThreadState_oa_queued hoare_impI sts_pred_tcb_neq'
-            | clarsimp)+
-  apply (rule_tac Q="\<lambda>s. \<forall>d p. ?DISTINCT d p s \<and> sch_act_simple s" in hoare_pre_imp)
-   apply (clarsimp simp: Invariants_H.valid_queues_def valid_queues_no_bitmap_def)
-  apply (wp hoare_vcg_all_lift sts_ksQ)
-  apply (clarsimp)
-  done
-
-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 Q="(\<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)
-  done
-
-lemma sts_invs_minor'_no_valid_queues:
-  "\<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. runnable' st \<and> obj_at' tcbQueued t s \<longrightarrow> st_tcb_at' runnable' t s)
-      and sch_act_simple
-      and invs'\<rbrace>
-    setThreadState st t
-   \<lbrace>\<lambda>_ s. (\<forall>t' d p.
-            (t' \<in> set(ksReadyQueues s (d, p)) \<longrightarrow>
-             (obj_at' (\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d \<and> tcbPriority tcb = p) t' s
-              \<and> (t' \<noteq> t \<longrightarrow> st_tcb_at' runnable' t' s)))
-            \<and> distinct (ksReadyQueues s (d, p)) \<and> (maxDomain < d \<or> maxPriority < p \<longrightarrow> ksReadyQueues s (d, p) = [])) \<and>
-         valid_bitmapQ s \<and>
-         bitmapQ_no_L2_orphans s \<and>
-         bitmapQ_no_L1_orphans s \<and>
-         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>
-         valid_queues' 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 \<and>
-         cur_tcb' s \<and>
-         tcb_at' t s\<rbrace>"
-  apply (simp add: invs'_def valid_state'_def valid_queues_def)
-  apply (wp sts_valid_queues_partial sts_ksQ
-            setThreadState_oa_queued sts_st_tcb_at'_cases
-            irqs_masked_lift
-            valid_irq_node_lift
-            setThreadState_ct_not_inQ
-            sts_valid_bitmapQ_sch_act_simple
-            sts_valid_bitmapQ_no_L2_orphans_sch_act_simple
-            sts_valid_bitmapQ_no_L1_orphans_sch_act_simple
-            hoare_vcg_conj_lift hoare_vcg_imp_lift hoare_vcg_all_lift)+
-  apply (clarsimp simp: disj_imp)
-  apply (intro conjI)
-        apply (clarsimp simp: valid_queues_def)
-        apply (rule conjI, clarsimp)
-         apply (drule valid_queues_no_bitmap_objD, assumption)
-         apply (clarsimp simp: inQ_def comp_def)
-         apply (rule conjI)
-          apply (erule obj_at'_weaken)
-          apply (simp add: inQ_def)
-         apply (clarsimp simp: st_tcb_at'_def)
-         apply (erule obj_at'_weaken)
-         apply (simp add: inQ_def)
-        apply (simp add: valid_queues_no_bitmap_def)
-       apply clarsimp
-     apply (clarsimp simp: st_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 (fastforce simp: valid_tcb_state'_def
-                  split: Structures_H.thread_state.splits)
-    apply (clarsimp dest!: st_tcb_at_state_refs_ofD'
-                    elim!: rsubst[where P=sym_refs]
-                   intro!: ext)
-   apply (fastforce simp: valid_queues_def inQ_def pred_tcb_at' pred_tcb_at'_def
-                   elim!: st_tcb_ex_cap'' obj_at'_weakenE)+
-  done
-
 crunch ct_idle_or_in_cur_domain'[wp]: tcbSchedDequeue ct_idle_or_in_cur_domain'
-
-lemma tcbSchedDequeue_invs'_no_valid_queues:
-   "\<lbrace>\<lambda>s. (\<forall>t' d p.
-            (t' \<in> set(ksReadyQueues s (d, p)) \<longrightarrow>
-             (obj_at' (\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d \<and> tcbPriority tcb = p) t' s
-              \<and> (t' \<noteq> t \<longrightarrow> st_tcb_at' runnable' t' s)))
-            \<and> distinct (ksReadyQueues s (d, p)) \<and> (maxDomain < d \<or> maxPriority < p \<longrightarrow> ksReadyQueues s (d, p) = [])) \<and>
-         valid_bitmapQ s \<and>
-         bitmapQ_no_L2_orphans s \<and>
-         bitmapQ_no_L1_orphans s \<and>
-         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>
-         valid_queues' 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 \<and>
-         cur_tcb' s \<and>
-         tcb_at' t s\<rbrace>
-    tcbSchedDequeue t
-   \<lbrace>\<lambda>_. invs' \<rbrace>"
-  apply (simp add: invs'_def valid_state'_def)
-  apply (wp tcbSchedDequeue_valid_queues_weak valid_irq_handlers_lift
-            valid_irq_node_lift valid_irq_handlers_lift'
-            tcbSchedDequeue_irq_states irqs_masked_lift cur_tcb_lift
-            untyped_ranges_zero_lift
-         | clarsimp simp add: cteCaps_of_def valid_queues_def o_def)+
-  apply (rule conjI)
-   apply (fastforce simp: obj_at'_def inQ_def st_tcb_at'_def valid_queues_no_bitmap_except_def)
-  apply (rule conjI, clarsimp simp: correct_queue_def)
-  apply (fastforce simp: valid_pspace'_def intro: obj_at'_conjI
-                   elim: valid_objs'_maxDomain valid_objs'_maxPriority)
-  done
-
-lemmas sts_tcbSchedDequeue_invs' =
-  sts_invs_minor'_no_valid_queues
-  tcbSchedDequeue_invs'_no_valid_queues
+  (wp: crunch_wps)
 
 lemma asUser_sch_act_simple[wp]:
   "\<lbrace>sch_act_simple\<rbrace> asUser s t \<lbrace>\<lambda>_. sch_act_simple\<rbrace>"
@@ -1714,11 +1286,14 @@ lemma (in delete_one_conc) suspend_invs'[wp]:
   "\<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 (wp sts_tcbSchedDequeue_invs')
-      apply (simp add: updateRestartPC_def | strengthen no_refs_simple_strg')+
-      prefer 2
-    apply (wpsimp wp: hoare_drop_imps hoare_vcg_imp_lift'
-           | strengthen no_refs_simple_strg')+
+  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]:
@@ -1763,109 +1338,6 @@ lemma (in delete_one_conc_pre) suspend_st_tcb_at':
 lemmas (in delete_one_conc_pre) suspend_makes_simple' =
        suspend_st_tcb_at' [where P=simple', simplified]
 
-lemma valid_queues_not_runnable'_not_ksQ:
-  assumes "Invariants_H.valid_queues s" and "st_tcb_at' (Not \<circ> runnable') t s"
-  shows   "\<forall>d p. t \<notin> set (ksReadyQueues s (d, p))"
-  using assms
-  apply -
-  apply (clarsimp simp: Invariants_H.valid_queues_def valid_queues_no_bitmap_def pred_tcb_at'_def)
-  apply (erule_tac x=d in allE)
-  apply (erule_tac x=p in allE)
-  apply (clarsimp)
-  apply (drule(1) bspec)
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-declare valid_queues_not_runnable'_not_ksQ[OF ByAssum, simp]
-
-lemma cancelSignal_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues and st_tcb_at' (Not \<circ> runnable') t\<rbrace>
-   cancelSignal t ae \<lbrace>\<lambda>_. Invariants_H.valid_queues \<rbrace>"
-  apply (simp add: cancelSignal_def)
-  apply (wp sts_valid_queues)
-      apply (rule_tac Q="\<lambda>_ s. \<forall>p. t \<notin> set (ksReadyQueues s p)" in hoare_post_imp, simp)
-      apply (wp hoare_vcg_all_lift)
-     apply (wpc)
-      apply (wp)+
-   apply (rule_tac Q="\<lambda>_ s. Invariants_H.valid_queues s \<and> (\<forall>p. t \<notin> set (ksReadyQueues s p))" in hoare_post_imp)
-    apply (clarsimp)
-   apply (wp)
-  apply (clarsimp)
-  done
-
-lemma (in delete_one_conc_pre) cancelIPC_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)\<rbrace>
-   cancelIPC t \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: cancelIPC_def Let_def getThreadReplySlot_def
-             cong: Structures_H.thread_state.case_cong list.case_cong)
-  apply (rule hoare_seq_ext [OF _ gts_sp'])
-  apply (rule hoare_pre)
-   apply (wpc
-           | wp hoare_vcg_conj_lift delete_one_queues threadSet_valid_queues
-                threadSet_valid_objs' sts_valid_queues setEndpoint_ksQ
-                hoare_vcg_all_lift threadSet_sch_act threadSet_weak_sch_act_wf
-           | simp add: o_def if_apply_def2 inQ_def
-           | rule hoare_drop_imps
-           | clarsimp simp: valid_tcb'_def tcb_cte_cases_def
-                     elim!: pred_tcb'_weakenE)+
-  apply (fastforce dest: valid_queues_not_runnable'_not_ksQ elim: pred_tcb'_weakenE)
-  done
-
-(* FIXME: move to Schedule_R *)
-lemma tcbSchedDequeue_nonq[wp]:
-  "\<lbrace>Invariants_H.valid_queues and tcb_at' t and K (t = t')\<rbrace>
-    tcbSchedDequeue t \<lbrace>\<lambda>_ s. \<forall>d p. t' \<notin> set (ksReadyQueues s (d, p))\<rbrace>"
-  apply (rule hoare_gen_asm)
-  apply (simp add: tcbSchedDequeue_def)
-  apply (wp threadGet_wp|simp)+
-  apply (fastforce simp: Invariants_H.valid_queues_def valid_queues_no_bitmap_def obj_at'_def projectKOs inQ_def)
-  done
-
-lemma sts_ksQ_oaQ:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace>
-   setThreadState st t
-   \<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>"
-  (is "\<lbrace>_\<rbrace> _ \<lbrace>\<lambda>_. ?POST\<rbrace>")
-  proof -
-    have RR: "\<lbrace>sch_act_simple and ?POST\<rbrace> rescheduleRequired \<lbrace>\<lambda>_. ?POST\<rbrace>"
-      apply (simp add: rescheduleRequired_def)
-      apply (wp)
-        apply (clarsimp)
-       apply (rule_tac
-                Q="(\<lambda>s. action = ResumeCurrentThread \<or> action = ChooseNewThread) and ?POST"
-                                                               in hoare_pre_imp, assumption)
-       apply (case_tac action)
-         apply (clarsimp)+
-      apply (wp)
-      apply (clarsimp simp: sch_act_simple_def)
-      done
-    show ?thesis
-      apply (simp add: setThreadState_def)
-      apply (wp RR)
-      apply (rule_tac Q="\<lambda>_. ?POST" in hoare_post_imp)
-       apply (clarsimp simp add: sch_act_simple_def)
-      apply (wp hoare_convert_imp)
-      apply (clarsimp simp: Invariants_H.valid_queues_def valid_queues_no_bitmap_def)
-      apply (drule_tac x=d in spec)
-      apply (drule_tac x=p in spec)
-      apply (fastforce dest: bspec elim!: obj_at'_weakenE simp: inQ_def)
-      done
-  qed
-
-lemma (in delete_one_conc_pre) suspend_nonq:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and tcb_at' t
-                 and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
-                 and (\<lambda>s. t \<noteq> ksIdleThread s) and K (t = t')\<rbrace>
-     suspend t
-   \<lbrace>\<lambda>rv s. \<forall>d p. t' \<notin> set (ksReadyQueues s (d, p))\<rbrace>"
-  apply (rule hoare_gen_asm)
-  apply (simp add: suspend_def unless_def)
-  unfolding updateRestartPC_def
-  apply (wp hoare_allI tcbSchedDequeue_t_notksQ sts_ksQ_oaQ)
-    apply wpsimp+
-  done
-
 lemma suspend_makes_inactive:
   "\<lbrace>K (t = t')\<rbrace> suspend t \<lbrace>\<lambda>rv. st_tcb_at' ((=) Inactive) t'\<rbrace>"
   apply (cases "t = t'", simp_all)
@@ -1878,20 +1350,19 @@ 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 tcbSchedEnqueue_ct', wp, simp)
+  by (rule hoare_weaken_pre, wps, wp, simp)
 
 lemma sts_sch_act_not_ct[wp]:
   "\<lbrace>\<lambda>s. sch_act_not (ksCurThread s) s\<rbrace>
    setThreadState st t \<lbrace>\<lambda>_ s. sch_act_not (ksCurThread s) s\<rbrace>"
-  by (rule hoare_weaken_pre, wps tcbSchedEnqueue_ct', wp, simp)
+  by (rule hoare_weaken_pre, wps, wp, simp)
 
 text \<open>Cancelling all IPC in an endpoint or notification object\<close>
 
 lemma ep_cancel_corres_helper:
-  "corres dc ((\<lambda>s. \<forall>t \<in> set list. tcb_at t s) and valid_etcbs)
-             ((\<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')
+  "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
@@ -1900,28 +1371,34 @@ lemma ep_cancel_corres_helper:
                         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 (rule corres_guard_imp [OF setThreadState_corres])
-            apply simp
-           apply (simp add: valid_tcb_state_def)
-          apply simp
-         apply (wp sts_valid_queues)+
-       apply (force simp: tcb_at_is_etcb_at)
-      apply (fastforce elim: obj_at'_weakenE)
-     apply ((wp hoare_vcg_const_Ball_lift | simp)+)[1]
-    apply (rule hoare_pre)
-     apply (wp hoare_vcg_const_Ball_lift
-               weak_sch_act_wf_lift_linear sts_st_tcb' setThreadState_not_st
-               sts_valid_queues tcbSchedEnqueue_not_st
-          | simp)+
-    apply (auto elim: obj_at'_weakenE simp: valid_tcb_state'_def)
+         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
 
+crunches 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 ep_cancel_corres:
   "corres dc (invs and valid_sched and ep_at ep) (invs' and ep_at' ep)
              (cancel_all_ipc ep) (cancelAllIPC ep)"
@@ -1929,10 +1406,10 @@ proof -
   have P:
     "\<And>list.
      corres dc (\<lambda>s. (\<forall>t \<in> set list. tcb_at t s) \<and> valid_pspace s \<and> ep_at ep s
-                        \<and> valid_etcbs s \<and> weak_valid_sched_action s)
+                        \<and> valid_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> Invariants_H.valid_queues s \<and> valid_queues' s \<and> valid_objs' 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;
@@ -1954,22 +1431,23 @@ proof -
         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 R="\<lambda>_ s. \<forall>x\<in>set list. tcb_at' x s \<and> valid_objs' s"
+      apply (rule_tac R="\<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 (rule hoare_name_pre_state)
-      apply ((wp hoare_vcg_const_Ball_lift mapM_x_wp'
-                sts_valid_queues setThreadState_not_st sts_st_tcb' tcbSchedEnqueue_not_st
-           | clarsimp
-           | fastforce elim: obj_at'_weakenE simp: valid_tcb_state'_def)+)[2]
-    apply (rule hoare_name_pre_state)
+      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 elim!: valid_objs_valid_tcbE))+
+           | (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 (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
@@ -1997,6 +1475,8 @@ lemma cancelAllSignals_corres:
   "corres dc (invs and valid_sched and ntfn_at ntfn) (invs' and ntfn_at' ntfn)
              (cancel_all_signals ntfn) (cancelAllSignals ntfn)"
   apply (simp add: cancel_all_signals_def cancelAllSignals_def)
+  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+
@@ -2007,22 +1487,26 @@ lemma cancelAllSignals_corres:
       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 setThreadState_not_st
+                 weak_sch_act_wf_lift_linear
                  set_thread_state_runnable_weak_valid_sched_action
             | simp)+
       apply (rename_tac list)
-      apply (rule_tac R="\<lambda>_ s. (\<forall>x\<in>set list. tcb_at' x s) \<and> valid_objs' s"
+      apply (rule_tac R="\<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_queues setThreadState_not_st
-                  simp: valid_tcb_state'_def)
+      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')+
+   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:
@@ -2061,6 +1545,11 @@ proof -
   done
 qed
 
+lemma tcbSchedEnqueue_valid_pspace'[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>valid_pspace'\<rbrace>"
+  unfolding valid_pspace'_def
+  by wpsimp
+
 lemma cancel_all_invs'_helper:
   "\<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}
@@ -2075,8 +1564,7 @@ lemma cancel_all_invs'_helper:
    apply clarsimp
   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_valid_queues sts_st_tcb' setThreadState_not_st
+             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
@@ -2085,7 +1573,7 @@ lemma cancel_all_invs'_helper:
                  elim!: rsubst[where P=sym_refs]
                  dest!: set_mono_suffix
                 intro!: ext
-       | (drule (1) bspec, clarsimp simp: valid_pspace'_def valid_tcb'_def elim!: valid_objs_valid_tcbE))+
+       | (drule (1) bspec, clarsimp simp: valid_pspace'_def valid_tcb'_def))+
   done
 
 lemma ep_q_refs_max:
@@ -2116,7 +1604,6 @@ lemma rescheduleRequired_invs'[wp]:
   "\<lbrace>invs'\<rbrace> rescheduleRequired \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (simp add: rescheduleRequired_def)
   apply (wp ssa_invs' | simp | wpc)+
-  apply (clarsimp simp: invs'_def valid_state'_def)
   done
 
 lemma invs_rct_ct_activatable':
@@ -2243,6 +1730,7 @@ lemma rescheduleRequired_all_invs_but_ct_not_inQ:
 lemma cancelAllIPC_invs'[wp]:
   "\<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 hoare_seq_ext[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'
@@ -2271,6 +1759,7 @@ lemma cancelAllIPC_invs'[wp]:
 lemma cancelAllSignals_invs'[wp]:
   "\<lbrace>invs'\<rbrace> cancelAllSignals ntfn \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (simp add: cancelAllSignals_def)
+  apply (rule hoare_seq_ext[OF _ stateAssert_sp])
   apply (rule hoare_seq_ext [OF _ get_ntfn_sp'])
   apply (case_tac "ntfnObj ntfna", simp_all)
     apply (wp, simp)
@@ -2305,12 +1794,14 @@ crunch valid_objs'[wp]: tcbSchedEnqueue 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>"
+  "\<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 hoare_seq_ext[OF _ stateAssert_sp])
   apply (rule hoare_seq_ext [OF _ get_ep_sp'])
   apply (rule hoare_pre)
    apply (wp set_ep_valid_objs' setSchedulerAction_valid_objs')
-    apply (rule_tac Q="\<lambda>rv s. valid_objs' s \<and> (\<forall>x\<in>set (epQueue ep). tcb_at' x s)"
+    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)
@@ -2327,8 +1818,9 @@ lemma cancelAllIPC_valid_objs'[wp]:
   done
 
 lemma cancelAllSignals_valid_objs'[wp]:
-  "\<lbrace>valid_objs'\<rbrace> cancelAllSignals ntfn \<lbrace>\<lambda>rv. valid_objs'\<rbrace>"
+  "\<lbrace>valid_objs' and pspace_aligned' and pspace_distinct'\<rbrace> cancelAllSignals ntfn \<lbrace>\<lambda>rv. valid_objs'\<rbrace>"
   apply (simp add: cancelAllSignals_def)
+  apply (rule hoare_seq_ext[OF _ stateAssert_sp])
   apply (rule hoare_seq_ext [OF _ get_ntfn_sp'])
   apply (case_tac "ntfnObj ntfna", simp_all)
     apply (wp, simp)
@@ -2381,19 +1873,17 @@ 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>"
-  apply (simp add: setThreadState_def setQueue_def
-                   rescheduleRequired_def tcbSchedEnqueue_def
-                   unless_def bitmap_fun_defs
-             cong: scheduler_action.case_cong  cong del: if_cong
-            | wp | wpcw)+
-  done
+  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 unless_def)
+  apply (simp add: tcbSchedEnqueue_def tcbQueuePrepend_def unless_def)
   apply (wp | simp add: setQueue_def bitmap_fun_defs)+
   done
 
@@ -2427,19 +1917,41 @@ lemma setObject_ko_wp_at':
                      objBits_def[symmetric] ps_clear_upd
                      in_magnitude_check v projectKOs)
 
-lemma rescheduleRequired_unlive:
-  "\<lbrace>\<lambda>s. ko_wp_at' (Not \<circ> live') p s \<and> ksSchedulerAction s \<noteq> SwitchToThread p\<rbrace>
-      rescheduleRequired
+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>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | simp | wpc)+
-   apply (simp add: tcbSchedEnqueue_def unless_def
-                    threadSet_def setQueue_def threadGet_def)
-   apply (wp setObject_ko_wp_at getObject_tcb_wp
-            | simp add: objBits_simps' bitmap_fun_defs split del: if_split)+
-  apply (clarsimp simp: o_def)
-  apply (drule obj_at_ko_at')
-  apply clarsimp
+  by (clarsimp simp: threadSet_def valid_def getObject_def
+                     setObject_def in_monad loadObject_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 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 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
+
+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>"
+  supply comp_apply[simp del]
+  unfolding rescheduleRequired_def
+  apply (wpsimp wp: tcbSchedEnqueue_unlive_other)
   done
 
 lemmas setEndpoint_ko_wp_at'
@@ -2449,6 +1961,7 @@ 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>"
   apply (simp add: cancelAllIPC_def ep'_Idle_case_helper)
+  apply (rule hoare_seq_ext[OF _ stateAssert_sp])
   apply (rule hoare_seq_ext [OF _ get_ep_sp'])
   apply (rule hoare_pre)
    apply (wp cancelAll_unlive_helper setEndpoint_ko_wp_at'
@@ -2468,6 +1981,7 @@ lemma cancelAllSignals_unlive:
       \<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 (rule hoare_seq_ext[OF _ stateAssert_sp])
   apply (rule hoare_seq_ext [OF _ get_ntfn_sp'])
   apply (case_tac "ntfnObj ntfn", simp_all add: setNotification_def)
     apply wp
@@ -2533,25 +2047,20 @@ lemma cancelBadgedSends_filterM_helper':
   apply (rule hoare_pre)
    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' sts_valid_queues setThreadState_not_st
-             tcbSchedEnqueue_not_st
-             untyped_ranges_zero_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
+  apply (clarsimp simp: valid_pspace'_def cong: conj_cong)
   apply (intro conjI)
-      apply (clarsimp simp: valid_pspace'_def valid_tcb'_def elim!: valid_objs_valid_tcbE dest!: st_tcb_ex_cap'')
-     apply (fastforce dest!: 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)
-    apply (fastforce elim!: obj_atE'
-                      simp: state_refs_of'_def projectKOs tcb_bound_refs'_def
-                            subsetD symreftype_inverse'
-                     split: if_split_asm)+
-  done
+    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]
@@ -2561,7 +2070,8 @@ lemma cancelBadgedSends_invs[wp]:
   shows
   "\<lbrace>invs'\<rbrace> cancelBadgedSends epptr badge \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (simp add: cancelBadgedSends_def)
-  apply (rule hoare_seq_ext [OF _ get_ep_sp'])
+  apply (rule hoare_seq_ext[OF _ stateAssert_sp])
+  apply (rule hoare_seq_ext [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",
@@ -2594,10 +2104,20 @@ lemma cancelBadgedSends_invs[wp]:
 crunch state_refs_of[wp]: tcb_sched_action "\<lambda>s. P (state_refs_of s)"
   (ignore_del: tcb_sched_action)
 
+lemma setEndpoint_valid_tcbs'[wp]:
+  "setEndpoint ePtr val \<lbrace>valid_tcbs'\<rbrace>"
+  unfolding setEndpoint_def
+  apply (wpsimp wp: setObject_valid_tcbs'[where P=\<top>])
+   apply (clarsimp simp: updateObject_default_def monad_simps projectKOs)
+  apply fastforce
+  done
+
 lemma cancelBadgedSends_corres:
   "corres dc (invs and valid_sched and ep_at epptr) (invs' and ep_at' epptr)
          (cancel_badged_sends epptr bdg) (cancelBadgedSends epptr bdg)"
   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 Q'=invs'])
@@ -2607,10 +2127,16 @@ lemma cancelBadgedSends_corres:
   apply (rule corres_guard_imp)
     apply (rule corres_split_nor[OF setEndpoint_corres])
        apply (simp add: ep_relation_def)
-      apply (rule corres_split_eqr[OF _ _ _ hoare_post_add[where R="\<lambda>_. valid_objs'"]])
+      apply (rule corres_split_eqr[OF _ _ _ hoare_post_add
+                                             [where R="\<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 Q'="\<lambda>xs s. (\<forall>x \<in> set xs. tcb_at' x s) \<and> weak_sch_act_wf (ksSchedulerAction s) s \<and> Invariants_H.valid_queues s \<and> valid_queues' s \<and> valid_objs' 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)
@@ -2621,56 +2147,56 @@ lemma cancelBadgedSends_corres:
                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])
+                 apply (rule corres_split[OF tcbSchedEnqueue_corres], simp)
                    apply (rule corres_trivial)
                    apply simp
-                  apply (wp sts_valid_queues gts_st_tcb_at)+
+                  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: is_tcb_def)
-           apply (wp hoare_vcg_const_Ball_lift gts_wp | clarsimp)+
-            apply (wp gts_st_tcb_at hoare_vcg_imp_lift
-                      sts_st_tcb' sts_valid_queues
+            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 (wp gts_st_tcb_at hoare_vcg_imp_lift mapM_wp'
-                 sts_st_tcb' sts_valid_queues
-                 set_thread_state_runnable_weak_valid_sched_action
-                 | clarsimp simp: valid_tcb_state'_def)+
-    apply (wp hoare_vcg_const_Ball_lift  set_ep_valid_objs')+
+       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 (drule ko_at_valid_objs', clarsimp)
-   apply (simp add: projectKOs)
-  apply (clarsimp simp: valid_obj'_def valid_ep'_def invs_weak_sch_act_wf
-                        invs'_def valid_state'_def)
+  apply (fastforce simp: valid_ep'_def)
   done
 
+crunches 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 (simp add: threadGet_def| wp getObject_tcb_wp)+
-      apply (rule hoare_strengthen_post, rule hoare_post_taut)
-      apply (fastforce simp: obj_at'_def projectKOs)
-     apply (rule hoare_post_taut)
-    apply wp+
-  done
+  unfolding suspend_def
+  by (wpsimp simp: comp_def wp: tcbSchedDequeue_not_tcbQueued)
 
 crunch unqueued: prepareThreadDelete "obj_at' (Not \<circ> tcbQueued) t"
 crunch inactive: prepareThreadDelete "st_tcb_at' ((=) Inactive) t'"
-crunch nonq: prepareThreadDelete " \<lambda>s. \<forall>d p. t' \<notin> set (ksReadyQueues s (d, p))"
 
 end
 end
diff --git a/proof/refine/ARM/Ipc_R.thy b/proof/refine/ARM/Ipc_R.thy
index e6a261e3d3..6c418b8e94 100644
--- a/proof/refine/ARM/Ipc_R.thy
+++ b/proof/refine/ARM/Ipc_R.thy
@@ -14,7 +14,7 @@ lemmas lookup_slot_wrapper_defs'[simp] =
    lookupSourceSlot_def lookupTargetSlot_def lookupPivotSlot_def
 
 lemma getMessageInfo_corres: "corres ((=) \<circ> message_info_map)
-                      (tcb_at t) (tcb_at' t)
+                      (tcb_at t and pspace_aligned and pspace_distinct) \<top>
                       (get_message_info t) (getMessageInfo t)"
   apply (rule corres_guard_imp)
     apply (unfold get_message_info_def getMessageInfo_def fun_app_def)
@@ -755,14 +755,6 @@ lemma tcts_sch_act[wp]:
    \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
   by (wp sch_act_wf_lift tcb_in_cur_domain'_lift transferCapsToSlots_pres1)
 
-lemma tcts_vq[wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> transferCapsToSlots ep buffer n caps slots mi \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  by (wp valid_queues_lift transferCapsToSlots_pres1)
-
-lemma tcts_vq'[wp]:
-  "\<lbrace>valid_queues'\<rbrace> transferCapsToSlots ep buffer n caps slots mi \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  by (wp valid_queues_lift' transferCapsToSlots_pres1)
-
 crunch state_refs_of' [wp]: setExtraBadge "\<lambda>s. P (state_refs_of' s)"
 
 lemma tcts_state_refs_of'[wp]:
@@ -976,6 +968,11 @@ crunch ksDomScheduleIdx[wp]: setExtraBadge "\<lambda>s. P (ksDomScheduleIdx s)"
 crunch ksDomSchedule[wp]: transferCapsToSlots "\<lambda>s. P (ksDomSchedule s)"
 crunch ksDomScheduleIdx[wp]: transferCapsToSlots "\<lambda>s. P (ksDomScheduleIdx s)"
 
+crunches transferCapsToSlots
+  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)
 
 lemma transferCapsToSlots_invs[wp]:
   "\<lbrace>\<lambda>s. invs' s \<and> distinct slots
@@ -1181,18 +1178,12 @@ lemma set_mrs_valid_objs' [wp]:
 crunch valid_objs'[wp]: copyMRs valid_objs'
   (wp: crunch_wps simp: crunch_simps)
 
-crunch valid_queues'[wp]: asUser "Invariants_H.valid_queues'"
-  (simp: crunch_simps wp: hoare_drop_imps)
-
-
 lemma setMRs_invs_bits[wp]:
   "\<lbrace>valid_pspace'\<rbrace> setMRs t buf mrs \<lbrace>\<lambda>rv. valid_pspace'\<rbrace>"
   "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>
      setMRs t buf mrs \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
   "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
      setMRs t buf mrs \<lbrace>\<lambda>rv s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> setMRs t buf mrs \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  "\<lbrace>valid_queues'\<rbrace> setMRs t buf mrs \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
   "\<lbrace>\<lambda>s. P (state_refs_of' s)\<rbrace>
      setMRs t buf mrs
    \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
@@ -1209,8 +1200,6 @@ lemma copyMRs_invs_bits[wp]:
   "\<lbrace>valid_pspace'\<rbrace> copyMRs s sb r rb n \<lbrace>\<lambda>rv. valid_pspace'\<rbrace>"
   "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace> copyMRs s sb r rb n
       \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> copyMRs s sb r rb n \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  "\<lbrace>valid_queues'\<rbrace> copyMRs s sb r rb n \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
   "\<lbrace>\<lambda>s. P (state_refs_of' s)\<rbrace>
       copyMRs s sb r rb n
    \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
@@ -1467,15 +1456,15 @@ lemma msgFromLookupFailure_map[simp]:
   by (cases lf, simp_all add: lookup_failure_map_def msgFromLookupFailure_def)
 
 lemma asUser_getRestartPC_corres:
-  "corres (=) (tcb_at t) (tcb_at' t)
-                 (as_user t getRestartPC) (asUser t getRestartPC)"
+  "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+     (as_user t getRestartPC) (asUser t getRestartPC)"
   apply (rule asUser_corres')
   apply (rule corres_Id, simp, simp)
   apply (rule no_fail_getRestartPC)
   done
 
 lemma asUser_mapM_getRegister_corres:
-  "corres (=) (tcb_at t) (tcb_at' t)
+  "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
      (as_user t (mapM getRegister regs))
      (asUser t (mapM getRegister regs))"
   apply (rule asUser_corres')
@@ -1485,7 +1474,7 @@ lemma asUser_mapM_getRegister_corres:
   done
 
 lemma makeArchFaultMessage_corres:
-  "corres (=) (tcb_at t) (tcb_at' t)
+  "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
   (make_arch_fault_msg f t)
   (makeArchFaultMessage (arch_fault_map f) t)"
   apply (cases f, clarsimp simp: makeArchFaultMessage_def split: arch_fault.split)
@@ -1496,7 +1485,7 @@ lemma makeArchFaultMessage_corres:
   done
 
 lemma makeFaultMessage_corres:
-  "corres (=) (tcb_at t) (tcb_at' t)
+  "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
      (make_fault_msg ft t)
      (makeFaultMessage (fault_map ft) t)"
   apply (cases ft, simp_all add: makeFaultMessage_def split del: if_split)
@@ -1534,7 +1523,8 @@ lemmas threadget_fault_corres =
 lemma doFaultTransfer_corres:
   "corres dc
     (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 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)
@@ -1543,7 +1533,8 @@ lemma doFaultTransfer_corres:
                         ARM_H.badgeRegister_def badge_register_def)
   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"
+                             case_option \<top> in_user_frame recv_buf and
+                             pspace_aligned and pspace_distinct"
               and Q'="\<lambda>fault'. tcb_at' sender and tcb_at' receiver and
                                case_option \<top> valid_ipc_buffer_ptr' recv_buf"
                in corres_underlying_split)
@@ -1681,10 +1672,6 @@ crunch vp[wp]: doIPCTransfer "valid_pspace'"
   (wp: crunch_wps hoare_vcg_const_Ball_lift get_rs_cte_at' wp: transferCapsToSlots_vp simp:ball_conj_distrib )
 crunch sch_act_wf[wp]: doIPCTransfer "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
   (wp: crunch_wps get_rs_cte_at' ignore: transferCapsToSlots  simp: zipWithM_x_mapM)
-crunch vq[wp]: doIPCTransfer "Invariants_H.valid_queues"
-  (wp: crunch_wps get_rs_cte_at' ignore: transferCapsToSlots  simp: zipWithM_x_mapM)
-crunch vq'[wp]: doIPCTransfer "valid_queues'"
-  (wp: crunch_wps get_rs_cte_at' ignore: transferCapsToSlots  simp: zipWithM_x_mapM)
 crunch state_refs_of[wp]: doIPCTransfer "\<lambda>s. P (state_refs_of' s)"
   (wp: crunch_wps get_rs_cte_at' ignore: transferCapsToSlots  simp: zipWithM_x_mapM)
 crunch ct[wp]: doIPCTransfer "cur_tcb'"
@@ -1759,7 +1746,7 @@ crunch nosch[wp]: doIPCTransfer "\<lambda>s. P (ksSchedulerAction s)"
    simp: split_def zipWithM_x_mapM)
 
 lemma handle_fault_reply_registers_corres:
-  "corres (=) (tcb_at t) (tcb_at' t)
+  "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
            (do t' \<leftarrow> arch_get_sanitise_register_info t;
                y \<leftarrow> as_user t
                 (zipWithM_x
@@ -1788,7 +1775,7 @@ lemma handle_fault_reply_registers_corres:
 
 lemma handleFaultReply_corres:
   "ft' = fault_map ft \<Longrightarrow>
-   corres (=) (tcb_at t) (tcb_at' t)
+   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)
@@ -1831,16 +1818,6 @@ lemma getThreadCallerSlot_inv:
   "\<lbrace>P\<rbrace> getThreadCallerSlot t \<lbrace>\<lambda>_. P\<rbrace>"
   by (simp add: getThreadCallerSlot_def, wp)
 
-lemma deleteCallerCap_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>
-   deleteCallerCap t
-   \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: deleteCallerCap_def getSlotCap_def getThreadCallerSlot_def locateSlot_conv)
-  apply (wp getThreadCallerSlot_inv cteDeleteOne_ct_not_ksQ getCTE_wp)
-  apply (clarsimp simp: cte_wp_at_ctes_of)
-  done
-
 crunch tcb_at'[wp]: unbindNotification "tcb_at' x"
 
 lemma finaliseCapTrue_standin_tcb_at' [wp]:
@@ -1994,39 +1971,11 @@ lemma cteDeleteOne_weak_sch_act[wp]:
 crunch weak_sch_act_wf[wp]: emptySlot "\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s"
 
 crunch pred_tcb_at'[wp]: handleFaultReply "pred_tcb_at' proj P t"
-crunch valid_queues[wp]: handleFaultReply "Invariants_H.valid_queues"
-crunch valid_queues'[wp]: handleFaultReply "valid_queues'"
 crunch tcb_in_cur_domain'[wp]: handleFaultReply "tcb_in_cur_domain' t"
 
 crunch sch_act_wf[wp]: unbindNotification "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
 (wp: sbn_sch_act')
 
-crunch valid_queues'[wp]: cteDeleteOne valid_queues'
-  (simp: crunch_simps inQ_def
-     wp: crunch_wps sts_st_tcb' getObject_inv loadObject_default_inv
-         threadSet_valid_queues' rescheduleRequired_valid_queues'_weak)
-
-lemma cancelSignal_valid_queues'[wp]:
-  "\<lbrace>valid_queues'\<rbrace> cancelSignal t ntfn \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (simp add: cancelSignal_def)
-  apply (rule hoare_pre)
-   apply (wp getNotification_wp| wpc | simp)+
-  done
-
-lemma cancelIPC_valid_queues'[wp]:
-  "\<lbrace>valid_queues' and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) \<rbrace> cancelIPC t \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (simp add: cancelIPC_def Let_def getThreadReplySlot_def locateSlot_conv liftM_def)
-  apply (rule hoare_seq_ext[OF _ gts_sp'])
-  apply (case_tac state, simp_all) defer 2
-  apply (rule hoare_pre)
-   apply ((wp getEndpoint_wp getCTE_wp | wpc | simp)+)[8]
-  apply (wp cteDeleteOne_valid_queues')
-  apply (rule_tac Q="\<lambda>_. valid_queues' and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)" in hoare_post_imp)
-  apply (clarsimp simp: capHasProperty_def cte_wp_at_ctes_of)
-   apply (wp threadSet_valid_queues' threadSet_sch_act| simp)+
-  apply (clarsimp simp: inQ_def)
-  done
-
 crunch valid_objs'[wp]: handleFaultReply valid_objs'
 
 lemma cte_wp_at_is_reply_cap_toI:
@@ -2034,6 +1983,17 @@ lemma cte_wp_at_is_reply_cap_toI:
    \<Longrightarrow> cte_wp_at (is_reply_cap_to t) ptr s"
   by (fastforce simp: cte_wp_at_reply_cap_to_ex_rights)
 
+crunches handle_fault_reply
+  for pspace_alignedp[wp]: pspace_aligned
+  and pspace_distinct[wp]: pspace_distinct
+
+crunches 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 doReplyTransfer_corres:
   "corres dc
      (einvs and tcb_at receiver and tcb_at sender
@@ -2045,7 +2005,7 @@ lemma doReplyTransfer_corres:
   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)+)
+     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
@@ -2079,8 +2039,12 @@ lemma doReplyTransfer_corres:
            apply (rule corres_split[OF setThreadState_corres])
               apply simp
              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_queues sts_valid_objs' delete_one_tcbDomain_obj_at'
-                   | simp add: valid_tcb_state'_def)+
+            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])
@@ -2089,12 +2053,16 @@ lemma doReplyTransfer_corres:
           apply (fastforce)
          apply (clarsimp simp:is_cap_simps)
         apply (wp weak_valid_sched_action_lift)+
-       apply (rule_tac Q="\<lambda>_. valid_queues' and valid_objs' and cur_tcb' and tcb_at' receiver and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)" in hoare_post_imp, simp add: sch_act_wf_weak)
+       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)
+    apply (clarsimp simp: invs_psp_aligned invs_distinct)
     apply (rule conjI, erule invs_valid_objs)
     apply (rule conjI, clarsimp)+
     apply (rule conjI)
@@ -2118,11 +2086,13 @@ lemma doReplyTransfer_corres:
                  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 P="valid_sched and cur_tcb and tcb_at receiver"
-                            and P'="tcb_at' receiver and cur_tcb'
+                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 Invariants_H.valid_queues and valid_queues' and valid_objs'"
-                              in corres_inst)
+                                      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])
@@ -2130,24 +2100,24 @@ lemma doReplyTransfer_corres:
                      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_queues | simp | force simp: valid_sched_def valid_sched_action_def valid_tcb_state'_def)+
+                              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_valid_queues threadSet_valid_queues'
+                         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 (wp threadSet_cur weak_sch_act_wf_lift_linear threadSet_pred_tcb_no_state
-                      thread_set_not_state_valid_sched threadSet_valid_queues threadSet_valid_queues'
-                 | simp add: runnable_def inQ_def valid_tcb'_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"
+     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)
+     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>)
@@ -2358,7 +2328,7 @@ proof -
              apply (rule setEndpoint_corres)
              apply (simp add: ep_relation_def)
             apply wp+
-          apply (clarsimp simp: st_tcb_at_tcb_at valid_tcb_state_def)
+          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)
@@ -2368,7 +2338,7 @@ proof -
             apply (rule setEndpoint_corres)
             apply (simp add: ep_relation_def)
            apply wp+
-         apply (clarsimp simp: st_tcb_at_tcb_at valid_tcb_state_def)
+         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)
@@ -2407,10 +2377,12 @@ proof -
                  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 setThreadState_valid_queues' sts_valid_queues sts_weak_sch_act_wf
+               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)
+              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)
@@ -2475,11 +2447,13 @@ proof -
                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 setThreadState_valid_queues' sts_valid_queues sts_weak_sch_act_wf
+              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)+)[1]
+                     | 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)
@@ -2560,14 +2534,15 @@ lemma sendSignal_corres:
                apply (rule possibleSwitchTo_corres)
               apply wp
              apply (wp set_thread_state_runnable_weak_valid_sched_action sts_st_tcb_at'
-                       sts_valid_queues sts_st_tcb' hoare_disjI2
+                       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 (clarsimp simp: invs'_def valid_state'_def sch_act_wf_weak
-                               valid_tcb_state'_def)
+         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)+
@@ -2593,23 +2568,23 @@ lemma sendSignal_corres:
           apply (rule corres_split[OF asUser_setRegister_corres])
             apply (rule possibleSwitchTo_corres)
            apply ((wp | simp)+)[1]
-          apply (rule_tac Q="\<lambda>_. Invariants_H.valid_queues and valid_queues' and
-                                 (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and
+          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'"
+                                 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_queues setThreadState_valid_queues'
-                  setThreadState_st_tcb
+        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 (clarsimp 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 (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)
 
@@ -2627,16 +2602,14 @@ lemma sendSignal_corres:
           apply (wp cur_tcb_lift | 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_queues setThreadState_valid_queues'
-                 setThreadState_st_tcb
-            | 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 (clarsimp 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 (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]
@@ -2667,38 +2640,6 @@ lemma possibleSwitchTo_sch_act[wp]:
   apply (auto simp: obj_at'_def projectKOs tcb_in_cur_domain'_def)
   done
 
-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>"
-  apply (simp add: possibleSwitchTo_def curDomain_def bitmap_fun_defs)
-  apply (wp hoare_drop_imps | wpc | simp)+
-  apply (auto simp: valid_tcb'_def weak_sch_act_wf_def
-              dest: pred_tcb_at'
-             elim!: valid_objs_valid_tcbE)
-  done
-
-lemma possibleSwitchTo_ksQ':
-  "\<lbrace>(\<lambda>s. t' \<notin> set (ksReadyQueues s p) \<and> sch_act_not t' s) and K(t' \<noteq> t)\<rbrace>
-     possibleSwitchTo t
-   \<lbrace>\<lambda>_ s. t' \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: possibleSwitchTo_def curDomain_def bitmap_fun_defs)
-  apply (wp hoare_weak_lift_imp rescheduleRequired_ksQ' tcbSchedEnqueue_ksQ threadGet_wp
-         | wpc
-         | simp split del: if_split)+
-  apply (auto simp: obj_at'_def)
-  done
-
-lemma possibleSwitchTo_valid_queues'[wp]:
-  "\<lbrace>valid_queues' and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)
-                  and st_tcb_at' runnable' t\<rbrace>
-   possibleSwitchTo t
-   \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (simp add: possibleSwitchTo_def curDomain_def bitmap_fun_defs)
-  apply (wp hoare_weak_lift_imp threadGet_wp | wpc | simp)+
-  apply (auto simp: obj_at'_def)
-  done
-
 crunch st_refs_of'[wp]: possibleSwitchTo "\<lambda>s. P (state_refs_of' s)"
   (wp: crunch_wps)
 
@@ -2710,15 +2651,15 @@ crunch ct[wp]: possibleSwitchTo 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>"
+  "\<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)+
-  apply (auto simp: obj_at'_def projectKOs)
+  apply (auto simp: obj_at'_def)
   done
 
 crunches possibleSwitchTo
@@ -2748,10 +2689,6 @@ crunches sendSignal, setBoundNotification
    rule: irqs_masked_lift)
 end
 
-lemma sts_running_valid_queues:
-  "runnable' st \<Longrightarrow> \<lbrace> Invariants_H.valid_queues \<rbrace> setThreadState st t \<lbrace>\<lambda>_. Invariants_H.valid_queues \<rbrace>"
-  by (wp sts_valid_queues, clarsimp)
-
 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)
@@ -2764,24 +2701,21 @@ lemma setThreadState_nonqueued_state_update:
                \<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)
-               \<and> (\<not> runnable' st \<longrightarrow> (\<forall>p. t \<notin> set (ksReadyQueues s p)))\<rbrace>
-  setThreadState st t \<lbrace>\<lambda>rv. invs'\<rbrace>"
+               \<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
-                            sts_valid_queues
-                            setThreadState_ct_not_inQ)
+  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 (drule simple_st_tcb_at_state_refs_ofD')
   apply (drule bound_tcb_at_state_refs_ofD')
-  apply (rule conjI, fastforce)
-  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 (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
 
 lemma cteDeleteOne_reply_cap_to'[wp]:
@@ -2849,16 +2783,14 @@ lemma cancelAllIPC_not_rct[wp]:
    \<lbrace>\<lambda>_ s. ksSchedulerAction s \<noteq> ResumeCurrentThread \<rbrace>"
   apply (simp add: cancelAllIPC_def)
   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 (wp)+
-     apply (rule hoare_post_imp [OF _ rescheduleRequired_notresume], simp)
-    apply simp
-    apply (rule mapM_x_wp_inv)
-    apply (wp)+
-  apply (wp hoare_vcg_all_lift hoare_drop_imp)
-    apply (simp_all)
+      apply (wpsimp wp: hoare_vcg_all_lift hoare_drop_imp)+
   done
 
 lemma cancelAllSignals_not_rct[wp]:
@@ -2867,12 +2799,10 @@ lemma cancelAllSignals_not_rct[wp]:
    \<lbrace>\<lambda>_ s. ksSchedulerAction s \<noteq> ResumeCurrentThread \<rbrace>"
   apply (simp add: cancelAllSignals_def)
   apply (wp | wpc)+
-     apply (rule hoare_post_imp [OF _ rescheduleRequired_notresume], simp)
-    apply simp
-    apply (rule mapM_x_wp_inv)
-    apply (wp)+
-  apply (wp hoare_vcg_all_lift hoare_drop_imp)
-    apply (simp_all)
+       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 not_rct[wp]: finaliseCapTrue_standin "\<lambda>s. ksSchedulerAction s \<noteq> ResumeCurrentThread"
@@ -2958,7 +2888,6 @@ lemma sai_invs'[wp]:
      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
-               sts_valid_queues [where st="Structures_H.thread_state.Running", simplified]
                set_ntfn_valid_objs' cur_tcb_lift sts_st_tcb'
                hoare_convert_imp [OF setNotification_nosch]
            | simp split del: if_split)+)[3]
@@ -3033,8 +2962,10 @@ lemma sai_invs'[wp]:
                    dest!: global'_no_ex_cap st_tcb_ex_cap'' ko_at_valid_objs')+
 
 lemma replyFromKernel_corres:
-  "corres dc (tcb_at t and invs) (tcb_at' t and invs')
+  "corres dc (tcb_at t and invs) invs'
              (reply_from_kernel t r) (replyFromKernel t r)"
+  apply (rule corres_cross_add_guard[where Q'="tcb_at' t"])
+   apply (fastforce intro!: tcb_at_cross)
   apply (case_tac r)
   apply (clarsimp simp: replyFromKernel_def reply_from_kernel_def
                         badge_register_def badgeRegister_def)
@@ -3045,7 +2976,7 @@ lemma replyFromKernel_corres:
            apply simp
           apply (rule setMessageInfo_corres)
           apply (wp hoare_case_option_wp hoare_valid_ipc_buffer_ptr_typ_at'
-                 | clarsimp)+
+                 | fastforce)+
   done
 
 lemma rfk_invs':
@@ -3058,7 +2989,7 @@ lemma rfk_invs':
 crunch nosch[wp]: replyFromKernel "\<lambda>s. P (ksSchedulerAction s)"
 
 lemma completeSignal_corres:
-  "corres dc (ntfn_at ntfnptr and tcb_at tcb and pspace_aligned and valid_objs
+  "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)"
@@ -3083,12 +3014,12 @@ lemma completeSignal_corres:
 
 
 lemma doNBRecvFailedTransfer_corres:
-  "corres dc (tcb_at thread)
-            (tcb_at' thread)
-            (do_nbrecv_failed_transfer thread)
-            (doNBRecvFailedTransfer thread)"
+  "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 (simp add: badgeRegister_def badge_register_def, rule asUser_setRegister_corres)
+  by (corres corres: asUser_setRegister_corres
+               simp: badgeRegister_def badge_register_def)+
 
 lemma receiveIPC_corres:
   assumes "is_ep_cap cap" and "cap_relation cap cap'"
@@ -3173,11 +3104,11 @@ lemma receiveIPC_corres:
                                              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 Invariants_H.valid_queues
-                                                   and valid_queues'
                                                    and valid_pspace'
                                                    and valid_objs'
-                                             and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)"
+                                             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])
@@ -3186,17 +3117,18 @@ lemma receiveIPC_corres:
                        apply (rule corres_split[OF setThreadState_corres])
                           apply simp
                          apply (rule possibleSwitchTo_corres)
-                        apply (wp sts_st_tcb_at' set_thread_state_runnable_weak_valid_sched_action
-                             | simp)+
-                       apply (wp sts_st_tcb_at'_cases sts_valid_queues setThreadState_valid_queues'
-                                 setThreadState_st_tcb
+                        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 (clarsimp simp: st_tcb_at_tcb_at st_tcb_def2 valid_sched_def
-                                            valid_sched_action_def)
+                      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"
-                         in hoare_post_imp, erule sch_act_wf_weak)
+                   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
@@ -3219,16 +3151,15 @@ lemma receiveIPC_corres:
                 apply wp+
               apply (rule corres_guard_imp, rule doNBRecvFailedTransfer_corres, simp)
               apply simp
-             apply (clarsimp simp: valid_tcb_state_def)
+             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 (clarsimp simp: valid_cap_def invs_psp_aligned invs_valid_objs pred_tcb_at_def
-                         valid_obj_def valid_tcb_def valid_bound_ntfn_def
-                  dest!: invs_valid_objs
-                  elim!: obj_at_valid_objsE
-                  split: option.splits)
+   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'
@@ -3262,7 +3193,7 @@ lemma receiveSignal_corres:
              apply (rule setNotification_corres)
              apply (simp add: ntfn_relation_def)
             apply wp+
-          apply (rule corres_guard_imp, rule doNBRecvFailedTransfer_corres, simp+)
+          apply (rule corres_guard_imp, rule doNBRecvFailedTransfer_corres, fastforce+)
        \<comment> \<open>WaitingNtfn\<close>
        apply (simp add: ntfn_relation_def)
        apply (rule corres_guard_imp)
@@ -3273,7 +3204,7 @@ lemma receiveSignal_corres:
             apply (simp add: ntfn_relation_def)
            apply wp+
          apply (rule corres_guard_imp)
-           apply (rule doNBRecvFailedTransfer_corres, simp+)
+           apply (rule doNBRecvFailedTransfer_corres, fastforce+)
       \<comment> \<open>ActiveNtfn\<close>
       apply (simp add: ntfn_relation_def)
       apply (rule corres_guard_imp)
@@ -3343,7 +3274,7 @@ lemma sendFaultIPC_corres:
                   | 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 (simp add: valid_cap_def)
+          apply (fastforce simp: valid_cap_def)
          apply (clarsimp simp: valid_cap'_def inQ_def)
         apply auto[1]
         apply (clarsimp simp: lookup_failure_map_def)
@@ -3361,14 +3292,16 @@ lemma gets_the_noop_corres:
   done
 
 lemma handleDoubleFault_corres:
-  "corres dc (tcb_at thread)
-             (tcb_at' thread and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s))
+  "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_underlying_split [OF setThreadState_corres])
+           rule corres_split[OF setThreadState_corres])
        apply simp
       apply (rule corres_noop2)
          apply (simp add: exs_valid_def return_def)
@@ -3377,7 +3310,7 @@ lemma handleDoubleFault_corres:
         apply (rule asUser_inv)
         apply (rule getRestartPC_inv)
        apply (wp no_fail_getRestartPC)+
-    apply (wp|simp)+
+   apply (wp|simp)+
   done
 
 crunch tcb' [wp]: sendFaultIPC "tcb_at' t" (wp: crunch_wps)
@@ -3417,30 +3350,6 @@ crunch sch_act_wf: setupCallerCap
   "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
   (wp: crunch_wps ssa_sch_act sts_sch_act rule: sch_act_wf_lift)
 
-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 vq[wp]: cteInsert "Invariants_H.valid_queues"
-  (wp: crunch_wps)
-
-crunch vq[wp]: getThreadCallerSlot "Invariants_H.valid_queues"
-  (wp: crunch_wps)
-
-crunch vq[wp]: getThreadReplySlot "Invariants_H.valid_queues"
-  (wp: crunch_wps)
-
-lemma setupCallerCap_vq[wp]:
-  "\<lbrace>Invariants_H.valid_queues and (\<lambda>s. \<forall>p. send \<notin> set (ksReadyQueues s p))\<rbrace>
-   setupCallerCap send recv grant \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: setupCallerCap_def)
-  apply (wp crunch_wps sts_valid_queues)
-  apply (fastforce simp: valid_queues_def obj_at'_def inQ_def)
-  done
-
-crunch vq'[wp]: setupCallerCap "valid_queues'"
-  (wp: crunch_wps)
-
 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)"
@@ -3484,7 +3393,7 @@ lemma setupCallerCap_vp[wp]:
 declare haskell_assert_inv[wp del]
 
 lemma setupCallerCap_iflive[wp]:
-  "\<lbrace>if_live_then_nonz_cap' and ex_nonz_cap_to' sender\<rbrace>
+  "\<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
@@ -3496,7 +3405,7 @@ lemma setupCallerCap_iflive[wp]:
 
 lemma setupCallerCap_ifunsafe[wp]:
   "\<lbrace>if_unsafe_then_cap' and valid_objs' and
-    ex_nonz_cap_to' rcvr and tcb_at' rcvr\<rbrace>
+    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
@@ -3518,13 +3427,11 @@ lemma setupCallerCap_global_refs'[wp]:
    \<lbrace>\<lambda>rv. valid_global_refs'\<rbrace>"
   unfolding setupCallerCap_def getThreadCallerSlot_def
             getThreadReplySlot_def locateSlot_conv
-  apply (wp getSlotCap_cte_wp_at
-    | simp add: o_def unique_master_reply_cap'
-    | strengthen eq_imp_strg
-    | wp (once) getCTE_wp | clarsimp simp: cte_wp_at_ctes_of)+
-  (* at setThreadState *)
-  apply (rule_tac Q="\<lambda>_. valid_global_refs'" in hoare_post_imp, wpsimp+)
-  done
+  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 valid_arch'[wp]: setupCallerCap "valid_arch_state'"
   (wp: hoare_drop_imps)
@@ -3703,12 +3610,21 @@ crunch ctes_of[wp]: possibleSwitchTo "\<lambda>s. P (ctes_of s)"
 lemmas possibleSwitchToTo_cteCaps_of[wp]
     = cteCaps_of_ctes_of_lift[OF possibleSwitchTo_ctes_of]
 
+crunches asUser
+  for valid_bitmaps[wp]: valid_bitmaps
+  (rule: valid_bitmaps_lift wp: crunch_wps)
+
+crunches 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)
+
 (* 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 (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))
           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
@@ -3726,7 +3642,7 @@ lemma ri_invs' [wp]:
      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
-                sts_valid_queues setThreadState_ct_not_inQ
+                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)
@@ -3747,7 +3663,6 @@ lemma ri_invs' [wp]:
        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 (thin_tac "\<forall>a b. t \<notin> set (ksReadyQueues one (a, b))") \<comment> \<open>causes slowdown\<close>
          apply (safe ; solves \<open>auto\<close>)
         apply fastforce
        apply fastforce
@@ -3758,7 +3673,7 @@ lemma ri_invs' [wp]:
     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
-               sts_valid_queues setThreadState_ct_not_inQ
+               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)
@@ -3782,9 +3697,8 @@ lemma ri_invs' [wp]:
    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' sts_valid_queues
-              setThreadState_ct_not_inQ possibleSwitchTo_valid_queues
-              possibleSwitchTo_valid_queues'
+              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
@@ -3802,8 +3716,6 @@ lemma ri_invs' [wp]:
                          st_tcb_at_refs_of_rev' conj_ac
               split del: if_split
                    cong: if_cong)
-   apply (frule_tac t=sender in valid_queues_not_runnable'_not_ksQ)
-    apply (erule pred_tcb'_weakenE, clarsimp)
    apply (subgoal_tac "sch_act_not sender s")
     prefer 2
     apply (clarsimp simp: pred_tcb_at'_def obj_at'_def)
@@ -3837,7 +3749,6 @@ lemma ri_invs' [wp]:
 lemma rai_invs'[wp]:
   "\<lbrace>invs' and sch_act_not t
           and st_tcb_at' simple' t
-          and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))
           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
@@ -3854,7 +3765,7 @@ lemma rai_invs'[wp]:
     apply (simp add: invs'_def valid_state'_def)
     apply (rule hoare_pre)
      apply (wp valid_irq_node_lift sts_sch_act' typ_at_lifts
-               sts_valid_queues setThreadState_ct_not_inQ
+               setThreadState_ct_not_inQ
                asUser_urz
             | simp add: valid_ntfn'_def doNBRecvFailedTransfer_def | wpc)+
     apply (clarsimp simp: pred_tcb_at' valid_tcb_state'_def)
@@ -3872,7 +3783,7 @@ lemma rai_invs'[wp]:
        apply (clarsimp split: if_split_asm)
       apply (fastforce simp: tcb_bound_refs'_def symreftype_inverse'
                       split: if_split_asm)
-     apply (clarsimp dest!: global'_no_ex_cap)
+     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)
@@ -3892,7 +3803,7 @@ lemma rai_invs'[wp]:
   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'
-             sts_valid_queues setThreadState_ct_not_inQ typ_at_lifts
+             setThreadState_ct_not_inQ typ_at_lifts
              asUser_urz
         | simp add: valid_ntfn'_def doNBRecvFailedTransfer_def | wpc)+
   apply (clarsimp simp: valid_tcb_state'_def)
@@ -3920,7 +3831,7 @@ lemma rai_invs'[wp]:
         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 (clarsimp dest!: global'_no_ex_cap)
+  apply (fastforce dest!: global'_no_ex_cap)
   done
 
 lemma getCTE_cap_to_refs[wp]:
@@ -3949,7 +3860,6 @@ 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>Invariants_H.valid_queues\<rbrace> cteInsert a b c \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<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
@@ -3974,9 +3884,12 @@ crunch irqs_masked'[wp]: possibleSwitchTo "irqs_masked'"
 crunch urz[wp]: possibleSwitchTo "untyped_ranges_zero'"
   (simp: crunch_simps unless_def wp: crunch_wps)
 
+crunches possibleSwitchTo
+  for pspace_aligned'[wp]: pspace_aligned'
+  and pspace_distinct'[wp]: pspace_distinct'
+
 lemma si_invs'[wp]:
   "\<lbrace>invs' and st_tcb_at' simple' t
-          and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))
           and sch_act_not t
           and ex_nonz_cap_to' ep and ex_nonz_cap_to' t\<rbrace>
   sendIPC bl call ba cg cgr t ep
@@ -3995,8 +3908,8 @@ lemma si_invs'[wp]:
      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 sts_valid_queues setThreadState_ct_not_inQ
-               possibleSwitchTo_ksQ' possibleSwitchTo_ct_not_inQ hoare_vcg_all_lift sts_ksQ'
+               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"]
@@ -4050,8 +3963,7 @@ lemma si_invs'[wp]:
     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' sts_valid_queues
-               setThreadState_ct_not_inQ)
+     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")
@@ -4070,8 +3982,7 @@ lemma si_invs'[wp]:
    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'
-              sts_valid_queues setThreadState_ct_not_inQ)
+    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)
@@ -4098,19 +4009,15 @@ lemma si_invs'[wp]:
 lemma sfi_invs_plus':
   "\<lbrace>invs' and st_tcb_at' simple' t
           and sch_act_not t
-          and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))
           and ex_nonz_cap_to' t\<rbrace>
-      sendFaultIPC t f
-   \<lbrace>\<lambda>rv. invs'\<rbrace>, \<lbrace>\<lambda>rv. invs' and st_tcb_at' simple' t
-                      and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))
-                      and sch_act_not t and (\<lambda>s. ksIdleThread s \<noteq> 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'
            | wpc | simp)+
    apply (rule_tac Q'="\<lambda>rv s. invs' s \<and> sch_act_not t s
                              \<and> st_tcb_at' simple' t s
-                             \<and> (\<forall>p. t \<notin> set (ksReadyQueues s p))
                              \<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)"
@@ -4122,12 +4029,16 @@ lemma sfi_invs_plus':
   apply (subst(asm) global'_no_ex_cap, auto)
   done
 
+crunches send_fault_ipc
+  for pspace_aligned[wp]: "pspace_aligned :: det_ext state \<Rightarrow> _"
+  and pspace_distinct[wp]: "pspace_distinct :: det_ext state \<Rightarrow> _"
+  (simp: crunch_simps wp: crunch_wps)
+
 lemma handleFault_corres:
   "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 (\<lambda>s. \<forall>p. thread \<notin> set(ksReadyQueues s p))
                     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)
@@ -4142,9 +4053,6 @@ lemma handleFault_corres:
          apply simp
         apply (rule handleDoubleFault_corres)
        apply wp+
-      apply (rule hoare_post_impErr, rule sfi_invs_plus', simp_all)[1]
-      apply clarsimp
-     apply wp+
    apply (clarsimp simp: st_tcb_at_tcb_at st_tcb_def2 invs_def
                          valid_state_def valid_idle_def)
   apply auto
@@ -4155,17 +4063,13 @@ lemma sts_invs_minor'':
                    \<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. (\<exists>p. t \<in> set (ksReadyQueues s p)) \<longrightarrow> runnable' st)
-      and (\<lambda>s. runnable' st \<and> obj_at' tcbQueued t s
-                                      \<longrightarrow> st_tcb_at' runnable' t s)
       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' sts_valid_queues
-             setThreadState_ct_not_inQ)
+   apply (wp valid_irq_node_lift sts_sch_act' setThreadState_ct_not_inQ)
   apply clarsimp
   apply (rule conjI)
    apply fastforce
@@ -4180,12 +4084,11 @@ lemma sts_invs_minor'':
    apply (clarsimp dest!: st_tcb_at_state_refs_ofD'
                    elim!: rsubst[where P=sym_refs]
                   intro!: ext)
-  apply (clarsimp elim!: st_tcb_ex_cap'')
+  apply (fastforce elim!: st_tcb_ex_cap'')
   done
 
 lemma hf_invs' [wp]:
   "\<lbrace>invs' and sch_act_not t
-          and (\<lambda>s. \<forall>p. t \<notin> set(ksReadyQueues s p))
           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>"
diff --git a/proof/refine/ARM/KHeap_R.thy b/proof/refine/ARM/KHeap_R.thy
index 2708b28ab0..913226b0b9 100644
--- a/proof/refine/ARM/KHeap_R.thy
+++ b/proof/refine/ARM/KHeap_R.thy
@@ -14,8 +14,45 @@ lemma lookupAround2_known1:
   "m x = Some y \<Longrightarrow> fst (lookupAround2 x m) = Some (x, y)"
   by (fastforce simp: lookupAround2_char1)
 
+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
+
 context begin interpretation Arch . (*FIXME: arch_split*)
 
+lemma setObject_modify_variable_size:
+  fixes v :: "'a :: pspace_storable" shows
+  "\<lbrakk>obj_at' (P :: 'a \<Rightarrow> bool) p s; updateObject v = updateObject_default v;
+    (1 :: machine_word) < 2 ^ objBits v; obj_at' (\<lambda>obj. objBits v = objBits obj) p s\<rbrakk>
+   \<Longrightarrow> setObject p v s = modify (ksPSpace_update (\<lambda>ps. ps (p \<mapsto> injectKO v))) s"
+  apply (clarsimp simp: setObject_def split_def exec_gets obj_at'_def projectKOs
+                        lookupAround2_known1 assert_opt_def updateObject_default_def bind_assoc)
+  apply (simp add: projectKO_def alignCheck_assert)
+  apply (simp add: project_inject objBits_def)
+  apply (clarsimp simp only: koTypeOf_injectKO)
+  apply (frule in_magnitude_check[where s'=s])
+    apply blast
+   apply fastforce
+  apply (simp add: magnitudeCheck_assert in_monad bind_def gets_def oassert_opt_def
+                   get_def return_def)
+  apply (simp add: simpler_modify_def)
+  done
+
+lemma setObject_modify:
+  fixes v :: "'a :: pspace_storable" shows
+  "\<lbrakk>obj_at' (P :: 'a \<Rightarrow> bool) p s; updateObject v = updateObject_default v;
+    (1 :: machine_word) < 2 ^ objBits v; \<And>ko. P ko \<Longrightarrow> objBits ko = objBits v \<rbrakk>
+   \<Longrightarrow> setObject p v s = modify (ksPSpace_update (\<lambda>ps. ps (p \<mapsto> injectKO v))) s"
+  apply (rule setObject_modify_variable_size)
+     apply fastforce
+    apply fastforce
+  apply fastforce
+  unfolding obj_at'_def
+  by fastforce
+
 lemma obj_at_getObject:
   assumes R:
   "\<And>a b n ko s obj::'a::pspace_storable.
@@ -116,8 +153,7 @@ lemma corres_get_tcb [corres]:
   apply (drule bspec)
    apply clarsimp
    apply blast
-  apply (clarsimp simp add: other_obj_relation_def
-                            lookupAround2_known1)
+  apply (clarsimp simp: tcb_relation_cut_def lookupAround2_known1)
   done
 
 lemma lookupAround2_same1[simp]:
@@ -383,6 +419,40 @@ lemma setObject_tcb_strongest:
                         ps_clear_upd)
   done
 
+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 opt_pred_def projectKO_opts_defs projectKOs projectKO_eq
+          split: if_split_asm
+                 Structures_H.kernel_object.split_asm
+
+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_tcbs_of'[wp]:
+  "setObject c (notification :: notification) \<lbrace>\<lambda>s. P' (tcbs_of' s)\<rbrace>"
+  by setObject_easy_cases
+
+lemma setObject_cte_tcbSchedNexts_of[wp]:
+  "setObject c (cte :: cte) \<lbrace>\<lambda>s. P' (tcbSchedNexts_of s)\<rbrace>"
+  by setObject_easy_cases
+
+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_tcbQueued[wp]:
+  "setObject c (cte :: cte) \<lbrace>\<lambda>s. P' (tcbQueued |< tcbs_of' s)\<rbrace>"
+  supply inQ_def[simp]
+  by setObject_easy_cases
+
+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 getObject_obj_at':
   assumes x: "\<And>q n ko. loadObject p q n ko =
                 (loadObject_default p q n ko :: ('a :: pspace_storable) kernel)"
@@ -870,7 +940,7 @@ lemma obj_relation_cut_same_type:
          \<or> (\<exists>sz sz'. a_type ko = AArch (ADeviceData sz) \<and> a_type ko' = AArch (ADeviceData sz'))"
   apply (rule ccontr)
   apply (simp add: obj_relation_cuts_def2 a_type_def)
-  apply (auto simp: other_obj_relation_def cte_relation_def
+  apply (auto simp: other_obj_relation_def tcb_relation_cut_def cte_relation_def
                     pte_relation_def pde_relation_def
              split: Structures_A.kernel_object.split_asm if_split_asm
                     Structures_H.kernel_object.split_asm
@@ -888,6 +958,16 @@ where
   "exst_same' (KOTCB tcb) (KOTCB tcb') = exst_same tcb tcb'" |
   "exst_same' _ _ = True"
 
+lemma tcbs_of'_non_tcb_update:
+  "\<lbrakk>typ_at' (koTypeOf ko) ptr s'; koTypeOf ko \<noteq> TCBT\<rbrakk>
+   \<Longrightarrow> tcbs_of' (s'\<lparr>ksPSpace := (ksPSpace s')(ptr \<mapsto> ko)\<rparr>) = tcbs_of' s'"
+  by (fastforce simp: typ_at'_def ko_wp_at'_def opt_map_def projectKO_opts_defs
+               split: kernel_object.splits)
+
+lemma typ_at'_koTypeOf:
+  "ko_at' ob' ptr b \<Longrightarrow> typ_at' (koTypeOf (injectKO ob')) ptr b"
+  by (auto simp: typ_at'_def ko_wp_at'_def obj_at'_def project_inject projectKOs)
+
 lemma setObject_other_corres:
   fixes ob' :: "'a :: pspace_storable"
   assumes x: "updateObject ob' = updateObject_default ob'"
@@ -917,7 +997,7 @@ lemma setObject_other_corres:
   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 (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 simp: obj_at_def a_type_def
@@ -927,6 +1007,14 @@ lemma setObject_other_corres:
   apply (simp only: pspace_relation_def pspace_dom_update dom_fun_upd2 simp_thms)
   apply (elim conjE)
   apply (frule bspec, erule domI)
+  apply (prop_tac "typ_at' (koTypeOf (injectKO ob')) ptr b")
+   subgoal
+     by (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 clarsimp
   apply (rule conjI)
    apply (rule ballI, drule(1) bspec)
    apply (drule domD)
@@ -935,30 +1023,30 @@ lemma setObject_other_corres:
    apply clarsimp
    apply (frule_tac ko'=ko and x'=ptr in obj_relation_cut_same_type,
            (fastforce simp add: is_other_obj_relation_type t)+)
-   apply (erule disjE)
-    apply (simp add: is_other_obj_relation_type t)
-   apply (erule disjE)
-    apply (insert t,
-      clarsimp simp: is_other_obj_relation_type_CapTable a_type_def)
-   apply (erule disjE)
-    apply (insert t,
-       clarsimp simp: is_other_obj_relation_type_UserData a_type_def)
-   apply (insert t,
-      clarsimp simp: is_other_obj_relation_type_DeviceData a_type_def)
-  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)
-  by (clarsimp simp: is_other_obj_relation_type t exst_same_def
-              split: Structures_A.kernel_object.splits Structures_H.kernel_object.splits
-                     ARM_A.arch_kernel_obj.splits)+
+   apply (insert t)
+   apply ((erule disjE
+          | clarsimp simp: is_other_obj_relation_type is_other_obj_relation_type_def a_type_def)+)[1]
+  apply (extract_conjunct \<open>match conclusion in "ekheap_relation _ _" \<Rightarrow> -\<close>)
+   apply (simp only: ekheap_relation_def)
+   apply (rule ballI, drule(1) bspec)
+   apply (drule domD)
+   apply (insert e)
+   apply atomize
+   apply (clarsimp simp: obj_at'_def)
+   apply (erule_tac x=obj in allE)
+   apply (clarsimp simp: projectKO_eq project_inject)
+   apply (case_tac ob;
+          simp_all add: a_type_def other_obj_relation_def etcb_relation_def
+                        is_other_obj_relation_type t exst_same_def)
+     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
@@ -1056,9 +1144,10 @@ lemma typ_at'_valid_obj'_lift:
              (wpsimp|rule conjI)+)
     apply (rename_tac tcb)
     apply (case_tac "tcbState tcb";
-           simp add: valid_tcb'_def valid_tcb_state'_def split_def valid_bound_ntfn'_def
-              split: option.splits,
-           wpsimp)
+           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)
@@ -1340,32 +1429,6 @@ lemma set_ep_bitmapQ_no_L2_orphans[wp]:
   apply (wp hoare_Ball_helper hoare_vcg_all_lift updateObject_default_inv | simp add: bitmapQ_def)+
   done
 
-lemma set_ep_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> setEndpoint epptr ep \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: Invariants_H.valid_queues_def)
-  apply (wp hoare_vcg_conj_lift)
-    apply (simp add: setEndpoint_def valid_queues_no_bitmap_def)
-    apply (wp hoare_Ball_helper hoare_vcg_all_lift)
-      apply (rule obj_at_setObject2)
-      apply (clarsimp simp: updateObject_default_def in_monad)
-     apply (wp updateObject_default_inv set_ep_valid_bitmapQ[unfolded setEndpoint_def]
-            | simp add: valid_queues_no_bitmap_def)+
-  done
-
-lemma set_ep_valid_queues'[wp]:
-  "\<lbrace>valid_queues'\<rbrace> setEndpoint epptr ep \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (unfold setEndpoint_def)
-  apply (simp only: valid_queues'_def imp_conv_disj
-                    obj_at'_real_def)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-    apply (rule setObject_ko_wp_at)
-      apply simp
-     apply (simp add: objBits_simps')
-    apply simp
-   apply (wp updateObject_default_inv | simp)+
-  apply (clarsimp simp: projectKOs ko_wp_at'_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>"
@@ -1565,34 +1628,6 @@ lemma set_ntfn_bitmapQ_no_L2_orphans[wp]:
   apply (wp hoare_Ball_helper hoare_vcg_all_lift updateObject_default_inv | simp)+
   done
 
-lemma set_ntfn_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> setNotification p ntfn \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: Invariants_H.valid_queues_def)
-  apply (rule hoare_pre)
-   apply (wp hoare_vcg_conj_lift)
-    apply (simp add: setNotification_def valid_queues_no_bitmap_def)
-    apply (wp hoare_Ball_helper hoare_vcg_all_lift)
-      apply (rule obj_at_setObject2)
-      apply (clarsimp simp: updateObject_default_def in_monad)
-     apply (wp updateObject_default_inv set_ep_valid_bitmapQ[unfolded setEndpoint_def]
-            | simp add: valid_queues_no_bitmap_def)+
-  done
-
-lemma set_ntfn_valid_queues'[wp]:
-  "\<lbrace>valid_queues'\<rbrace> setNotification p ntfn \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (unfold setNotification_def)
-  apply (rule setObject_ntfn_pre)
-  apply (simp only: valid_queues'_def imp_conv_disj
-                    obj_at'_real_def)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-    apply (rule setObject_ko_wp_at)
-      apply simp
-     apply (simp add: objBits_simps')
-    apply simp
-   apply (wp updateObject_default_inv | simp)+
-  apply (clarsimp simp: projectKOs ko_wp_at'_def)
-  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>
@@ -2014,6 +2049,21 @@ lemma setNotification_ct_idle_or_in_cur_domain'[wp]:
 crunch gsUntypedZeroRanges[wp]: setNotification "\<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>"
+  assumes nexts: "\<And>P. f \<lbrace>\<lambda>s. P (tcbSchedNexts_of s)\<rbrace>"
+  shows "f \<lbrace>sym_heap_sched_pointers\<rbrace>"
+  by (rule_tac f=tcbSchedPrevs_of in hoare_lift_Pf2; wpsimp wp: assms)
+
+crunches setNotification
+  for tcbSchedNexts_of[wp]: "\<lambda>s. P (tcbSchedNexts_of s)"
+  and tcbSchedPrevs_of[wp]: "\<lambda>s. P (tcbSchedPrevs_of s)"
+  and valid_sched_pointers[wp]: valid_sched_pointers
+  and ksReadyQueues[wp]: "\<lambda>s. P (ksReadyQueues s)"
+  and ksReadyQueuesL1Bitmap[wp]: "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
+  and ksReadyQueuesL2Bitmap[wp]: "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
+  (simp: updateObject_default_def)
+
 lemma set_ntfn_minor_invs':
   "\<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))
@@ -2023,9 +2073,10 @@ lemma set_ntfn_minor_invs':
          and (\<lambda>s. ptr \<noteq> ksIdleThread s) \<rbrace>
      setNotification ptr val
    \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (clarsimp simp add: invs'_def valid_state'_def cteCaps_of_def)
-  apply (wp irqs_masked_lift valid_irq_node_lift untyped_ranges_zero_lift,
-    simp_all add: o_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')+
@@ -2111,21 +2162,17 @@ crunch typ_at'[wp]: doMachineOp "\<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>"
+  "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
-                valid_pspace'_def valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs
-       | wp cur_tcb_lift sch_act_wf_lift tcb_in_cur_domain'_lift
-       | fastforce elim: state_refs_of'_pspaceI)+
+      | wp
+      | fastforce elim: state_refs_of'_pspaceI)+
 
 crunch cte_wp_at'[wp]: doMachineOp "\<lambda>s. P (cte_wp_at' P' p s)"
 crunch obj_at'[wp]: doMachineOp "\<lambda>s. P (obj_at' P' p s)"
@@ -2148,6 +2195,29 @@ lemma setEndpoint_ct':
   apply (wp updateObject_default_inv | simp)+
   done
 
+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 (clarsimp simp: bit_simps objBits_simps' word_bits_def
+                 split: kernel_object.splits arch_kernel_object.splits)
+  done
+
+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
+
+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]
diff --git a/proof/refine/ARM/Refine.thy b/proof/refine/ARM/Refine.thy
index 07192b70f0..5b974fc45d 100644
--- a/proof/refine/ARM/Refine.thy
+++ b/proof/refine/ARM/Refine.thy
@@ -81,7 +81,7 @@ lemma typ_at_UserDataI:
   apply clarsimp
   apply (subst mask_lower_twice [where n = pageBits, OF pbfs_atleast_pageBits, symmetric])
   apply (clarsimp simp: obj_relation_cuts_def2 pte_relation_def
-                        cte_relation_def other_obj_relation_def
+                        cte_relation_def other_obj_relation_def tcb_relation_cut_def
                         pde_relation_def
               split: Structures_A.kernel_object.split_asm
                      Structures_H.kernel_object.split_asm
@@ -112,7 +112,7 @@ lemma typ_at_DeviceDataI:
   apply clarsimp
   apply (subst mask_lower_twice [where n = pageBits, OF pbfs_atleast_pageBits, symmetric])
   apply (clarsimp simp: obj_relation_cuts_def2 pte_relation_def
-                        cte_relation_def other_obj_relation_def
+                        cte_relation_def other_obj_relation_def tcb_relation_cut_def
                         pde_relation_def
               split: Structures_A.kernel_object.split_asm
                      Structures_H.kernel_object.split_asm
@@ -565,7 +565,7 @@ lemma kernel_corres':
            apply simp
            apply (rule handleInterrupt_corres[simplified dc_def])
           apply simp
-          apply (wp hoare_drop_imps hoare_vcg_all_lift)[1]
+          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>
@@ -643,7 +643,7 @@ lemma entry_corres:
     apply (rule corres_split[OF getCurThread_corres])
       apply (rule corres_split)
          apply simp
-         apply (rule threadset_corresT)
+         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)
@@ -655,7 +655,7 @@ lemma entry_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, simp add: invs_def cur_tcb_def)
+         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'
@@ -664,7 +664,7 @@ lemma entry_corres:
               | 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 (fastforce simp: invs_def cur_tcb_def)
   apply (clarsimp simp: ct_in_state'_def)
   done
 
diff --git a/proof/refine/ARM/Retype_R.thy b/proof/refine/ARM/Retype_R.thy
index c77ec89d27..6a5ed86224 100644
--- a/proof/refine/ARM/Retype_R.thy
+++ b/proof/refine/ARM/Retype_R.thy
@@ -303,7 +303,7 @@ lemma state_relation_null_filterE:
      null_filter (caps_of_state t) = null_filter (caps_of_state s);
      null_filter' (ctes_of t') = null_filter' (ctes_of s');
      pspace_relation (kheap t) (ksPSpace t');
-     ekheap_relation (ekheap t) (ksPSpace t');
+     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';
@@ -989,7 +989,7 @@ lemma retype_ekheap_relation:
      apply (intro impI conjI)
       apply clarsimp
       apply (drule_tac x=a in bspec,force)
-      apply (clarsimp simp add: other_obj_relation_def split: if_split_asm)
+      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
@@ -1165,6 +1165,11 @@ global_interpretation update_gs: PSpace_update_eq "update_gs ty us ptrs"
 
 context begin interpretation Arch . (*FIXME: arch_split*)
 
+lemma ksReadyQueues_update_gs[simp]:
+  "ksReadyQueues (update_gs tp us addrs s) = ksReadyQueues s"
+  by (simp add: update_gs_def
+         split: aobject_type.splits Structures_A.apiobject_type.splits)
+
 lemma update_gs_id:
   "tp \<in> no_gs_types \<Longrightarrow> update_gs tp us addrs = id"
   by (simp add: no_gs_types_def update_gs_def
@@ -1184,6 +1189,144 @@ lemma update_gs_simps[simp]:
                                else ups x)"
   by (simp_all add: update_gs_def)
 
+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 -
+  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_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>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 (fastforce simp: ptr_add_def p_assoc_help)
+    done
+qed
+
+lemma retype_tcbSchedPrevs_of:
+  assumes   vs': "pspace_aligned' s'" "pspace_distinct' s'"
+  assumes   pn': "pspace_no_overlap' ptr sz s'"
+  assumes    ko: "makeObjectKO dev ty = Some ko"
+  assumes 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
+    "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 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_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
+    "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 -
+  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
+    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
+    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"
@@ -1212,7 +1355,7 @@ lemma retype_state_relation:
           \<in> state_relation"
   (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)
+  proof (rule state_relation_null_filterE[OF sr refl _ _ _ _ _ _ _ _ vs'], simp_all add: trans_state_update[symmetric] del: trans_state_update)
 
   have cover':"range_cover ptr sz (objBitsKO ko) m"
     by (rule range_cover_rel[OF cover objBits_le_obj_bits_api[OF ko] num_r])
@@ -1403,6 +1546,16 @@ lemma retype_state_relation:
                                   else cns x" in exI, simp)
       apply (rule_tac x=id in exI, simp)+
     done
+
+  have rdyqrel: "ready_queues_relation s s'"
+    using sr by (simp add: state_relation_def)
+
+  thus "ready_queues_relation_2 (ready_queues s) (ksReadyQueues s')
+                                (?ps' |> tcb_of' |> tcbSchedNext) (?ps' |> tcb_of' |> tcbSchedPrev)
+                                (\<lambda>d p. inQ d p |< (?ps' |> tcb_of'))"
+    using retype_ready_queues_relation[OF _ vs' pn' ko cover num_r]
+    by (clarsimp simp: ready_queues_relation_def Let_def)
+
 qed
 
 lemma new_cap_addrs_fold':
@@ -2408,7 +2561,6 @@ 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 :: Structures_H.notification)
-             | Structures_A.TCBObject \<Rightarrow> ko = injectKO (makeObject :: tcb)
              | _ \<Rightarrow> False \<rbrakk> \<Longrightarrow>
     obj_relation_retype (default_object ty dev n) ko"
   apply (rule obj_relation_retype_other_obj)
@@ -2429,6 +2581,13 @@ lemma other_objs_default_relation:
                  split: Structures_A.apiobject_type.split_asm)
   done
 
+lemma tcb_relation_retype:
+  "obj_relation_retype (default_object Structures_A.TCBObject dev n) (KOTCB makeObject)"
+  by (clarsimp simp: default_object_def obj_relation_retype_def tcb_relation_def default_tcb_def
+                     makeObject_tcb makeObject_cte new_context_def newContext_def
+                     fault_rel_optionation_def initContext_def default_arch_tcb_def newArchTCB_def
+                     arch_tcb_relation_def objBits_simps' tcb_relation_cut_def)
+
 lemma captable_relation_retype:
   "n < word_bits \<Longrightarrow>
    obj_relation_retype (default_object Structures_A.CapTableObject dev n) (KOCTE makeObject)"
@@ -3155,10 +3314,10 @@ proof (intro conjI impI)
        apply (rule_tac ptr="x + xa" in cte_wp_at_tcbI', assumption+)
         apply fastforce
        apply simp
-      apply (rename_tac thread_state mcp priority bool option nat cptr vptr bound user_context)
-      apply (case_tac thread_state, simp_all add: valid_tcb_state'_def
-                                                  valid_bound_ntfn'_def obj_at_disj'
-                                           split: option.splits)[2]
+      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)])
@@ -3853,16 +4012,6 @@ lemma sch_act_wf_lift_asm:
   apply auto
   done
 
-lemma valid_queues_lift_asm':
-  assumes tat: "\<And>d p t. \<lbrace>\<lambda>s. \<not> obj_at' (inQ d p) t s \<and> Q d p s\<rbrace> f \<lbrace>\<lambda>_ s. \<not> obj_at' (inQ d p) t s\<rbrace>"
-  and     prq: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueues s)\<rbrace>"
-  shows   "\<lbrace>\<lambda>s. valid_queues' s \<and> (\<forall>d p. Q d p s)\<rbrace> f \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp only: valid_queues'_def imp_conv_disj)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift
-            tat prq)
-  apply simp
-  done
-
 lemma createObjects'_ct[wp]:
   "\<lbrace>\<lambda>s. P (ksCurThread s)\<rbrace> createObjects' p n v us \<lbrace>\<lambda>rv s. P (ksCurThread s)\<rbrace>"
   by (rule createObjects_pspace_only, simp)
@@ -4331,35 +4480,153 @@ crunch ksMachine[wp]: createObjects "\<lambda>s. P (ksMachineState s)"
 crunch cur_domain[wp]: createObjects "\<lambda>s. P (ksCurDomain s)"
   (simp: unless_def)
 
-lemma createNewCaps_valid_queues':
-  "\<lbrace>valid_queues' and pspace_no_overlap' ptr sz
-       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_queues'\<rbrace>"
-  apply (wp valid_queues_lift_asm' [OF createNewCaps_obj_at2])
-  apply (clarsimp simp: projectKOs)
-  apply (simp add: makeObjectKO_def
-            split: object_type.split_asm
-                   apiobject_type.split_asm)
-  apply (clarsimp simp: inQ_def)
-  apply (auto simp: makeObject_tcb
-             split: object_type.splits apiobject_type.splits)
+lemma createObjects_valid_bitmaps:
+  "createObjects' ptr n val gbits \<lbrace>valid_bitmaps\<rbrace>"
+  apply (clarsimp simp: createObjects'_def alignError_def split_def)
+  apply (wp case_option_wp[where P="\<lambda>_. P" and P'=P for P, simplified] assert_inv
+         | clarsimp simp del: fun_upd_apply)+
+  apply (clarsimp simp: valid_bitmaps_def valid_bitmapQ_def bitmapQ_def bitmapQ_no_L2_orphans_def
+                        bitmapQ_no_L1_orphans_def)
   done
 
-lemma createNewCaps_valid_queues:
-  "\<lbrace>valid_queues and pspace_no_overlap' ptr sz
-       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_queues\<rbrace>"
-  apply (rule hoare_gen_asm)
-  apply (wpsimp wp: valid_queues_lift_asm createNewCaps_obj_at2[where sz=sz])
-       apply (clarsimp simp: projectKO_opts_defs)
-       apply (simp add: inQ_def)
-      apply (wpsimp wp: createNewCaps_pred_tcb_at'[where sz=sz])+
+lemma valid_bitmaps_gsCNodes_update[simp]:
+  "valid_bitmaps (gsCNodes_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
+
+lemma valid_bitmaps_gsUserPages_update[simp]:
+  "valid_bitmaps (gsUserPages_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
+
+crunches curDomain, copyGlobalMappings
+  for valid_bitmaps[wp]: valid_bitmaps
+  and sched_pointers[wp]: "\<lambda>s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)"
+  and valid_sched_pointers[wp]: valid_sched_pointers
+  (wp: crunch_wps valid_bitmaps_lift)
+
+lemma createNewCaps_valid_bitmaps:
+  "\<lbrace>\<lambda>s. valid_pspace' s \<and> pspace_no_overlap' ptr sz s \<and> valid_bitmaps s\<rbrace>
+   createNewCaps ty ptr n us dev
+   \<lbrace>\<lambda>_. valid_bitmaps\<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 (wpsimp wp: createObjects_valid_bitmaps)
+           by (wpsimp wp: createObjects_valid_bitmaps[simplified o_def] mapM_x_wp
+               | simp add: makeObject_tcb objBits_def createObjects_def
+               | intro conjI impI)+
+
+lemma createObjects_sched_queues:
+  "\<lbrace>\<lambda>s. n \<noteq> 0
+        \<and> range_cover ptr sz (objBitsKO val + gbits) n
+        \<and> P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)
+        \<and> (case val of KOTCB tcb \<Rightarrow> tcbSchedNext tcb = None \<and> tcbSchedPrev tcb = None
+                     | _ \<Rightarrow> True)
+        \<and> pspace_aligned' s \<and> pspace_distinct' s
+        \<and> pspace_no_overlap' ptr sz s\<rbrace>
+   createObjects' ptr n val gbits
+   \<lbrace>\<lambda>_ s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)\<rbrace>"
+  (is "\<lbrace> \<lambda>s. _ \<and> _ \<and> ?Pre s \<rbrace> _ \<lbrace>\<lambda>_. _\<rbrace>")
+proof (rule hoare_grab_asm)+
+  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>_ s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)\<rbrace>"
+  proof -
+    have shiftr_not_zero:" 1 \<le> ((of_nat n)::machine_word) << gbits"
+      using range_cover_not_zero_shift[OF not_0 cover,where gbits = gbits]
+      by (simp add:word_le_sub1)
+    show ?thesis
+      apply (clarsimp simp: createObjects'_def unless_def alignError_def split_def)
+      apply (wp | clarsimp simp del: fun_upd_apply)+
+      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 (clarsimp simp: foldr_upd_app_if)
+      apply (rule_tac a="tcbSchedNexts_of s" and b="tcbSchedPrevs_of s"
+                   in rsubst2[rotated, OF sym sym, where P=P])
+        apply (rule ext)
+        apply (clarsimp simp: opt_map_def)
+        apply (frule (3) retype_ksPSpace_None[simplified mult.commute])
+          apply (fastforce intro: cover)
+         apply fastforce
+        apply (clarsimp simp: projectKOs split: kernel_object.splits option.splits)
+       apply (rule ext)
+       apply (clarsimp simp: opt_map_def)
+       apply (frule (3) retype_ksPSpace_None[simplified mult.commute])
+         apply (fastforce intro: cover)
+        apply fastforce
+       apply (clarsimp simp: projectKOs split: kernel_object.splits option.splits)
+      apply simp
+      done
+  qed
+qed
+
+crunches doMachineOp
+  for sched_projs[wp]: "\<lambda>s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)"
+
+lemma createNewCaps_sched_queues:
+  assumes cover: "range_cover ptr sz (APIType_capBits ty us) n"
+  assumes not_0: "n \<noteq> 0"
+  shows
+    "\<lbrace>\<lambda>s. valid_pspace' s \<and> pspace_no_overlap' ptr sz s
+          \<and> P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)\<rbrace>
+     createNewCaps ty ptr n us dev
+     \<lbrace>\<lambda>_ s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of 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)
+           apply (wpsimp wp: mapM_x_wp' createObjects_sched_queues
+                       simp: curDomain_def)
+           by (wpsimp wp: mapM_x_wp' createObjects_sched_queues[simplified o_def]
+                          threadSet_sched_pointers
+               | simp add: objBitsKO_def APIType_capBits_def valid_pspace'_def makeObject_tcb
+                           objBits_def pageBits_def archObjSize_def createObjects_def
+                           pt_bits_def ptBits_def pteBits_def pdBits_def pdeBits_def word_size_bits_def
+               | intro conjI impI)+
+
+lemma createObjects_valid_sched_pointers:
+  "\<lbrace>\<lambda>s. valid_sched_pointers s
+        \<and> (case val of KOTCB tcb \<Rightarrow> tcbSchedNext tcb = None \<and> tcbSchedPrev tcb = None
+                     | _ \<Rightarrow> True)\<rbrace>
+   createObjects' ptr n val gbits
+   \<lbrace>\<lambda>_. valid_sched_pointers\<rbrace>"
+  apply (clarsimp simp: createObjects'_def unless_def alignError_def split_def)
+  apply (wp case_option_wp[where P="\<lambda>_. P" and P'=P for P, simplified] assert_inv
+         | clarsimp simp del: fun_upd_apply)+
+  apply (clarsimp simp: valid_sched_pointers_def foldr_upd_app_if opt_pred_def opt_map_def comp_def)
+  apply (cases "tcb_of' val"; clarsimp simp: projectKOs)
   done
 
+lemma createNewCaps_valid_sched_pointers:
+  "\<lbrace>\<lambda>s. valid_pspace' s \<and> pspace_no_overlap' ptr sz s \<and> valid_sched_pointers s\<rbrace>
+   createNewCaps ty ptr n us dev
+   \<lbrace>\<lambda>_. valid_sched_pointers\<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 (wpsimp wp: createObjects_valid_sched_pointers)
+           by (wpsimp wp: createObjects_valid_sched_pointers[simplified o_def] mapM_x_wp
+                          threadSet_valid_sched_pointers
+               | simp add: makeObject_tcb objBits_def createObjects_def
+               | intro conjI impI)+
+
 lemma mapM_x_threadSet_valid_pspace:
   "\<lbrace>valid_pspace' and K (curdom \<le> maxDomain)\<rbrace>
     mapM_x (threadSet (tcbDomain_update (\<lambda>_. curdom))) addrs \<lbrace>\<lambda>y. valid_pspace'\<rbrace>"
@@ -4758,12 +5025,13 @@ proof (rule hoare_gen_asm, erule conjE)
                createNewCaps_valid_arch_state
                valid_irq_node_lift_asm [unfolded pred_conj_def, OF _ createNewCaps_obj_at']
                createNewCaps_irq_handlers' createNewCaps_vms
-               createNewCaps_valid_queues
-               createNewCaps_valid_queues'
                createNewCaps_pred_tcb_at' cnc_ct_not_inQ
                createNewCaps_ct_idle_or_in_cur_domain'
                createNewCaps_sch_act_wf
                createNewCaps_urz[where sz=sz]
+               createNewCaps_sched_queues[OF cover not_0]
+               createNewCaps_valid_sched_pointers
+               createNewCaps_valid_bitmaps
            | simp)+
   using not_0
   apply (clarsimp simp: valid_pspace'_def)
@@ -4809,35 +5077,6 @@ lemma createObjects_sch:
   apply (wp sch_act_wf_lift_asm createObjects_pred_tcb_at' createObjects_orig_obj_at3 | force)+
   done
 
-lemma createObjects_queues:
-  "\<lbrace>\<lambda>s. valid_queues 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. valid_queues\<rbrace>"
-  apply (wpsimp wp: valid_queues_lift_asm [unfolded pred_conj_def, OF createObjects_orig_obj_at3]
-                    createObjects_pred_tcb_at' [unfolded pred_conj_def])
-      apply fastforce
-     apply wp+
-  apply fastforce
-  done
-
-lemma createObjects_queues':
-  assumes no_tcb: "\<And>t. projectKO_opt val \<noteq> Some (t::tcb)"
-  shows
-  "\<lbrace>\<lambda>s. valid_queues' 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. valid_queues'\<rbrace>"
-  apply (simp add: createObjects_def)
-  apply (wp valid_queues_lift_asm')
-    apply (wp createObjects_orig_obj_at2')
-    apply clarsimp
-    apply assumption
-   apply wp
-  apply (clarsimp simp: no_tcb split: option.splits)
-  apply fastforce
-  done
-
 lemma createObjects_no_cte_ifunsafe':
   assumes no_cte: "\<And>c. projectKO_opt val \<noteq> Some (c::cte)"
   assumes no_tcb: "\<And>t. projectKO_opt val \<noteq> Some (t::tcb)"
@@ -5087,7 +5326,7 @@ proof -
    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 (wp createObjects_sch)
    apply (rule hoare_vcg_conj_lift)
     apply (simp add: createObjects_def)
     apply (wp createObjects_state_refs_of'')
@@ -5098,8 +5337,7 @@ proof -
              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 | simp add: objBits_def )+
+             assms | simp add: objBits_def)+
   apply (rule hoare_vcg_conj_lift)
    apply (simp add: createObjects_def)
    apply (wp createObjects_idle')
@@ -5107,7 +5345,25 @@ proof -
              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
+             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]
@@ -5115,7 +5371,8 @@ proof -
   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 (clarsimp simp: invs'_def no_tcb valid_state'_def no_cte  split: option.splits)
+  apply (auto simp: invs'_def no_tcb valid_state'_def no_cte
+             split: option.splits kernel_object.splits)
   done
 qed
 
@@ -5152,7 +5409,7 @@ lemma gcd_corres: "corres (=) \<top> \<top> (gets cur_domain) curDomain"
 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. 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
@@ -5163,7 +5420,7 @@ lemma retype_region2_extra_ext_mapM_x_corres:
     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. tcb_at' t 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)
@@ -5171,8 +5428,10 @@ lemma retype_region2_extra_ext_mapM_x_corres:
             apply (case_tac tcb')
             apply simp
            apply fastforce
-          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
@@ -5204,10 +5463,11 @@ lemma retype_region2_obj_at:
   apply (auto simp: obj_at_def default_object_def is_tcb_def)
   done
 
-lemma createObjects_tcb_at':
+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\<rbrace>
-   createObjects ptr n (KOTCB makeObject) 0 \<lbrace>\<lambda>ptrs s. \<forall>addr\<in>set ptrs. tcb_at' addr 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
@@ -5283,7 +5543,7 @@ lemma corres_retype_region_createNewCaps:
                 apply (rule corres_retype[where 'a = tcb],
                        simp_all add: obj_bits_api_def objBits_simps' pageBits_def
                                     APIType_map2_def makeObjectKO_def
-                                    other_objs_default_relation)[1]
+                                    tcb_relation_retype)[1]
                 apply (fastforce simp: range_cover_def)
                apply (rule corres_split_nor)
                   apply (simp add: APIType_map2_def)
@@ -5294,7 +5554,7 @@ lemma corres_retype_region_createNewCaps:
                 apply wp
                apply wp
               apply ((wp retype_region2_obj_at | 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 ((wp createObjects_Not_tcbQueued[where sz=sz] | simp add: APIType_map2_def objBits_simps' obj_bits_api_def)+)[1]
             apply simp
            apply simp
           apply (subst retype_region2_extra_ext_trivial)
diff --git a/proof/refine/ARM/Schedule_R.thy b/proof/refine/ARM/Schedule_R.thy
index f9d9b29e2e..efdafb723a 100644
--- a/proof/refine/ARM/Schedule_R.thy
+++ b/proof/refine/ARM/Schedule_R.thy
@@ -15,11 +15,6 @@ declare hoare_weak_lift_imp[wp_split del]
 (* Levity: added (20090713 10:04:12) *)
 declare sts_rel_idle [simp]
 
-lemma invs_no_cicd'_queues:
-  "invs_no_cicd' s \<Longrightarrow> valid_queues s"
-  unfolding invs_no_cicd'_def
-  by simp
-
 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)"
@@ -72,17 +67,21 @@ lemma arch_switchToThread_corres:
               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 st_tcb_at' runnable' t)
+             (valid_arch_state' and st_tcb_at' runnable' t and no_0_obj')
              (arch_switch_to_thread t) (Arch.switchToThread t)"
+  apply (rule_tac Q="tcb_at t" 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 (simp add: arch_switch_to_thread_def ARM_H.switchToThread_def)
   apply (rule corres_guard_imp)
     apply (rule corres_underlying_split [OF setVMRoot_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 (erule st_tcb_at_tcb_at)
-  apply (clarsimp simp: valid_pspace'_def)
+  apply clarsimp
   done
 
 lemma schedule_choose_new_thread_sched_act_rct[wp]:
@@ -90,355 +89,279 @@ lemma schedule_choose_new_thread_sched_act_rct[wp]:
   unfolding schedule_choose_new_thread_def
   by wp
 
+\<comment> \<open>This proof shares many similarities with the proof of @{thm tcbSchedEnqueue_corres}\<close>
 lemma tcbSchedAppend_corres:
-  notes trans_state_update'[symmetric, simp del]
-  shows
-  "corres dc (is_etcb_at t) (tcb_at' t and Invariants_H.valid_queues and valid_queues') (tcb_sched_action (tcb_sched_append) t) (tcbSchedAppend t)"
-  apply (simp only: tcbSchedAppend_def tcb_sched_action_def)
-  apply (rule corres_symb_exec_r [OF _ _ threadGet_inv, 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, simp)
-   apply (rule no_fail_pre, wp, simp)
-  apply (case_tac queued)
-   apply (simp add: unless_def when_def)
-   apply (rule corres_no_failI)
-    apply wp+
-   apply (clarsimp simp: in_monad ethread_get_def gets_the_def bind_assoc
-                         assert_opt_def exec_gets is_etcb_at_def get_etcb_def get_tcb_queue_def
-                         set_tcb_queue_def simpler_modify_def)
-
-   apply (subgoal_tac "tcb_sched_append t (ready_queues a (tcb_domain y) (tcb_priority y))
-                       = (ready_queues a (tcb_domain y) (tcb_priority y))")
-    apply (simp add: state_relation_def ready_queues_relation_def)
-   apply (clarsimp simp: tcb_sched_append_def state_relation_def
-                         valid_queues'_def ready_queues_relation_def
-                         ekheap_relation_def etcb_relation_def
-                         obj_at'_def inQ_def projectKO_eq project_inject)
-   apply (drule_tac x=t in bspec,clarsimp)
+  "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_append tcb_ptr) (tcbSchedAppend 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_append_def get_tcb_queue_def
+                        tcbSchedAppend_def getQueue_def unless_def when_def)
+  apply (rule corres_symb_exec_l[OF _ _ ethread_get_sp]; (solves wpsimp)?)
+  apply (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]; 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 projectKOs opt_pred_def opt_map_def obj_at_def is_tcb_def
+                          in_correct_ready_q_def etcb_at_def is_etcb_at_def)
+   apply (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 (clarsimp simp: unless_def when_def cong: if_cong)
-  apply (rule stronger_corres_guard_imp)
-    apply (rule corres_split[where r'="(=)"])
-       apply (rule ethreadget_corres)
-       apply (simp add: etcb_relation_def)
-      apply (rule corres_split[where r'="(=)"])
-         apply (rule ethreadget_corres)
-         apply (simp add: etcb_relation_def)
-        apply (rule corres_split[where r'="(=)"])
-           apply simp
-           apply (rule getQueue_corres)
-          apply (rule corres_split_noop_rhs2)
-             apply (simp add: tcb_sched_append_def)
-             apply (intro conjI impI)
-              apply (rule corres_guard_imp)
-                apply (rule setQueue_corres)
-               prefer 3
-               apply (rule_tac P=\<top> and Q="K (t \<notin> set queuea)" in corres_assume_pre)
-               apply simp
-              apply simp
-             apply simp
-            apply (rule corres_split_noop_rhs2)
-               apply (rule addToBitmap_if_null_noop_corres)
-              apply (rule threadSet_corres_noop, simp_all add: tcb_relation_def exst_same_def)[1]
-             apply wp+
-          apply (wp getObject_tcb_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
-
-
-crunches tcbSchedEnqueue, tcbSchedAppend, tcbSchedDequeue
-  for valid_pspace'[wp]: valid_pspace'
-  and valid_arch_state'[wp]: valid_arch_state'
-  and pred_tcb_at'[wp]: "pred_tcb_at' proj P t"
-  (wp: threadSet_pred_tcb_no_state simp: unless_def tcb_to_itcb'_def)
-
-lemma removeFromBitmap_valid_queues_no_bitmap_except[wp]:
-" \<lbrace> valid_queues_no_bitmap_except t \<rbrace>
-     removeFromBitmap d p
-  \<lbrace>\<lambda>_. valid_queues_no_bitmap_except t \<rbrace>"
-  unfolding bitmapQ_defs valid_queues_no_bitmap_except_def
-  by (wp | clarsimp simp: bitmap_fun_defs)+
-
-lemma removeFromBitmap_bitmapQ:
-  "\<lbrace> \<lambda>s. True \<rbrace> removeFromBitmap d p \<lbrace>\<lambda>_ s. \<not> bitmapQ d p s \<rbrace>"
-  unfolding bitmapQ_defs bitmap_fun_defs
-  by (wpsimp simp: bitmap_fun_defs wordRadix_def)
-
-lemma removeFromBitmap_valid_bitmapQ[wp]:
-" \<lbrace> valid_bitmapQ_except d p and bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans and
-    (\<lambda>s. ksReadyQueues s (d,p) = []) \<rbrace>
-     removeFromBitmap d p
-  \<lbrace>\<lambda>_. valid_bitmapQ \<rbrace>"
-proof -
-  have "\<lbrace> valid_bitmapQ_except d p and bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans and
-            (\<lambda>s. ksReadyQueues s (d,p) = []) \<rbrace>
-         removeFromBitmap d p
-         \<lbrace>\<lambda>_. valid_bitmapQ_except d p and  bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans and
-              (\<lambda>s. \<not> bitmapQ d p s \<and> ksReadyQueues s (d,p) = []) \<rbrace>"
-    by (rule hoare_pre)
-       (wp removeFromBitmap_valid_queues_no_bitmap_except removeFromBitmap_valid_bitmapQ_except
-           removeFromBitmap_bitmapQ, simp)
-  thus ?thesis
-    by - (erule hoare_strengthen_post; fastforce elim: valid_bitmap_valid_bitmapQ_exceptE)
-qed
-
-(* this should be the actual weakest precondition to establish valid_queues
-   under tagging a thread as not queued *)
-lemma threadSet_valid_queues_dequeue_wp:
- "\<lbrace> valid_queues_no_bitmap_except t and
-        valid_bitmapQ and bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans and
-        (\<lambda>s. \<forall>d p. t \<notin> set (ksReadyQueues s (d,p))) \<rbrace>
-          threadSet (tcbQueued_update (\<lambda>_. False)) t
-       \<lbrace>\<lambda>rv. valid_queues \<rbrace>"
-  unfolding threadSet_def
-  apply (rule hoare_seq_ext[OF _ getObject_tcb_sp])
-  apply (rule hoare_pre)
-   apply (simp add: valid_queues_def valid_queues_no_bitmap_except_def valid_queues_no_bitmap_def)
-   apply (wp setObject_queues_unchanged_tcb hoare_Ball_helper hoare_vcg_all_lift
-             setObject_tcb_strongest)
-  apply (clarsimp simp: valid_queues_no_bitmap_except_def obj_at'_def valid_queues_no_bitmap_def)
-  done
+  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)?)
 
-(* FIXME move *)
-lemmas obj_at'_conjI = obj_at_conj'
-
-lemma setQueue_valid_queues_no_bitmap_except_dequeue_wp:
-  "\<And>d p ts t.
-   \<lbrace> \<lambda>s. valid_queues_no_bitmap_except t s \<and>
-         (\<forall>t' \<in> set ts. obj_at' (inQ d p and runnable' \<circ> tcbState) t' s) \<and>
-         t \<notin> set ts \<and> distinct ts \<and> p \<le> maxPriority \<and> d \<le> maxDomain \<rbrace>
-       setQueue d p ts
-   \<lbrace>\<lambda>rv. valid_queues_no_bitmap_except t \<rbrace>"
-  unfolding setQueue_def valid_queues_no_bitmap_except_def null_def
-  by wp force
-
-definition (* if t is in a queue, it should be tagged with right priority and domain *)
-  "correct_queue t s \<equiv> \<forall>d p. t \<in> set(ksReadyQueues s (d, p)) \<longrightarrow>
-             (obj_at' (\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d \<and> tcbPriority tcb = p) t s)"
-
-lemma valid_queues_no_bitmap_correct_queueI[intro]:
-  "valid_queues_no_bitmap s \<Longrightarrow> correct_queue t s"
-  unfolding correct_queue_def valid_queues_no_bitmap_def
-  by (fastforce simp: obj_at'_def inQ_def)
-
-
-lemma tcbSchedDequeue_valid_queues_weak:
-  "\<lbrace> valid_queues_no_bitmap_except t and valid_bitmapQ and
-     bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans and
-     correct_queue t and
-     obj_at' (\<lambda>tcb. tcbDomain tcb \<le> maxDomain \<and> tcbPriority tcb \<le> maxPriority) t \<rbrace>
-   tcbSchedDequeue t
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-proof -
-  show ?thesis
-  unfolding tcbSchedDequeue_def null_def valid_queues_def
-  apply wp (* stops on threadSet *)
-          apply (rule hoare_post_eq[OF _ threadSet_valid_queues_dequeue_wp],
-                 simp add: valid_queues_def)
-         apply (wp hoare_vcg_if_lift hoare_vcg_conj_lift hoare_vcg_imp_lift)+
-             apply (wp hoare_vcg_imp_lift setQueue_valid_queues_no_bitmap_except_dequeue_wp
-                       setQueue_valid_bitmapQ threadGet_const_tcb_at hoare_vcg_if_lift)+
-  (* wp done *)
-  apply (normalise_obj_at')
-  apply (clarsimp simp: correct_queue_def)
-  apply (normalise_obj_at')
-  apply (fastforce simp add: valid_queues_no_bitmap_except_def valid_queues_no_bitmap_def elim: obj_at'_weaken)+
-  done
-qed
+  \<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'])
 
-lemma tcbSchedDequeue_valid_queues:
-  "\<lbrace>Invariants_H.valid_queues
-    and obj_at' (\<lambda>tcb. tcbDomain tcb \<le> maxDomain) t
-    and obj_at' (\<lambda>tcb. tcbPriority tcb \<le> maxPriority) t\<rbrace>
-     tcbSchedDequeue t
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (rule hoare_pre, rule tcbSchedDequeue_valid_queues_weak)
-  apply (fastforce simp: valid_queues_def valid_queues_no_bitmap_def obj_at'_def inQ_def)
-  done
-
-lemma tcbSchedAppend_valid_queues'[wp]:
-  (* most of this is identical to tcbSchedEnqueue_valid_queues' in TcbAcc_R *)
-  "\<lbrace>valid_queues' and tcb_at' t\<rbrace> tcbSchedAppend t \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp add: tcbSchedAppend_def)
-  apply (rule hoare_pre)
-   apply (rule_tac B="\<lambda>rv. valid_queues' and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"
-           in hoare_seq_ext)
-    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 wpsimp
+    apply (wpsimp wp: hoare_vcg_if_lift hoare_vcg_ex_lift)
+   apply (corres corres: addToBitmap_if_null_noop_corres)
+
+  apply (rule corres_from_valid_det)
+    apply (fastforce intro: det_wp_modify det_wp_pre simp: set_tcb_queue_def)
+   apply (wpsimp simp: tcbQueueAppend_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'_tcbQueueEnd_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 simp: setQueue_def tcbQueueAppend_def)
+  apply normalise_obj_at'
+  apply (frule (1) tcb_at_is_etcb_at)
+  apply (clarsimp simp: obj_at_def is_etcb_at_def etcb_at_def)
+  apply (rename_tac s d p s' tcb' tcb etcb)
+  apply (frule_tac t=tcbPtr in ekheap_relation_tcb_domain_priority)
+    apply (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 obj_at'_tcbQueueEnd_ksReadyQueues)
+      apply fast
+     apply fast
+    apply fastforce
+   apply fastforce
+  apply (cut_tac xs="ready_queues s d p" in heap_path_head')
+   apply (force dest!: spec simp: list_queue_relation_def)
+  apply (clarsimp simp: list_queue_relation_def)
+
+  apply (case_tac "d \<noteq> tcb_domain etcb \<or> p \<noteq> tcb_priority etcb")
+   apply (cut_tac d=d and d'="tcb_domain etcb" and p=p and p'="tcb_priority etcb"
+               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 projectKOs opt_pred_def opt_map_def)
+    apply (metis inQ_def option.simps(5) tcb_of'_TCB)
+   apply (intro conjI impI; clarsimp)
+
+    \<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 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_def)+
-     apply (clarsimp simp: obj_at'_def inQ_def projectKOs valid_queues'_def)
-    apply (wp getObject_tcb_wp | simp add: threadGet_def)+
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-crunch norq[wp]: threadSet "\<lambda>s. P (ksReadyQueues s)"
-  (simp: updateObject_default_def)
-
-lemma threadSet_valid_queues'_dequeue: (* threadSet_valid_queues' is too weak for dequeue *)
-  "\<lbrace>\<lambda>s. (\<forall>d p t'. obj_at' (inQ d p) t' s \<and> t' \<noteq> t \<longrightarrow> t' \<in> set (ksReadyQueues s (d, p))) \<and>
-        obj_at' (inQ d p) t s \<rbrace>
-   threadSet (tcbQueued_update (\<lambda>_. False)) t
-   \<lbrace>\<lambda>rv. valid_queues' \<rbrace>"
-   unfolding valid_queues'_def
-   apply (rule hoare_pre)
-    apply (wp hoare_vcg_all_lift)
-    apply (simp only: imp_conv_disj not_obj_at')
-   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-   apply (simp add: not_obj_at')
-   apply (clarsimp simp: typ_at_tcb')
-   apply normalise_obj_at'
-   apply (fastforce elim: obj_at'_weaken simp: inQ_def)
-   done
-
-lemma setQueue_ksReadyQueues_lift:
-  "\<lbrace> \<lambda>s. P (s\<lparr>ksReadyQueues := (ksReadyQueues s)((d, p) := ts)\<rparr>) ts \<rbrace>
-   setQueue d p ts
-   \<lbrace> \<lambda>_ s. P s (ksReadyQueues s (d,p))\<rbrace>"
-  unfolding setQueue_def
-  by (wp, clarsimp simp: fun_upd_def snd_def)
-
-lemma tcbSchedDequeue_valid_queues'[wp]:
-  "\<lbrace>valid_queues' and tcb_at' t\<rbrace>
-    tcbSchedDequeue t \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  unfolding tcbSchedDequeue_def
-  apply (rule_tac B="\<lambda>rv. valid_queues' and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"
-                in hoare_seq_ext)
-   prefer 2
-   apply (wp threadGet_const_tcb_at)
-   apply (fastforce simp: obj_at'_def)
+        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 (tcbQueueEnd (ksReadyQueues s' (tcb_domain etcb, tcb_priority etcb)))
+                    \<notin> set (ready_queues s d p)")
+    apply (erule orthD2)
+    apply (drule_tac x="tcb_domain etcb" in spec)
+    apply (drule_tac x="tcb_priority etcb" in spec)
+    apply clarsimp
+    apply (drule_tac x="the (tcbQueueEnd (ksReadyQueues s' (tcb_domain etcb, tcb_priority etcb)))"
+                 in spec)
+    subgoal by (auto simp: in_opt_pred opt_map_red projectKOs)
+   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";
+              clarsimp 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: projectKOs inQ_def fun_upd_apply split: if_splits)
+     apply (case_tac "t = the (tcbQueueEnd (ksReadyQueues s' (tcb_domain etcb, tcb_priority etcb)))")
+      apply (clarsimp simp: projectKOs inQ_def opt_pred_def fun_upd_apply)
+     apply (clarsimp simp: inQ_def in_opt_pred opt_map_def fun_upd_apply)
+    apply (clarsimp simp: fun_upd_apply split: if_splits)
+   apply (clarsimp simp: fun_upd_apply split: if_splits)
+
+  \<comment> \<open>d = tcb_domain tcb \<and> p = tcb_priority tcb\<close>
   apply clarsimp
-  apply (rename_tac queued)
-  apply (case_tac queued, simp_all)
-   apply wp
-        apply (rule_tac d=tdom and p=prio in threadSet_valid_queues'_dequeue)
-       apply (rule hoare_pre_post, assumption)
-       apply (wp | clarsimp simp: bitmap_fun_defs)+
-      apply (wp hoare_vcg_all_lift setQueue_ksReadyQueues_lift)
-     apply clarsimp
-     apply (wp threadGet_obj_at' threadGet_const_tcb_at)+
-   apply clarsimp
-   apply (rule context_conjI, clarsimp simp: obj_at'_def)
-   apply (clarsimp simp: valid_queues'_def obj_at'_def projectKOs inQ_def|wp)+
+  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 projectKOs)
+  apply (intro conjI; clarsimp)
+
+   \<comment> \<open>the ready queue was originally empty\<close>
+   apply (force simp: inQ_def in_opt_pred fun_upd_apply opt_map_def obj_at'_def projectKOs
+                      queue_end_valid_def prev_queue_head_def
+               split: if_splits option.splits)
+
+   \<comment> \<open>the ready queue was not originally empty\<close>
+  apply (drule (2) heap_ls_append[where new=tcbPtr])
+  apply (rule conjI)
+   apply (clarsimp simp: fun_upd_apply queue_end_valid_def opt_map_def obj_at'_def projectKOs
+                  split: if_splits)
+  apply (rule conjI)
+   apply (clarsimp simp: fun_upd_apply queue_end_valid_def)
+  apply (rule conjI)
+   apply (subst opt_map_upd_triv)
+    apply (clarsimp simp: opt_map_def fun_upd_apply queue_end_valid_def obj_at'_def projectKOs
+                   split: if_splits)
+   apply (clarsimp simp: prev_queue_head_def fun_upd_apply split: if_splits)
+  by (clarsimp simp: inQ_def in_opt_pred fun_upd_apply queue_end_valid_def
+                     obj_at'_def projectKOs
+              split: if_splits)
+
+lemma tcbQueueAppend_valid_objs'[wp]:
+  "\<lbrace>\<lambda>s. valid_objs' s \<and> tcb_at' tcbPtr s \<and> (\<forall>end. tcbQueueEnd queue = Some end \<longrightarrow> tcb_at' end s)\<rbrace>
+   tcbQueueAppend queue tcbPtr
+   \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
+  unfolding tcbQueueAppend_def
+  apply (wpsimp wp: hoare_vcg_if_lift2 hoare_vcg_imp_lift')
+  apply (clarsimp simp: tcbQueueEmpty_def valid_bound_tcb'_def split: option.splits)
+  done
+
+lemma tcbSchedAppend_valid_objs'[wp]:
+  "\<lbrace>valid_objs' and pspace_aligned' and pspace_distinct'\<rbrace>
+   tcbSchedAppend tcbPtr
+   \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
+  apply (clarsimp simp: tcbSchedAppend_def setQueue_def)
+  apply (wpsimp wp: threadSet_valid_objs' threadGet_wp hoare_vcg_all_lift)
+  apply (normalise_obj_at', rename_tac tcb "end")
+  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
+  apply (frule tcbQueueHead_iff_tcbQueueEnd)
+  apply (force dest!: obj_at'_tcbQueueEnd_ksReadyQueues simp: tcbQueueEmpty_def obj_at'_def)
   done
 
-crunch tcb_at'[wp]: tcbSchedEnqueue "tcb_at' t"
-  (simp: unless_def)
-crunch tcb_at'[wp]: tcbSchedAppend "tcb_at' t"
-  (simp: unless_def)
-crunch tcb_at'[wp]: tcbSchedDequeue "tcb_at' t"
-
-crunch state_refs_of'[wp]: tcbSchedEnqueue "\<lambda>s. P (state_refs_of' s)"
-  (wp: refl simp: crunch_simps unless_def)
-crunch state_refs_of'[wp]: tcbSchedAppend "\<lambda>s. P (state_refs_of' s)"
-  (wp: refl simp: crunch_simps unless_def)
-crunch state_refs_of'[wp]: tcbSchedDequeue "\<lambda>s. P (state_refs_of' s)"
-  (wp: refl simp: crunch_simps)
+crunches tcbSchedAppend, tcbSchedDequeue
+  for pred_tcb_at'[wp]: "pred_tcb_at' proj P t"
+  (wp: threadSet_pred_tcb_no_state simp: unless_def tcb_to_itcb'_def)
 
-crunch cap_to'[wp]: tcbSchedEnqueue "ex_nonz_cap_to' p"
-  (simp: unless_def)
-crunch cap_to'[wp]: tcbSchedAppend "ex_nonz_cap_to' p"
-  (simp: unless_def)
-crunch cap_to'[wp]: tcbSchedDequeue "ex_nonz_cap_to' p"
+(* FIXME move *)
+lemmas obj_at'_conjI = obj_at_conj'
 
-crunch iflive'[wp]: setQueue if_live_then_nonz_cap'
+crunches tcbSchedAppend, tcbSchedDequeue, tcbSchedEnqueue
+  for tcb_at'[wp]: "tcb_at' t"
+  and cap_to'[wp]: "ex_nonz_cap_to' p"
+  and ifunsafe'[wp]: if_unsafe_then_cap'
+  (wp: crunch_wps simp: crunch_simps)
 
 lemma tcbSchedAppend_iflive'[wp]:
-  "\<lbrace>if_live_then_nonz_cap' and ex_nonz_cap_to' tcb\<rbrace>
-    tcbSchedAppend tcb \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
-  apply (simp add: tcbSchedAppend_def unless_def)
-  apply (wp threadSet_iflive' hoare_drop_imps | simp add: crunch_simps)+
+  "\<lbrace>if_live_then_nonz_cap' and pspace_aligned' and pspace_distinct'\<rbrace>
+   tcbSchedAppend tcbPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  unfolding tcbSchedAppend_def
+  apply (wpsimp wp: tcbQueueAppend_if_live_then_nonz_cap' threadGet_wp simp: bitmap_fun_defs)
+  apply (frule_tac p=tcbPtr in if_live_then_nonz_capE')
+   apply (fastforce simp: ko_wp_at'_def st_tcb_at'_def obj_at'_def projectKOs runnable_eq_active')
+  apply (clarsimp simp: tcbQueueEmpty_def)
+  apply (erule if_live_then_nonz_capE')
+  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 (fastforce dest!: obj_at'_tcbQueueEnd_ksReadyQueues
+                    simp: ko_wp_at'_def inQ_def obj_at'_def projectKOs tcbQueueEmpty_def)
   done
 
 lemma tcbSchedDequeue_iflive'[wp]:
-  "\<lbrace>if_live_then_nonz_cap'\<rbrace> tcbSchedDequeue tcb \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  "\<lbrace>if_live_then_nonz_cap' and valid_objs' and sym_heap_sched_pointers\<rbrace>
+   tcbSchedDequeue tcbPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
   apply (simp add: tcbSchedDequeue_def)
-  apply (wp threadSet_iflive' hoare_when_weak_wp | simp add: crunch_simps)+
-       apply ((wp | clarsimp simp: bitmap_fun_defs)+)[1] (* deal with removeFromBitmap *)
-      apply (wp threadSet_iflive' hoare_when_weak_wp | simp add: crunch_simps)+
-      apply (rule_tac Q="\<lambda>rv. \<top>" in hoare_post_imp, fastforce)
-      apply (wp | simp add: crunch_simps)+
-  done
-
-crunch ifunsafe'[wp]: tcbSchedEnqueue if_unsafe_then_cap'
-  (simp: unless_def)
-crunch ifunsafe'[wp]: tcbSchedAppend if_unsafe_then_cap'
-  (simp: unless_def)
-crunch ifunsafe'[wp]: tcbSchedDequeue if_unsafe_then_cap'
-
-crunch idle'[wp]: tcbSchedEnqueue valid_idle'
-  (simp: crunch_simps unless_def)
-crunch idle'[wp]: tcbSchedAppend valid_idle'
-  (simp: crunch_simps unless_def)
-crunch idle'[wp]: tcbSchedDequeue valid_idle'
-  (simp: crunch_simps)
-
-crunch global_refs'[wp]: tcbSchedEnqueue valid_global_refs'
-  (wp: threadSet_global_refs simp: unless_def)
-crunch global_refs'[wp]: tcbSchedAppend valid_global_refs'
-  (wp: threadSet_global_refs simp: unless_def)
-crunch global_refs'[wp]: tcbSchedDequeue valid_global_refs'
-  (wp: threadSet_global_refs)
-
-crunch irq_node'[wp]: tcbSchedEnqueue "\<lambda>s. P (irq_node' s)"
-  (simp: unless_def)
-crunch irq_node'[wp]: tcbSchedAppend "\<lambda>s. P (irq_node' s)"
-  (simp: unless_def)
-crunch irq_node'[wp]: tcbSchedDequeue "\<lambda>s. P (irq_node' s)"
-
-crunch typ_at'[wp]: tcbSchedEnqueue "\<lambda>s. P (typ_at' T p s)"
-  (simp: unless_def)
-crunch typ_at'[wp]: tcbSchedAppend "\<lambda>s. P (typ_at' T p s)"
-  (simp: unless_def)
-crunch typ_at'[wp]: tcbSchedDequeue "\<lambda>s. P (typ_at' T p s)"
-
-crunch ctes_of[wp]: tcbSchedEnqueue "\<lambda>s. P (ctes_of s)"
-  (simp: unless_def)
-crunch ctes_of[wp]: tcbSchedAppend "\<lambda>s. P (ctes_of s)"
-  (simp: unless_def)
-crunch ctes_of[wp]: tcbSchedDequeue "\<lambda>s. P (ctes_of s)"
-
-crunch ksInterrupt[wp]: tcbSchedEnqueue "\<lambda>s. P (ksInterruptState s)"
-  (simp: unless_def)
-crunch ksInterrupt[wp]: tcbSchedAppend "\<lambda>s. P (ksInterruptState s)"
-  (simp: unless_def)
-crunch ksInterrupt[wp]: tcbSchedDequeue "\<lambda>s. P (ksInterruptState s)"
-
-crunch irq_states[wp]: tcbSchedEnqueue valid_irq_states'
-  (simp: unless_def)
-crunch irq_states[wp]: tcbSchedAppend valid_irq_states'
-  (simp: unless_def)
-crunch irq_states[wp]: tcbSchedDequeue valid_irq_states'
-
-crunch ct'[wp]: tcbSchedEnqueue "\<lambda>s. P (ksCurThread s)"
-  (simp: unless_def)
-crunch ct'[wp]: tcbSchedAppend "\<lambda>s. P (ksCurThread s)"
-  (simp: unless_def)
-crunch ct'[wp]: tcbSchedDequeue "\<lambda>s. P (ksCurThread s)"
-
-crunch pde_mappings'[wp]: tcbSchedEnqueue "valid_pde_mappings'"
-  (simp: unless_def)
-crunch pde_mappings'[wp]: tcbSchedAppend "valid_pde_mappings'"
-  (simp: unless_def)
-crunch pde_mappings'[wp]: tcbSchedDequeue "valid_pde_mappings'"
+  apply (wpsimp wp: tcbQueueRemove_if_live_then_nonz_cap' threadGet_wp)
+  apply (fastforce elim: if_live_then_nonz_capE' simp: obj_at'_def projectKOs ko_wp_at'_def)
+  done
+
+crunches tcbSchedAppend, tcbSchedDequeue, tcbSchedEnqueue
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+  and tcb_at'[wp]: "tcb_at' t"
+  and ctes_of[wp]: "\<lambda>s. P (ctes_of s)"
+  and ksInterrupt[wp]: "\<lambda>s. P (ksInterruptState s)"
+  and irq_states[wp]: valid_irq_states'
+  and irq_node'[wp]: "\<lambda>s. P (irq_node' s)"
+  and ct'[wp]: "\<lambda>s. P (ksCurThread s)"
+  and global_refs'[wp]: valid_global_refs'
+  and ifunsafe'[wp]: if_unsafe_then_cap'
+  and cap_to'[wp]: "ex_nonz_cap_to' p"
+  and state_refs_of'[wp]: "\<lambda>s. P (state_refs_of' s)"
+  and idle'[wp]: valid_idle'
+  and valid_pde_mappings'[wp]: valid_pde_mappings'
+  (simp: unless_def crunch_simps wp: crunch_wps)
 
 lemma tcbSchedEnqueue_vms'[wp]:
   "\<lbrace>valid_machine_state'\<rbrace> tcbSchedEnqueue t \<lbrace>\<lambda>_. valid_machine_state'\<rbrace>"
@@ -446,9 +369,6 @@ lemma tcbSchedEnqueue_vms'[wp]:
   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift tcbSchedEnqueue_ksMachine)
   done
 
-crunch ksCurDomain[wp]: tcbSchedEnqueue "\<lambda>s. P (ksCurDomain s)"
-(simp: unless_def)
-
 lemma tcbSchedEnqueue_tcb_in_cur_domain'[wp]:
   "\<lbrace>tcb_in_cur_domain' t'\<rbrace> tcbSchedEnqueue t \<lbrace>\<lambda>_. tcb_in_cur_domain' t' \<rbrace>"
   apply (rule tcb_in_cur_domain'_lift)
@@ -469,19 +389,85 @@ lemma ct_idle_or_in_cur_domain'_lift2:
   apply (wp hoare_weak_lift_imp hoare_vcg_disj_lift | assumption)+
   done
 
+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 tcbSchedNext_update_valid_mdb'[wp]:
+  "\<lbrace>valid_mdb' and tcb_at' tcbPtr\<rbrace> threadSet (tcbSchedNext_update f) tcbPtr \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  apply (wpsimp wp: threadSet_mdb')
+  apply (fastforce simp: obj_at'_def valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)
+  done
+
+lemma tcbSchedPrev_update_valid_mdb'[wp]:
+  "\<lbrace>valid_mdb' and tcb_at' tcbPtr\<rbrace> threadSet (tcbSchedPrev_update f) tcbPtr \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  apply (wpsimp wp: threadSet_mdb')
+  apply (fastforce simp: obj_at'_def valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)
+  done
+
+lemma tcbQueueRemove_valid_mdb':
+  "\<lbrace>\<lambda>s. valid_mdb' s \<and> valid_objs' s\<rbrace> tcbQueueRemove q tcbPtr \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  unfolding tcbQueueRemove_def
+  apply (wpsimp wp: getTCB_wp)
+  apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+  apply (fastforce simp: valid_tcb'_def obj_at'_def)
+  done
+
+lemma tcbQueuePrepend_valid_mdb':
+  "\<lbrace>valid_mdb' and tcb_at' tcbPtr
+    and (\<lambda>s. \<not> tcbQueueEmpty queue \<longrightarrow> tcb_at' (the (tcbQueueHead queue)) s)\<rbrace>
+   tcbQueuePrepend queue tcbPtr
+   \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  unfolding tcbQueuePrepend_def
+  by (wpsimp wp: hoare_vcg_if_lift2 hoare_vcg_imp_lift')
+
+lemma tcbQueueAppend_valid_mdb':
+  "\<lbrace>\<lambda>s. valid_mdb' s \<and> tcb_at' tcbPtr s
+        \<and> (\<not> tcbQueueEmpty queue \<longrightarrow> tcb_at' (the (tcbQueueEnd queue)) s)\<rbrace>
+   tcbQueueAppend queue tcbPtr
+   \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  unfolding tcbQueueAppend_def
+  by (wpsimp wp: hoare_vcg_if_lift2 hoare_vcg_imp_lift')
+
+lemma tcbQueued_update_valid_mdb'[wp]:
+  "\<lbrace>valid_mdb' and tcb_at' tcbPtr\<rbrace> threadSet (tcbQueued_update f) tcbPtr \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  apply (wpsimp wp: threadSet_mdb')
+  apply (fastforce simp: obj_at'_def valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)
+  done
+
+lemma valid_mdb'_ksReadyQueuesL1Bitmap_update[simp]:
+  "valid_mdb' (ksReadyQueuesL1Bitmap_update f s) = valid_mdb' s"
+  by (simp add: valid_mdb'_def)
+
+lemma valid_mdb'_ksReadyQueuesL2Bitmap_update[simp]:
+  "valid_mdb' (ksReadyQueuesL2Bitmap_update f s) = valid_mdb' s"
+  by (simp add: valid_mdb'_def)
+
+lemma tcbSchedEnqueue_valid_mdb'[wp]:
+  "\<lbrace>valid_mdb' and valid_objs' and pspace_aligned' and pspace_distinct'\<rbrace>
+   tcbSchedEnqueue tcbPtr
+   \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  apply (clarsimp simp: tcbSchedEnqueue_def setQueue_def)
+  apply (wpsimp wp: tcbQueuePrepend_valid_mdb' threadGet_wp simp: bitmap_fun_defs)
+  apply normalise_obj_at'
+  apply (fastforce dest!: obj_at'_tcbQueueHead_ksReadyQueues
+                    simp: ready_queue_relation_def ksReadyQueues_asrt_def obj_at'_def)
+  done
+
+crunches tcbSchedEnqueue
+  for cur_tcb'[wp]: cur_tcb'
+  (wp: threadSet_cur)
+
 lemma tcbSchedEnqueue_invs'[wp]:
-  "\<lbrace>invs'
-    and st_tcb_at' runnable' t
-    and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t)\<rbrace>
-     tcbSchedEnqueue t
+  "\<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_state'_def)
-  apply (rule hoare_pre)
-   apply (wp tcbSchedEnqueue_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 tcbSchedEnqueue_ct_not_inQ
+              simp: cteCaps_of_def o_def)
   done
 
 crunch ksMachine[wp]: tcbSchedAppend "\<lambda>s. P (ksMachineState s)"
@@ -490,7 +476,7 @@ crunch ksMachine[wp]: tcbSchedAppend "\<lambda>s. P (ksMachineState s)"
 lemma tcbSchedAppend_vms'[wp]:
   "\<lbrace>valid_machine_state'\<rbrace> tcbSchedAppend t \<lbrace>\<lambda>_. valid_machine_state'\<rbrace>"
   apply (simp add: valid_machine_state'_def pointerInUserData_def pointerInDeviceData_def)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift tcbSchedAppend_ksMachine)
+  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
   done
 
 crunch pspace_domain_valid[wp]: tcbSchedAppend "pspace_domain_valid"
@@ -505,21 +491,27 @@ crunch ksIdleThread[wp]: tcbSchedAppend "\<lambda>s. P (ksIdleThread s)"
 crunch ksDomSchedule[wp]: tcbSchedAppend "\<lambda>s. P (ksDomSchedule s)"
 (simp: unless_def)
 
+lemma tcbQueueAppend_tcbPriority_obj_at'[wp]:
+  "tcbQueueAppend queue tptr \<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
+  unfolding tcbQueueAppend_def
+  apply (wpsimp wp: threadSet_wp)
+  by (auto simp: obj_at'_def projectKOs objBits_simps ps_clear_def split: if_splits)
+
+lemma tcbQueueAppend_tcbDomain_obj_at'[wp]:
+  "tcbQueueAppend queue tptr \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  unfolding tcbQueueAppend_def
+  apply (wpsimp wp: threadSet_wp)
+  by (auto simp: obj_at'_def projectKOs objBits_simps ps_clear_def split: if_splits)
+
 lemma tcbSchedAppend_tcbDomain[wp]:
-  "\<lbrace> obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t' \<rbrace>
-     tcbSchedAppend t
-   \<lbrace> \<lambda>_. obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t' \<rbrace>"
+  "tcbSchedAppend t \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
   apply (clarsimp simp: tcbSchedAppend_def)
-  apply (wpsimp simp: unless_def)+
-  done
+  by wpsimp
 
 lemma tcbSchedAppend_tcbPriority[wp]:
-  "\<lbrace> obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t' \<rbrace>
-     tcbSchedAppend t
-   \<lbrace> \<lambda>_. obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t' \<rbrace>"
+  "tcbSchedAppend t \<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
   apply (clarsimp simp: tcbSchedAppend_def)
-  apply (wpsimp simp: unless_def)+
-  done
+  by wpsimp
 
 lemma tcbSchedAppend_tcb_in_cur_domain'[wp]:
   "\<lbrace>tcb_in_cur_domain' t'\<rbrace> tcbSchedAppend t \<lbrace>\<lambda>_. tcb_in_cur_domain' t' \<rbrace>"
@@ -533,26 +525,58 @@ crunches tcbSchedAppend, tcbSchedDequeue
   (simp: unless_def)
 
 lemma tcbSchedAppend_sch_act_wf[wp]:
-  "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace> tcbSchedAppend thread
-  \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  apply (simp add:tcbSchedAppend_def bitmap_fun_defs)
-  apply (wp unless_wp setQueue_sch_act threadGet_wp|simp)+
-  apply (fastforce simp:typ_at'_def obj_at'_def)
+  "tcbSchedAppend thread \<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
+  by (wpsimp wp: sch_act_wf_lift)
+
+lemma tcbSchedAppend_valid_bitmapQ[wp]:
+  "\<lbrace>valid_bitmaps\<rbrace> tcbSchedAppend tcbPtr \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
+  supply if_split[split del]
+  unfolding tcbSchedAppend_def
+  apply (wpsimp simp: tcbQueueAppend_def
+                  wp: setQueue_valid_bitmapQ' addToBitmap_valid_bitmapQ_except addToBitmap_bitmapQ
+                      threadGet_wp hoare_vcg_if_lift2)
+  apply (clarsimp simp: ksReadyQueues_asrt_def split: if_splits)
+  apply normalise_obj_at'
+  apply (force dest: tcbQueueHead_iff_tcbQueueEnd
+               simp: valid_bitmaps_def valid_bitmapQ_def tcbQueueEmpty_def)
+  done
+
+lemma tcbSchedAppend_valid_mdb'[wp]:
+  "\<lbrace>valid_mdb' and valid_tcbs' and pspace_aligned' and pspace_distinct'\<rbrace>
+   tcbSchedAppend tcbPtr
+   \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  apply (clarsimp simp: tcbSchedAppend_def setQueue_def)
+  apply (wpsimp wp: tcbQueueAppend_valid_mdb' threadGet_wp simp: bitmap_fun_defs)
+  by (fastforce dest: obj_at'_tcbQueueEnd_ksReadyQueues
+                simp: ready_queue_relation_def ksReadyQueues_asrt_def obj_at'_def projectKOs)
+
+lemma tcbSchedAppend_valid_bitmaps[wp]:
+  "tcbSchedAppend tcbPtr \<lbrace>valid_bitmaps\<rbrace>"
+  unfolding valid_bitmaps_def
+  apply wpsimp
+  apply (clarsimp simp: valid_bitmaps_def)
   done
 
 lemma tcbSchedAppend_invs'[wp]:
-  "\<lbrace>invs'
-    and st_tcb_at' runnable' t
-    and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t)\<rbrace>
-     tcbSchedAppend t
+  "\<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_state'_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:
@@ -575,49 +599,13 @@ 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)
 
-lemma valid_queues'_ko_atD:
-  "valid_queues' s \<Longrightarrow> ko_at' tcb t s \<Longrightarrow> tcbQueued tcb
-    \<Longrightarrow> t \<in> set (ksReadyQueues s (tcbDomain tcb, tcbPriority tcb))"
-  apply (simp add: valid_queues'_def)
-  apply (elim allE, erule mp)
-  apply normalise_obj_at'
-  apply (simp add: inQ_def)
-  done
-
-lemma tcbSchedEnqueue_in_ksQ:
-  "\<lbrace>valid_queues' and tcb_at' t\<rbrace> tcbSchedEnqueue t
-   \<lbrace>\<lambda>r s. \<exists>domain priority. t \<in> set (ksReadyQueues s (domain, priority))\<rbrace>"
-  apply (rule_tac Q="\<lambda>s. \<exists>d p. valid_queues' s \<and>
-                             obj_at' (\<lambda>tcb. tcbPriority tcb = p) t s \<and>
-                             obj_at' (\<lambda>tcb. tcbDomain tcb = d) t s"
-           in hoare_pre_imp)
-   apply (clarsimp simp: tcb_at'_has_tcbPriority tcb_at'_has_tcbDomain)
-  apply (rule hoare_vcg_ex_lift)+
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply (wpsimp simp: if_apply_def2)
-     apply (rule_tac Q="\<lambda>rv s. tdom = d \<and> rv = p \<and> obj_at' (\<lambda>tcb. tcbPriority tcb = p) t s
-                             \<and> obj_at' (\<lambda>tcb. tcbDomain tcb = d) t s"
-              in hoare_post_imp, clarsimp)
-     apply (wp, (wp threadGet_const)+)
-   apply (rule_tac Q="\<lambda>rv s.
-              obj_at' (\<lambda>tcb. tcbPriority tcb = p) t s \<and>
-              obj_at' (\<lambda>tcb. tcbDomain tcb = d) t s \<and>
-              obj_at' (\<lambda>tcb. tcbQueued tcb = rv) t s \<and>
-              (rv \<longrightarrow> t \<in> set (ksReadyQueues s (d, p)))" in hoare_post_imp)
-    apply (clarsimp simp: o_def elim!: obj_at'_weakenE)
-   apply (wp threadGet_obj_at' hoare_vcg_imp_lift threadGet_const)
-  apply clarsimp
-  apply normalise_obj_at'
-  apply (frule(1) valid_queues'_ko_atD, simp+)
-  done
-
 crunch ksMachine[wp]: tcbSchedDequeue "\<lambda>s. P (ksMachineState s)"
   (simp: unless_def)
 
 lemma tcbSchedDequeue_vms'[wp]:
   "\<lbrace>valid_machine_state'\<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>_. valid_machine_state'\<rbrace>"
   apply (simp add: valid_machine_state'_def pointerInUserData_def pointerInDeviceData_def)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift tcbSchedDequeue_ksMachine)
+  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
   done
 
 crunch pspace_domain_valid[wp]: tcbSchedDequeue "pspace_domain_valid"
@@ -631,50 +619,93 @@ crunch ksIdleThread[wp]: tcbSchedDequeue "\<lambda>s. P (ksIdleThread s)"
 crunch ksDomSchedule[wp]: tcbSchedDequeue "\<lambda>s. P (ksDomSchedule s)"
 (simp: unless_def)
 
-crunch ksDomScheduleIdx[wp]: tcbSchedDequeue "\<lambda>s. P (ksDomScheduleIdx s)"
-(simp: unless_def)
-
 lemma tcbSchedDequeue_tcb_in_cur_domain'[wp]:
   "\<lbrace>tcb_in_cur_domain' t'\<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>_. tcb_in_cur_domain' t' \<rbrace>"
   apply (rule tcb_in_cur_domain'_lift)
    apply wp
-  apply (clarsimp simp: tcbSchedDequeue_def)
-  apply (wp hoare_when_weak_wp | simp)+
+  apply (clarsimp simp: tcbSchedDequeue_def tcbQueueRemove_def)
+  apply (wpsimp wp: hoare_when_weak_wp getObject_tcb_wp threadGet_wp)
   done
 
-lemma tcbSchedDequeue_tcbDomain[wp]:
-  "\<lbrace> obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t' \<rbrace>
-     tcbSchedDequeue t
-   \<lbrace> \<lambda>_. obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t' \<rbrace>"
-  apply (clarsimp simp: tcbSchedDequeue_def)
-  apply (wp hoare_when_weak_wp | simp)+
-  done
+crunch ksDomScheduleIdx[wp]: tcbSchedDequeue "\<lambda>s. P (ksDomScheduleIdx s)"
+  (simp: unless_def)
 
-lemma tcbSchedDequeue_tcbPriority[wp]:
-  "\<lbrace> obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t' \<rbrace>
-     tcbSchedDequeue t
-   \<lbrace> \<lambda>_. obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t' \<rbrace>"
-  apply (clarsimp simp: tcbSchedDequeue_def)
-  apply (wp hoare_when_weak_wp | simp)+
+lemma tcbSchedDequeue_valid_mdb'[wp]:
+  "\<lbrace>valid_mdb' and valid_objs'\<rbrace> tcbSchedDequeue tcbPtr \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  unfolding tcbSchedDequeue_def
+  apply (wpsimp simp: bitmap_fun_defs setQueue_def wp: threadSet_mdb' tcbQueueRemove_valid_mdb')
+      apply (rule_tac Q="\<lambda>_. tcb_at' tcbPtr" in hoare_post_imp)
+       apply (fastforce simp: tcb_cte_cases_def cteSizeBits_def)
+      apply (wpsimp wp: threadGet_wp)+
+  apply (fastforce simp: obj_at'_def)
   done
 
 lemma tcbSchedDequeue_invs'[wp]:
-  "\<lbrace>invs' and tcb_at' t\<rbrace>
-     tcbSchedDequeue t
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  unfolding invs'_def valid_state'_def
-  apply (rule hoare_pre)
-   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
-             tcbSchedDequeue_valid_queues
-             untyped_ranges_zero_lift
-        | simp add: cteCaps_of_def o_def)+
-  apply (fastforce elim: valid_objs'_maxDomain valid_objs'_maxPriority simp: valid_pspace'_def)+
+  "tcbSchedDequeue t \<lbrace>invs'\<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 ct_idle_or_in_cur_domain'_lift2 cur_tcb_lift
+              simp: cteCaps_of_def o_def)
   done
 
+lemma ready_qs_runnable_cross:
+  "\<lbrakk>(s, s') \<in> state_relation; pspace_aligned s; pspace_distinct s; valid_queues s\<rbrakk>
+   \<Longrightarrow> ready_qs_runnable s'"
+  apply (clarsimp simp: ready_qs_runnable_def)
+  apply normalise_obj_at'
+  apply (frule state_relation_ready_queues_relation)
+  apply (clarsimp simp: ready_queues_relation_def ready_queue_relation_def Let_def
+                        list_queue_relation_def)
+  apply (drule_tac x="tcbDomain ko" in spec)
+  apply (drule_tac x="tcbPriority ko" in spec)
+  apply (clarsimp simp: valid_queues_def)
+  apply (drule_tac x="tcbDomain ko" in spec)
+  apply (drule_tac x="tcbPriority ko" in spec)
+  apply clarsimp
+  apply (drule_tac x=t in bspec)
+   apply (fastforce simp: inQ_def in_opt_pred obj_at'_def projectKOs opt_map_red)
+  apply (fastforce dest: st_tcb_at_runnable_cross simp: obj_at'_def projectKOs st_tcb_at'_def)
+  done
+
+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_queues)?, (frule invs_psp_aligned)?, (frule invs_distinct)?,
+  fastforce dest: ready_qs_runnable_cross
+
+defs idleThreadNotQueued_def:
+  "idleThreadNotQueued s \<equiv> obj_at' (Not \<circ> tcbQueued) (ksIdleThread s) s"
+
+lemma idle_thread_not_queued:
+  "\<lbrakk>valid_idle s; valid_queues s; valid_etcbs s\<rbrakk>
+   \<Longrightarrow> \<not> (\<exists>d p. idle_thread s \<in> set (ready_queues s d p))"
+  apply (clarsimp simp: valid_queues_def)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply clarsimp
+  apply (drule_tac x="idle_thread s" in bspec)
+   apply fastforce
+  apply (clarsimp simp: valid_idle_def pred_tcb_at_def obj_at_def valid_etcbs_def)
+  done
+
+lemma valid_idle_tcb_at:
+  "valid_idle s \<Longrightarrow> tcb_at (idle_thread s) s"
+  by (clarsimp simp: valid_idle_def pred_tcb_at_def obj_at_def is_tcb_def)
+
 lemma setCurThread_corres:
-  "corres dc \<top> \<top> (modify (cur_thread_update (\<lambda>_. t))) (setCurThread t)"
-  apply (unfold setCurThread_def)
+  "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
@@ -716,47 +747,62 @@ lemma arch_switch_thread_ksQ[wp]:
   apply (wp)
   done
 
-crunch valid_queues[wp]: "Arch.switchToThread" "Invariants_H.valid_queues"
-(wp: crunch_wps simp: crunch_simps ignore: clearExMonitor)
+crunches storeWordUser, setVMRoot, asUser, storeWordUser, Arch.switchToThread
+  for ksQ[wp]: "\<lambda>s. P (ksReadyQueues s p)"
+  and ksIdleThread[wp]: "\<lambda>s. P (ksIdleThread s)"
+  and sym_heap_sched_pointers[wp]: sym_heap_sched_pointers
+  and valid_objs'[wp]: valid_objs'
+  (wp: crunch_wps threadSet_sched_pointers simp: crunch_simps)
+
+crunches arch_switch_to_thread, arch_switch_to_idle_thread
+  for pspace_aligned[wp]: pspace_aligned
+  and pspace_distinct[wp]: pspace_distinct
+  and ready_qs_distinct[wp]: ready_qs_distinct
+  and valid_idle[wp]: valid_idle
+  (wp: ready_qs_distinct_lift)
+
+lemma valid_queues_in_correct_ready_q[elim!]:
+  "valid_queues s \<Longrightarrow> in_correct_ready_q s"
+  by (clarsimp simp: valid_queues_def in_correct_ready_q_def)
+
+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)
 
 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_vs_lookup and valid_global_objs
                 and unique_table_refs o caps_of_state
-                and st_tcb_at runnable t and valid_etcbs)
-             (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)"
-  (is "corres _ ?PA ?PH _ _")
-
-proof -
-  have mainpart: "corres dc (?PA) (?PH)
-     (do y \<leftarrow> arch_switch_to_thread t;
-         y \<leftarrow> (tcb_sched_action tcb_sched_dequeue t);
-         modify (cur_thread_update (\<lambda>_. t))
-      od)
-     (do y \<leftarrow> Arch.switchToThread t;
-         y \<leftarrow> tcbSchedDequeue t;
-         setCurThread 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)
+  apply add_ready_qs_runnable
+  apply (simp add: switch_to_thread_def Thread_H.switchToThread_def)
+  apply (rule corres_symb_exec_l[OF _ _ get_sp]; (solves wpsimp)?)
+  apply (rule corres_symb_exec_l[OF _ _ assert_sp]; (solves wpsimp)?)
+  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_stateAssert_ignore)
+     apply (fastforce dest!: state_relation_ready_queues_relation intro: ksReadyQueues_asrt_cross)
+    apply (rule corres_stateAssert_add_assertion[rotated])
+     apply fastforce
     apply (rule corres_guard_imp)
       apply (rule corres_split[OF arch_switchToThread_corres])
         apply (rule corres_split[OF tcbSchedDequeue_corres setCurThread_corres])
-         apply (wp|clarsimp simp: tcb_at_is_etcb_at st_tcb_at_tcb_at)+
-    done
-
-  show ?thesis
-    apply -
-    apply (simp add: switch_to_thread_def Thread_H.switchToThread_def)
-    apply (rule corres_symb_exec_l [where Q = "\<lambda> s rv. (?PA and (=) rv) s",
-                                    OF corres_symb_exec_l [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
@@ -771,15 +817,21 @@ lemma arch_switchToIdleThread_corres:
   done
 
 lemma switchToIdleThread_corres:
-  "corres dc invs invs_no_cicd' switch_to_idle_thread switchToIdleThread"
+  "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 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_trivial, rule corres_modify)
-        apply (simp add: state_relation_def cdt_relation_def)
-       apply (wp+, simp+)
+        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)
@@ -814,11 +866,9 @@ proof -
     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 Invariants_H.valid_queues_def
-                              sch_act_wf ct_in_state'_def state_refs_of'_def
-                              ps_clear_def valid_irq_node'_def valid_queues'_def ct_not_inQ_ct
-                              ct_idle_or_in_cur_domain'_def
-                              bitmapQ_defs valid_queues_no_bitmap_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
@@ -832,101 +882,20 @@ lemma setCurThread_invs:
   by (rule hoare_pre, rule setCurThread_invs_no_cicd')
      (simp add: invs'_to_invs_no_cicd'_def)
 
-lemma valid_queues_not_runnable_not_queued:
-  fixes s
-  assumes vq:  "Invariants_H.valid_queues 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
-
-  with vq have "st_tcb_at' runnable' t s"
-    unfolding Invariants_H.valid_queues_def valid_queues_no_bitmap_def
-    apply -
-    apply clarsimp
-    apply (drule_tac x=d in spec)
-    apply (drule_tac x=p in spec)
-    apply (clarsimp simp add: st_tcb_at'_def)
-    apply (drule(1) bspec)
-    apply (erule obj_at'_weakenE)
-    apply (clarsimp)
-    done
-
-  with st show False
-    apply -
-    apply (drule(1) pred_tcb_at_conj')
-    apply (clarsimp)
-    done
-qed
-
-(*
- * The idle thread is not part of any ready queues.
- *)
-lemma idle'_not_tcbQueued':
- assumes vq:   "Invariants_H.valid_queues 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 vq' show ?thesis
-     by (rule valid_queues_not_runnable_not_queued)
- qed
-
 lemma setCurThread_invs_no_cicd'_idle_thread:
-  "\<lbrace>invs_no_cicd' and (\<lambda>s. t = ksIdleThread s) \<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
-  have idle'_activatable': "\<And> s t. st_tcb_at' idle' t s \<Longrightarrow> st_tcb_at' activatable' t s"
-    apply (clarsimp simp: st_tcb_at'_def o_def obj_at'_def)
+  "\<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
-  show ?thesis
-    apply (simp add: setCurThread_def)
-    apply wp
-    apply (clarsimp simp: all_invs_but_ct_idle_or_in_cur_domain'_def)
-    apply (frule (2) idle'_not_tcbQueued'[simplified o_def])
-    apply (clarsimp simp add: ct_not_inQ_ct idle'_activatable'
-                              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_queues_no_bitmap_def valid_queues'_def
-                              pred_tcb_at'_def
-                        cong: option.case_cong)
-    apply (clarsimp simp: obj_at'_def projectKOs idle_tcb'_def)
-    done
-qed
 
 lemma clearExMonitor_invs'[wp]:
   "\<lbrace>invs'\<rbrace> doMachineOp ARM.clearExMonitor \<lbrace>\<lambda>rv. invs'\<rbrace>"
@@ -964,13 +933,13 @@ lemma Arch_switchToThread_tcb_in_cur_domain'[wp]:
   done
 
 lemma tcbSchedDequeue_not_tcbQueued:
-  "\<lbrace> tcb_at' t \<rbrace> tcbSchedDequeue t \<lbrace> \<lambda>_. obj_at' (\<lambda>x. \<not> tcbQueued x) t \<rbrace>"
+  "\<lbrace>\<top>\<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>_. obj_at' (\<lambda>x. \<not> tcbQueued x) t\<rbrace>"
   apply (simp add: tcbSchedDequeue_def)
   apply (wp|clarsimp)+
   apply (rule_tac Q="\<lambda>queued. obj_at' (\<lambda>x. tcbQueued x = queued) t" in hoare_post_imp)
-   apply (clarsimp simp: obj_at'_def)
-  apply (wp threadGet_obj_at')
-  apply (simp)
+     apply (clarsimp simp: obj_at'_def)
+    apply (wpsimp wp: threadGet_wp)+
+  apply (clarsimp simp: obj_at'_def)
   done
 
 lemma Arch_switchToThread_obj_at[wp]:
@@ -1002,10 +971,6 @@ crunch valid_irq_states'[wp]: asUser "valid_irq_states'"
 crunch valid_machine_state'[wp]: asUser "valid_machine_state'"
 (wp: crunch_wps simp: crunch_simps)
 
-crunch valid_queues'[wp]: asUser "valid_queues'"
-(wp: crunch_wps simp: crunch_simps)
-
-
 crunch irq_masked'_helper: asUser "\<lambda>s. P (intStateIRQTable (ksInterruptState s))"
 (wp: crunch_wps simp: crunch_simps)
 
@@ -1033,22 +998,17 @@ lemma Arch_switchToThread_invs_no_cicd':
 
 
 lemma tcbSchedDequeue_invs_no_cicd'[wp]:
-  "\<lbrace>invs_no_cicd' and tcb_at' t\<rbrace>
-     tcbSchedDequeue t
-   \<lbrace>\<lambda>_. invs_no_cicd'\<rbrace>"
-  unfolding all_invs_but_ct_idle_or_in_cur_domain'_def valid_state'_def
+  "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
-            tcbSchedDequeue_valid_queues_weak
             untyped_ranges_zero_lift
         | simp add: cteCaps_of_def o_def)+
   apply clarsimp
-  apply (fastforce simp: valid_pspace'_def valid_queues_def
-                   elim: valid_objs'_maxDomain valid_objs'_maxPriority intro: obj_at'_conjI)
   done
 
 lemma switchToThread_invs_no_cicd':
-  "\<lbrace>invs_no_cicd' and st_tcb_at' runnable' t and tcb_in_cur_domain' t \<rbrace> ThreadDecls_H.switchToThread t \<lbrace>\<lambda>rv. invs' \<rbrace>"
+  "\<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')
@@ -1056,7 +1016,7 @@ lemma switchToThread_invs_no_cicd':
   done
 
 lemma switchToThread_invs[wp]:
-  "\<lbrace>invs' and st_tcb_at' runnable' t and tcb_in_cur_domain' t \<rbrace> switchToThread t \<lbrace>\<lambda>rv. invs' \<rbrace>"
+  "\<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 threadSet_timeslice_invs setCurThread_invs
              Arch_switchToThread_invs dmo_invs'
@@ -1141,62 +1101,6 @@ lemma tcb_at_typ_at':
   apply (case_tac ko, simp_all)
   done
 
-
-lemma invs'_not_runnable_not_queued:
-  fixes s
-  assumes inv: "invs' s"
-      and st: "st_tcb_at' (Not \<circ> runnable') t s"
-  shows "obj_at' (Not \<circ> tcbQueued) t s"
-  apply (insert assms)
-  apply (rule valid_queues_not_runnable_not_queued)
-    apply (clarsimp simp add: invs'_def valid_state'_def)+
-  done
-
-lemma valid_queues_not_tcbQueued_not_ksQ:
-  fixes s
-  assumes   vq: "Invariants_H.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"
-    unfolding Invariants_H.valid_queues_def valid_queues_no_bitmap_def
-    apply clarify
-    apply (drule_tac x=d in spec)
-    apply (drule_tac x=p in spec)
-    apply (clarsimp)
-    apply (drule(1) bspec)
-    apply (erule obj_at'_weakenE)
-    apply (simp)
-    done
-  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 valid_state'_def)
-  apply (drule(1) valid_queues_not_tcbQueued_not_ksQ)
-  apply (clarsimp)
-  done
-
-lemma ct_not_ksQ:
-  "\<lbrakk> invs' s; ksSchedulerAction s = ResumeCurrentThread \<rbrakk>
-   \<Longrightarrow> \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)"
-  apply (clarsimp simp: invs'_def valid_state'_def ct_not_inQ_def)
-  apply (frule(1) valid_queues_not_tcbQueued_not_ksQ)
-  apply (fastforce)
-  done
-
 crunch nosch[wp]: getCurThread "\<lambda>s. P (ksSchedulerAction s)"
 
 lemma setThreadState_rct:
@@ -1271,21 +1175,24 @@ lemma bitmapQ_from_bitmap_lookup:
   done
 
 lemma lookupBitmapPriority_obj_at':
-  "\<lbrakk>ksReadyQueuesL1Bitmap s (ksCurDomain s) \<noteq> 0; valid_queues_no_bitmap s; valid_bitmapQ s;
-         bitmapQ_no_L1_orphans s\<rbrakk>
-        \<Longrightarrow> obj_at' (inQ (ksCurDomain s) (lookupBitmapPriority (ksCurDomain s) s) and runnable' \<circ> tcbState)
-             (hd (ksReadyQueues s (ksCurDomain s, lookupBitmapPriority (ksCurDomain s) s))) s"
+  "\<lbrakk>ksReadyQueuesL1Bitmap s d \<noteq> 0; valid_bitmapQ s; bitmapQ_no_L1_orphans s;
+    ksReadyQueues_asrt s; ready_qs_runnable s; pspace_aligned' s; pspace_distinct' s\<rbrakk>
+   \<Longrightarrow> obj_at' (inQ d (lookupBitmapPriority d s) and runnable' \<circ> tcbState)
+               (the (tcbQueueHead (ksReadyQueues s (d, lookupBitmapPriority d s)))) s"
   apply (drule (2) bitmapQ_from_bitmap_lookup)
   apply (simp add: valid_bitmapQ_bitmapQ_simp)
-  apply (case_tac "ksReadyQueues s (ksCurDomain s, lookupBitmapPriority (ksCurDomain s) s)", simp)
-  apply (clarsimp, rename_tac t ts)
-  apply (drule cons_set_intro)
-  apply (drule (2) valid_queues_no_bitmap_objD)
+  apply (clarsimp simp: ready_queue_relation_def ksReadyQueues_asrt_def tcbQueueEmpty_def)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x="lookupBitmapPriority d s" in spec)
+  apply clarsimp
+  apply (frule (3) obj_at'_tcbQueueHead_ksReadyQueues)
+  apply (fastforce simp: obj_at'_and ready_qs_runnable_def obj_at'_def st_tcb_at'_def inQ_def
+                         tcbQueueEmpty_def)
   done
 
 lemma bitmapL1_zero_ksReadyQueues:
   "\<lbrakk> valid_bitmapQ s ; bitmapQ_no_L1_orphans s \<rbrakk>
-   \<Longrightarrow> (ksReadyQueuesL1Bitmap s d = 0) = (\<forall>p. ksReadyQueues s (d,p) = [])"
+   \<Longrightarrow> (ksReadyQueuesL1Bitmap s d = 0) = (\<forall>p. tcbQueueEmpty (ksReadyQueues s (d, p)))"
   apply (cases "ksReadyQueuesL1Bitmap s d = 0")
    apply (force simp add: bitmapQ_def valid_bitmapQ_def)
   apply (fastforce dest: bitmapQ_from_bitmap_lookup simp: valid_bitmapQ_bitmapQ_simp)
@@ -1356,7 +1263,7 @@ lemma bitmapL1_highest_lookup:
   done
 
 lemma bitmapQ_ksReadyQueuesI:
-  "\<lbrakk> bitmapQ d p s ; valid_bitmapQ s \<rbrakk> \<Longrightarrow> ksReadyQueues s (d, p) \<noteq> []"
+  "\<lbrakk> bitmapQ d p s ; valid_bitmapQ s \<rbrakk> \<Longrightarrow> \<not> tcbQueueEmpty (ksReadyQueues s (d, p))"
   unfolding valid_bitmapQ_def by simp
 
 lemma getReadyQueuesL2Bitmap_inv[wp]:
@@ -1365,24 +1272,22 @@ lemma getReadyQueuesL2Bitmap_inv[wp]:
 
 lemma switchToThread_lookupBitmapPriority_wp:
   "\<lbrace>\<lambda>s. invs_no_cicd' s \<and> bitmapQ (ksCurDomain s) (lookupBitmapPriority (ksCurDomain s) s) s \<and>
-        t = hd (ksReadyQueues s (ksCurDomain s, lookupBitmapPriority (ksCurDomain s) s)) \<rbrace>
+        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 ; 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 elim: obj_at'_weaken simp: inQ_def tcb_in_cur_domain'_def st_tcb_at'_def)
-    done
-  thus ?thesis
-    by (wp switchToThread_invs_no_cicd') (fastforce dest: invs_no_cicd'_queues)
-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_no_cicd':
   "\<lbrace>invs_no_cicd'\<rbrace> switchToIdleThread \<lbrace>\<lambda>rv. invs'\<rbrace>"
@@ -1482,9 +1387,8 @@ 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 st_tcb_at runnable t and valid_etcbs)
-             (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)
@@ -1493,8 +1397,8 @@ lemma guarded_switch_to_corres:
       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)+
-    done
+   apply (force simp: st_tcb_at_tcb_at projectKOs)+
+  done
 
 abbreviation "enumPrio \<equiv> [0.e.maxPriority]"
 
@@ -1503,7 +1407,7 @@ lemma curDomain_corres: "corres (=) \<top> \<top> (gets cur_domain) (curDomain)"
 
 lemma curDomain_corres':
   "corres (=) \<top> (\<lambda>s. ksCurDomain s \<le> maxDomain)
-    (gets cur_domain) (if 1 < numDomains then curDomain else return 0)"
+    (gets cur_domain) (if Suc 0 < numDomains then curDomain else return 0)"
   apply (case_tac "1 < numDomains"; simp)
    apply (rule corres_guard_imp[OF curDomain_corres]; solves simp)
   (* if we have only one domain, then we are in it *)
@@ -1513,27 +1417,32 @@ lemma curDomain_corres':
 
 lemma lookupBitmapPriority_Max_eqI:
   "\<lbrakk> valid_bitmapQ s ; bitmapQ_no_L1_orphans s ; ksReadyQueuesL1Bitmap s d \<noteq> 0 \<rbrakk>
-   \<Longrightarrow> lookupBitmapPriority d s = (Max {prio. ksReadyQueues s (d, prio) \<noteq> []})"
+   \<Longrightarrow> lookupBitmapPriority d s = (Max {prio. \<not> tcbQueueEmpty (ksReadyQueues s (d, prio))})"
   apply (rule Max_eqI[simplified eq_commute]; simp)
    apply (fastforce simp: bitmapL1_highest_lookup valid_bitmapQ_bitmapQ_simp)
   apply (metis valid_bitmapQ_bitmapQ_simp bitmapQ_from_bitmap_lookup)
   done
 
 lemma corres_gets_queues_getReadyQueuesL1Bitmap:
-  "corres (\<lambda>qs l1. ((l1 = 0) = (\<forall>p. qs p = []))) \<top> valid_queues
+  "corres (\<lambda>qs l1. (l1 = 0) = (\<forall>p. qs p = [])) \<top> valid_bitmaps
     (gets (\<lambda>s. ready_queues s d)) (getReadyQueuesL1Bitmap d)"
-  unfolding state_relation_def valid_queues_def getReadyQueuesL1Bitmap_def
-  by (clarsimp simp: bitmapL1_zero_ksReadyQueues ready_queues_relation_def)
+  unfolding state_relation_def valid_bitmaps_def getReadyQueuesL1Bitmap_def
+  apply (clarsimp simp: ready_queues_relation_def ready_queue_relation_def Let_def)
+  apply (drule_tac x=d in spec)
+  apply (fastforce simp: bitmapL1_zero_ksReadyQueues list_queue_relation_def tcbQueueEmpty_def)
+  done
 
 lemma guarded_switch_to_chooseThread_fragment_corres:
   "corres dc
     (P and st_tcb_at runnable t and invs and valid_sched)
-    (P' and st_tcb_at' runnable' t and invs_no_cicd')
-          (guarded_switch_to t)
-          (do runnable \<leftarrow> isRunnable t;
-              y \<leftarrow> assert runnable;
-              ThreadDecls_H.switchToThread t
-           od)"
+    (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)
@@ -1548,35 +1457,50 @@ lemma guarded_switch_to_chooseThread_fragment_corres:
               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'
+   \<Longrightarrow> Max {prio. ready_queues s d prio \<noteq> []}
+       = Max {prio. \<not> tcbQueueEmpty (ksReadyQueues s' (d, prio))}"
+  apply (clarsimp simp: ready_queues_relation_def ready_queue_relation_def Let_def
+                        list_queue_relation_def tcbQueueEmpty_def)
+  apply (rule Max_eq_if)
+     apply fastforce
+    apply fastforce
+   apply (fastforce dest: heap_path_head)
+  apply clarsimp
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=b in spec)
+  apply force
+  done
+
 lemma bitmap_lookup_queue_is_max_non_empty:
-  "\<lbrakk> valid_queues s'; (s, s') \<in> state_relation; invs s;
+  "\<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 all_invs_but_ct_idle_or_in_cur_domain'_def 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 \<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 (simp add: valid_queues_no_bitmap_def)
-   apply (erule_tac x="ksCurDomain s" in allE)
-   apply (erule_tac x="lookupBitmapPriority (ksCurDomain s) s" in allE)
-   apply (clarsimp simp: st_tcb_at'_def)
-   apply (erule obj_at'_weaken)
-   apply simp
-   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>"
@@ -1589,51 +1513,68 @@ lemma invs_no_cicd_ksCurDomain_maxDomain':
   unfolding invs_no_cicd'_def by simp
 
 lemma chooseThread_corres:
-  "corres dc (invs and valid_sched) (invs_no_cicd')
-     choose_thread chooseThread" (is "corres _ ?PREI ?PREH _ _")
+  "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
-  unfolding choose_thread_def chooseThread_def
-  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> 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 dest!: invs_no_cicd'_queues simp: bitmap_lookup_queue_is_max_non_empty)
-              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 (clarsimp simp: if_apply_def2)
-      apply (wp hoare_vcg_conj_lift hoare_vcg_imp_lift ksReadyQueuesL1Bitmap_return_wp)
-     apply (wpsimp wp: curDomain_or_return_0 simp: curDomain_def)+
-    apply (fastforce simp: invs_no_cicd'_def)
-   apply (clarsimp simp: valid_sched_def DetSchedInvs_AI.valid_queues_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 (simp add: invs_no_cicd_ksCurDomain_maxDomain')
-  apply (clarsimp dest!: invs_no_cicd'_queues)
-  apply (fastforce intro: ksReadyQueuesL1Bitmap_st_tcb_at')
-  done
+    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 (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 =
@@ -1722,7 +1663,7 @@ lemma isHighestPrio_corres:
   assumes "d' = d"
   assumes "p' = p"
   shows
-    "corres ((=)) \<top> valid_queues
+    "corres ((=)) \<top> valid_bitmaps
       (gets (is_highest_prio d p))
       (isHighestPrio d' p')"
   using assms
@@ -1732,18 +1673,16 @@ lemma isHighestPrio_corres:
     apply (rule corres_split[OF corres_gets_queues_getReadyQueuesL1Bitmap])
       apply (rule corres_if_r'[where P'="\<lambda>_. True",rotated])
        apply (rule_tac corres_symb_exec_r)
-              apply (rule_tac
-                       P="\<lambda>s. q = ready_queues s d
-                              " and
-                       P'="\<lambda>s. valid_queues s \<and>
-                               l1 = ksReadyQueuesL1Bitmap s d \<and>
-                               l1 \<noteq> 0 \<and> hprio = lookupBitmapPriority d s" and
-                       F="hprio = Max {prio. q prio \<noteq> []}" in corres_req)
-              apply (elim conjE)
-              apply (clarsimp simp: valid_queues_def)
-              apply (subst lookupBitmapPriority_Max_eqI; blast?)
-              apply (fastforce simp: ready_queues_relation_def dest!: state_relationD)
-             apply fastforce
+          apply (rule_tac P="\<lambda>s. q = ready_queues s d"
+                      and P'="\<lambda>s. valid_bitmaps s \<and> l1 = ksReadyQueuesL1Bitmap s d \<and>
+                                  l1 \<noteq> 0 \<and> hprio = lookupBitmapPriority d s"
+                      and F="hprio = Max {prio. q prio \<noteq> []}" in corres_req)
+           apply (elim conjE)
+           apply (clarsimp simp: valid_bitmaps_def)
+           apply (subst lookupBitmapPriority_Max_eqI; blast?)
+           apply (fastforce dest: state_relation_ready_queues_relation Max_prio_helper[where d=d]
+                            simp: tcbQueueEmpty_def)
+          apply fastforce
          apply (wpsimp simp: if_apply_def2 wp: hoare_drop_imps ksReadyQueuesL1Bitmap_return_wp)+
   done
 
@@ -1755,9 +1694,8 @@ crunch inv[wp]: schedule_switch_thread_fastfail P
 crunch inv[wp]: scheduleSwitchThreadFastfail P
 
 lemma setSchedulerAction_invs': (* not in wp set, clobbered by ssa_wp *)
-  "\<lbrace>\<lambda>s. invs' s \<rbrace> setSchedulerAction ChooseNewThread \<lbrace>\<lambda>_. invs' \<rbrace>"
+  "setSchedulerAction ChooseNewThread \<lbrace>invs' \<rbrace>"
   by (wpsimp simp: invs'_def cur_tcb'_def valid_state'_def valid_irq_node'_def ct_not_inQ_def
-                   valid_queues_def valid_queues_no_bitmap_def valid_queues'_def
                    ct_idle_or_in_cur_domain'_def)
 
 lemma scheduleChooseNewThread_corres:
@@ -1789,6 +1727,46 @@ lemma ethread_get_when_corres:
   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
+
+crunches 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)
+
+crunches 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]
@@ -1816,7 +1794,7 @@ lemma schedule_corres:
          apply (rule corres_split[OF thread_get_isRunnable_corres])
            apply (rule corres_split)
               apply (rule corres_when, simp)
-              apply (rule tcbSchedEnqueue_corres)
+              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)+
@@ -1825,7 +1803,7 @@ lemma schedule_corres:
                 rename_tac was_running wasRunning)
           apply (rule corres_split)
              apply (rule corres_when, simp)
-             apply (rule tcbSchedEnqueue_corres)
+             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)
@@ -1841,7 +1819,7 @@ lemma schedule_corres:
                     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])
+                         apply (rule corres_split[OF tcbSchedEnqueue_corres], simp)
                            apply (simp, fold dc_def)
                            apply (rule corres_split)
                               apply (rule setSchedulerAction_corres; simp)
@@ -1855,7 +1833,7 @@ lemma schedule_corres:
                           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])
+                         apply (rule corres_split[OF tcbSchedAppend_corres], simp)
                            apply (simp, fold dc_def)
                            apply (rule corres_split)
                               apply (rule setSchedulerAction_corres; simp)
@@ -1887,7 +1865,8 @@ lemma schedule_corres:
                     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)+
+                     del: gets_wp
+                  | strengthen valid_objs'_valid_tcbs')+
        apply (clarsimp simp: conj_ac if_apply_def2 cong: imp_cong conj_cong del: hoare_gets)
        apply (wp gets_wp)+
 
@@ -1910,18 +1889,17 @@ lemma schedule_corres:
                                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 (clarsimp simp add: pred_tcb_at_def obj_at_def is_tcb valid_idle_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)+
-     apply (simp add: valid_sched_def valid_blocked_def valid_blocked_except_def)
      done
 
   (* haskell final subgoal *)
-  apply (clarsimp simp: if_apply_def2 invs'_def valid_state'_def
+  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
@@ -1935,11 +1913,8 @@ proof -
     apply (simp add: setSchedulerAction_def)
     apply wp
     apply (clarsimp simp add: invs'_def valid_state'_def cur_tcb'_def
-                              Invariants_H.valid_queues_def
-                              state_refs_of'_def ps_clear_def
-                              valid_irq_node'_def valid_queues'_def
-                              tcb_in_cur_domain'_def ct_idle_or_in_cur_domain'_def
-                              bitmapQ_defs valid_queues_no_bitmap_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
@@ -1979,7 +1954,7 @@ lemma switchToThread_ct_not_queued_2:
   apply (simp add: Thread_H.switchToThread_def)
   apply (wp)
     apply (simp add: ARM_H.switchToThread_def setCurThread_def)
-    apply (wp tcbSchedDequeue_not_tcbQueued | simp )+
+    apply (wp tcbSchedDequeue_not_tcbQueued hoare_drop_imp | simp )+
   done
 
 lemma setCurThread_obj_at':
@@ -1993,11 +1968,12 @@ proof -
 qed
 
 lemma switchToIdleThread_ct_not_queued_no_cicd':
-  "\<lbrace> invs_no_cicd' \<rbrace> switchToIdleThread \<lbrace>\<lambda>rv s. obj_at' (Not \<circ> tcbQueued) (ksCurThread s) s \<rbrace>"
+  "\<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 (rule idle'_not_tcbQueued')
-  apply (simp add: invs_no_cicd'_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]:
@@ -2014,7 +1990,7 @@ lemma switchToThread_tcb_in_cur_domain':
    ThreadDecls_H.switchToThread thread
    \<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)
+  apply (wpsimp wp: tcbSchedDequeue_not_tcbQueued hoare_drop_imps)
   done
 
 lemma chooseThread_invs_no_cicd'_posts: (* generic version *)
@@ -2036,11 +2012,14 @@ proof -
     by (simp add: all_invs_but_ct_idle_or_in_cur_domain'_def maxDomain_def)
 
   show ?thesis
-    unfolding chooseThread_def Let_def curDomain_def
+    apply (clarsimp simp: chooseThread_def Let_def curDomain_def)
+    apply (rule hoare_seq_ext[OF _ stateAssert_sp])+
     apply (simp only: return_bind, simp)
-    apply (rule hoare_seq_ext[where B="\<lambda>rv s. invs_no_cicd' s \<and> rv = ksCurDomain s"])
+    apply (rule hoare_seq_ext[where B="\<lambda>rv s. invs_no_cicd' s \<and> rv = ksCurDomain s
+                                              \<and> ksReadyQueues_asrt s \<and> ready_qs_runnable s"])
      apply (rule_tac B="\<lambda>rv s. invs_no_cicd' s \<and> curdom = ksCurDomain s \<and>
-                               rv = ksReadyQueuesL1Bitmap s curdom" in hoare_seq_ext)
+                               rv = ksReadyQueuesL1Bitmap s curdom \<and>
+                               ksReadyQueues_asrt s \<and> ready_qs_runnable s" in hoare_seq_ext)
       apply (rename_tac l1)
       apply (case_tac "l1 = 0")
        (* switch to idle thread *)
@@ -2054,12 +2033,10 @@ proof -
       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
-      apply (clarsimp dest!: invs_no_cicd'_queues
-                      simp: valid_queues_def lookupBitmapPriority_def[symmetric])
-      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 (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
@@ -2098,11 +2075,14 @@ proof -
 
   (* FIXME this is almost identical to the chooseThread_invs_no_cicd'_posts proof, can generalise? *)
   show ?thesis
-    unfolding chooseThread_def Let_def curDomain_def
+    apply (clarsimp simp: chooseThread_def Let_def curDomain_def)
+    apply (rule hoare_seq_ext[OF _ stateAssert_sp])+
     apply (simp only: return_bind, simp)
-    apply (rule hoare_seq_ext[where B="\<lambda>rv s. invs_no_cicd' s \<and> rv = ksCurDomain s"])
+    apply (rule hoare_seq_ext[where B="\<lambda>rv s. invs_no_cicd' s \<and> rv = ksCurDomain s
+                                              \<and> ksReadyQueues_asrt s \<and> ready_qs_runnable s"])
      apply (rule_tac B="\<lambda>rv s. invs_no_cicd' s \<and> curdom = ksCurDomain s \<and>
-                               rv = ksReadyQueuesL1Bitmap s curdom" in hoare_seq_ext)
+                               rv = ksReadyQueuesL1Bitmap s curdom \<and>
+                               ksReadyQueues_asrt s \<and> ready_qs_runnable s" in hoare_seq_ext)
       apply (rename_tac l1)
       apply (case_tac "l1 = 0")
        (* switch to idle thread *)
@@ -2110,7 +2090,10 @@ proof -
       (* we have a thread to switch to *)
       apply (clarsimp simp: bitmap_fun_defs)
       apply (wp assert_inv)
-      apply (clarsimp dest!: invs_no_cicd'_queues simp: valid_queues_def)
+      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
@@ -2260,12 +2243,20 @@ crunch sch_act_sane: setThreadState, setBoundNotification "sch_act_sane"
   (simp: crunch_simps wp: crunch_wps)
 
 lemma possibleSwitchTo_corres:
-  "corres dc (valid_etcbs and weak_valid_sched_action and cur_tcb and st_tcb_at runnable t)
-    (Invariants_H.valid_queues and valid_queues' and
-    (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and cur_tcb' and tcb_at' t and st_tcb_at' runnable' t and valid_objs')
-      (possible_switch_to t)
-      (possibleSwitchTo t)"
+  "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 (rule corres_split[OF curDomain_corres], simp)
@@ -2274,21 +2265,21 @@ lemma possibleSwitchTo_corres:
          apply (clarsimp simp: etcb_relation_def)
         apply (rule corres_split[OF getSchedulerAction_corres])
           apply (rule corres_if, simp)
-           apply (rule tcbSchedEnqueue_corres)
+           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)
-            apply (wp rescheduleRequired_valid_queues'_weak)+
+             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 (fastforce simp: valid_sched_def invs_def valid_state_def cur_tcb_def
+   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 (simp add: tcb_at_is_etcb_at)
+  apply (fastforce simp: tcb_at_is_etcb_at)
   done
 
 end
diff --git a/proof/refine/ARM/StateRelation.thy b/proof/refine/ARM/StateRelation.thy
index 31c0ffb48f..2734b5ba88 100644
--- a/proof/refine/ARM/StateRelation.thy
+++ b/proof/refine/ARM/StateRelation.thy
@@ -20,6 +20,10 @@ where
 
 lemmas cte_map_def' = cte_map_def[simplified cte_level_bits_def, simplified]
 
+lemma cte_map_def2:
+  "cte_map \<equiv> \<lambda>(oref, cref). oref + (of_bl cref << cte_level_bits)"
+  by (simp add: cte_map_def word_shift_by_n)
+
 definition
   lookup_failure_map :: "ExceptionTypes_A.lookup_failure \<Rightarrow> Fault_H.lookup_failure"
 where
@@ -192,13 +196,20 @@ where
   \<and> tcb_bound_notification tcb = tcbBoundNotification tcb'
   \<and> tcb_mcpriority tcb = tcbMCP tcb'"
 
+\<comment> \<open>
+  A pair of objects @{term "(obj, obj')"} should satisfy the following relation when, under further
+  mild assumptions, a @{term corres_underlying} lemma for @{term "set_object obj"}
+  and @{term "setObject obj'"} can be stated: see setObject_other_corres in KHeap_R.
+
+  TCBs do not satisfy this relation because the tcbSchedPrev and tcbSchedNext fields of a TCB are
+  used to model the ready queues, and so an update to such a field would correspond to an update
+  to a ready queue (see ready_queues_relation below).\<close>
 definition
   other_obj_relation :: "Structures_A.kernel_object \<Rightarrow> Structures_H.kernel_object \<Rightarrow> bool"
 where
   "other_obj_relation obj obj' \<equiv>
   (case (obj, obj') of
-        (TCB tcb, KOTCB tcb') \<Rightarrow> tcb_relation tcb tcb'
-      | (Endpoint ep, KOEndpoint ep') \<Rightarrow> ep_relation ep ep'
+        (Endpoint ep, KOEndpoint ep') \<Rightarrow> ep_relation ep ep'
       | (Notification ntfn, KONotification ntfn') \<Rightarrow> ntfn_relation ntfn ntfn'
       | (ArchObj (ARM_A.ASIDPool pool), KOArch (KOASIDPool pool'))
              \<Rightarrow> asid_pool_relation pool pool'
@@ -277,6 +288,12 @@ where
 | "aobj_relation_cuts (PageDirectory pd) x =
      (\<lambda>y. (x + (ucast y << 2), pde_relation y)) ` UNIV"
 
+definition tcb_relation_cut :: "Structures_A.kernel_object \<Rightarrow> kernel_object \<Rightarrow> bool" where
+  "tcb_relation_cut obj obj' \<equiv>
+   case (obj, obj') of
+       (TCB t, KOTCB t') \<Rightarrow> tcb_relation t t'
+     | _ \<Rightarrow> False"
+
 primrec
   obj_relation_cuts :: "Structures_A.kernel_object \<Rightarrow> word32 \<Rightarrow> obj_relation_cuts"
 where
@@ -284,7 +301,7 @@ where
      (if well_formed_cnode_n sz cs
       then {(cte_map (x, y), cte_relation y) | y. y \<in> dom cs}
       else {(x, \<bottom>\<bottom>)})"
-| "obj_relation_cuts (TCB tcb) x = {(x, other_obj_relation)}"
+| "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 (ArchObj ao) x = aobj_relation_cuts ao x"
@@ -295,6 +312,7 @@ 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>)}
+             | TCB tcb \<Rightarrow> {(x, tcb_relation_cut)}
              | ArchObj (PageTable pt) \<Rightarrow> (\<lambda>y. (x + (ucast y << 2), pte_relation y))
                                            ` (UNIV :: word8 set)
              | ArchObj (PageDirectory pd) \<Rightarrow> (\<lambda>y. (x + (ucast y << 2), pde_relation y))
@@ -309,6 +327,7 @@ lemma obj_relation_cuts_def3:
   "obj_relation_cuts ko x =
   (case (a_type ko) of
      ACapTable n \<Rightarrow> {(cte_map (x, y), cte_relation y) | y. length y = n}
+   | ATCB \<Rightarrow> {(x, tcb_relation_cut)}
    | AArch APageTable \<Rightarrow> (\<lambda>y. (x + (ucast y << 2), pte_relation y))
                             ` (UNIV :: word8 set)
    | AArch APageDirectory \<Rightarrow> (\<lambda>y. (x + (ucast y << 2), pde_relation y))
@@ -327,6 +346,7 @@ definition
  "is_other_obj_relation_type tp \<equiv>
   case tp of
      ACapTable n \<Rightarrow> False
+   | ATCB \<Rightarrow> False
    | AArch APageTable \<Rightarrow> False
    | AArch APageDirectory \<Rightarrow> False
    | AArch (AUserData _)   \<Rightarrow> False
@@ -338,6 +358,10 @@ 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_TCB:
+  "\<not> is_other_obj_relation_type ATCB"
+  by (simp add: is_other_obj_relation_type_def)
+
 lemma is_other_obj_relation_type_UserData:
   "\<not> is_other_obj_relation_type (AArch (AUserData sz))"
   unfolding is_other_obj_relation_type_def by simp
@@ -385,11 +409,55 @@ where
   "sched_act_relation choose_new_thread a' = (a' = ChooseNewThread)" |
   "sched_act_relation (switch_thread x) a' = (a' = SwitchToThread x)"
 
-definition
-  ready_queues_relation :: "(Deterministic_A.domain \<Rightarrow> Structures_A.priority \<Rightarrow> Deterministic_A.ready_queue)
-                         \<Rightarrow> (domain \<times> priority \<Rightarrow> KernelStateData_H.ready_queue) \<Rightarrow> bool"
-where
-  "ready_queues_relation qs qs' \<equiv> \<forall>d p. (qs d p = qs' (d, p))"
+definition queue_end_valid :: "obj_ref list \<Rightarrow> tcb_queue \<Rightarrow> bool" where
+  "queue_end_valid ts q \<equiv>
+     (ts = [] \<longrightarrow> tcbQueueEnd q = None) \<and> (ts \<noteq> [] \<longrightarrow> tcbQueueEnd q = Some (last ts))"
+
+definition prev_queue_head :: "tcb_queue \<Rightarrow> (obj_ref \<rightharpoonup> 'a) \<Rightarrow> bool" where
+  "prev_queue_head q prevs \<equiv> \<forall>head. tcbQueueHead q = Some head \<longrightarrow> prevs head = None"
+
+lemma prev_queue_head_heap_upd:
+  "\<lbrakk>prev_queue_head q prevs; Some r \<noteq> tcbQueueHead q\<rbrakk> \<Longrightarrow> prev_queue_head q (prevs(r := x))"
+  by (clarsimp simp: prev_queue_head_def)
+
+definition list_queue_relation ::
+  "obj_ref list \<Rightarrow> tcb_queue \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> bool"
+  where
+  "list_queue_relation ts q nexts prevs \<equiv>
+     heap_ls nexts (tcbQueueHead q) ts \<and> queue_end_valid ts q \<and> prev_queue_head q prevs"
+
+lemma list_queue_relation_nil:
+  "list_queue_relation ts q nexts prevs \<Longrightarrow> ts = [] \<longleftrightarrow> tcbQueueEmpty q"
+  by (fastforce dest: heap_path_head simp: tcbQueueEmpty_def list_queue_relation_def)
+
+definition ready_queue_relation ::
+  "Deterministic_A.domain \<Rightarrow> Structures_A.priority
+   \<Rightarrow> Deterministic_A.ready_queue \<Rightarrow> ready_queue
+   \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref)
+   \<Rightarrow> (obj_ref \<Rightarrow> bool) \<Rightarrow> bool"
+  where
+  "ready_queue_relation d p q q' nexts prevs flag \<equiv>
+     list_queue_relation q q' nexts prevs
+     \<and> (\<forall>t. flag t \<longleftrightarrow> t \<in> set q)
+     \<and> (d > maxDomain \<or> p > maxPriority \<longrightarrow> tcbQueueEmpty q')"
+
+definition ready_queues_relation_2 ::
+  "(Deterministic_A.domain \<Rightarrow> Structures_A.priority \<Rightarrow> Deterministic_A.ready_queue)
+   \<Rightarrow> (domain \<times> priority \<Rightarrow> ready_queue)
+   \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref)
+   \<Rightarrow> (domain \<Rightarrow> priority \<Rightarrow> obj_ref \<Rightarrow> bool) \<Rightarrow> bool"
+  where
+  "ready_queues_relation_2 qs qs' nexts prevs inQs \<equiv>
+     \<forall>d p. let q = qs d p; q' = qs' (d, p); flag = inQs d p in
+           ready_queue_relation d p q q' nexts prevs flag"
+
+abbreviation ready_queues_relation :: "det_state \<Rightarrow> kernel_state \<Rightarrow> bool" where
+  "ready_queues_relation s s' \<equiv>
+     ready_queues_relation_2
+      (ready_queues s) (ksReadyQueues s') (tcbSchedNexts_of s') (tcbSchedPrevs_of s')
+      (\<lambda>d p. inQ d p |< tcbs_of' s')"
+
+lemmas ready_queues_relation_def = ready_queues_relation_2_def
 
 definition
   ghost_relation :: "Structures_A.kheap \<Rightarrow> (word32 \<rightharpoonup> vmpage_size) \<Rightarrow> (word32 \<rightharpoonup> nat) \<Rightarrow> bool"
@@ -463,6 +531,8 @@ lemma obj_relation_cutsE:
      \<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>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);
                               ko' = KOArch (KOPTE pte'); pte_relation_aligned z (pt z) pte' \<rbrakk>
               \<Longrightarrow> R;
@@ -473,12 +543,12 @@ lemma obj_relation_cutsE:
               y = x + n * 2 ^ pageBits; n < 2 ^ (pageBitsForSize sz - pageBits) \<rbrakk> \<Longrightarrow> R;
             \<lbrakk> y = x; other_obj_relation ko ko'; is_other_obj_relation_type (a_type ko) \<rbrakk> \<Longrightarrow> R
     \<rbrakk> \<Longrightarrow> R"
-  apply (simp add: obj_relation_cuts_def2 is_other_obj_relation_type_def
+  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)
-    apply ((clarsimp split: if_splits,
-                force simp: cte_relation_def pte_relation_def pde_relation_def)+)[5]
+                   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:
@@ -554,7 +624,7 @@ where
          pspace_relation (kheap s) (ksPSpace s')
        \<and> ekheap_relation (ekheap s) (ksPSpace s')
        \<and> sched_act_relation (scheduler_action s) (ksSchedulerAction s')
-       \<and> ready_queues_relation (ready_queues s) (ksReadyQueues s')
+       \<and> ready_queues_relation s 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')
@@ -576,6 +646,10 @@ lemma curthread_relation:
   "(a, b) \<in> state_relation \<Longrightarrow> ksCurThread b = cur_thread a"
   by (simp add: state_relation_def)
 
+lemma curdomain_relation[elim!]:
+  "(s, s') \<in> state_relation \<Longrightarrow> cur_domain s = ksCurDomain s'"
+  by (clarsimp simp: state_relation_def)
+
 lemma state_relation_pspace_relation[elim!]:
   "(s,s') \<in> state_relation \<Longrightarrow> pspace_relation (kheap s) (ksPSpace s')"
   by (simp add: state_relation_def)
@@ -584,12 +658,24 @@ lemma state_relation_ekheap_relation[elim!]:
   "(s,s') \<in> state_relation \<Longrightarrow> ekheap_relation (ekheap s) (ksPSpace s')"
   by (simp add: state_relation_def)
 
+lemma state_relation_sched_act_relation[elim!]:
+  "(s,s') \<in> state_relation \<Longrightarrow> sched_act_relation (scheduler_action s) (ksSchedulerAction s')"
+  by (clarsimp simp: state_relation_def)
+
+lemma state_relation_ready_queues_relation[elim!]:
+  "(s, s') \<in> state_relation \<Longrightarrow> ready_queues_relation s s'"
+  by (simp add: state_relation_def)
+
+lemma state_relation_idle_thread[elim!]:
+  "(s, s') \<in> state_relation \<Longrightarrow> idle_thread s = ksIdleThread s'"
+  by (clarsimp simp: state_relation_def)
+
 lemma state_relationD:
   assumes sr:  "(s, s') \<in> state_relation"
   shows "pspace_relation (kheap s) (ksPSpace s') \<and>
   ekheap_relation (ekheap s) (ksPSpace s') \<and>
   sched_act_relation (scheduler_action s) (ksSchedulerAction s') \<and>
-  ready_queues_relation (ready_queues s) (ksReadyQueues s') \<and>
+  ready_queues_relation s 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>
@@ -611,7 +697,7 @@ lemma state_relationE [elim?]:
   and rl: "\<lbrakk>pspace_relation (kheap s) (ksPSpace s');
   ekheap_relation (ekheap s) (ksPSpace s');
   sched_act_relation (scheduler_action s) (ksSchedulerAction s');
-  ready_queues_relation (ready_queues s) (ksReadyQueues s');
+  ready_queues_relation s 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');
diff --git a/proof/refine/ARM/Syscall_R.thy b/proof/refine/ARM/Syscall_R.thy
index 6f8a7b6e96..1a1cb85d11 100644
--- a/proof/refine/ARM/Syscall_R.thy
+++ b/proof/refine/ARM/Syscall_R.thy
@@ -341,16 +341,14 @@ lemma threadSet_tcbDomain_update_sch_act_wf[wp]:
 
 lemma setDomain_corres:
   "corres dc
-     (valid_etcbs and valid_sched and tcb_at tptr)
-     (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)"
+     (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 corres_guard_imp)
     apply (rule corres_split[OF getCurThread_corres])
-      apply (rule corres_split[OF tcbSchedDequeue_corres])
+      apply (rule corres_split[OF tcbSchedDequeue_corres], simp)
         apply (rule corres_split)
            apply (rule ethread_set_corres; simp)
            apply (clarsimp simp: etcb_relation_def)
@@ -359,26 +357,38 @@ lemma setDomain_corres:
             apply (rule corres_split)
                apply clarsimp
                apply (rule corres_when[OF refl])
-               apply (rule tcbSchedEnqueue_corres)
+               apply (rule tcbSchedEnqueue_corres, simp)
               apply (rule corres_when[OF refl])
               apply (rule rescheduleRequired_corres)
-             apply ((wp hoare_drop_imps hoare_vcg_conj_lift | clarsimp| assumption)+)[5]
-        apply clarsimp
-        apply (rule_tac Q="\<lambda>_. valid_objs' and valid_queues' and valid_queues and
-          (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and tcb_at' tptr"
-          in hoare_strengthen_post[rotated])
-         apply (auto simp: invs'_def valid_state'_def sch_act_wf_weak st_tcb_at'_def o_def)[1]
-        apply (wp threadSet_valid_objs' threadSet_valid_queues'_no_state
-          threadSet_valid_queues_no_state
-          threadSet_pred_tcb_no_state | simp)+
-      apply (rule_tac Q = "\<lambda>r s. invs' s \<and> (\<forall>p. tptr \<notin> set (ksReadyQueues s p)) \<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)
-       apply (drule(1) bspec)
-       apply (clarsimp simp:tcb_cte_cases_def)
+             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 Tcb_R.tcbSchedDequeue_not_in_queue)+
+      apply (wp hoare_vcg_all_lift tcbSchedDequeue_not_queued)+
    apply clarsimp
    apply (frule tcb_at_is_etcb_at)
     apply simp+
@@ -447,7 +457,7 @@ lemma performInvocation_corres:
         apply (rule corres_split[OF setDomain_corres])
           apply (rule corres_trivial, simp)
          apply (wp)+
-       apply (clarsimp+)[2]
+       apply (fastforce+)[2]
      \<comment> \<open>CNodes\<close>
      apply clarsimp
      apply (rule corres_guard_imp)
@@ -757,90 +767,71 @@ 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>rv. invs'\<rbrace>"
+   doReplyTransfer t' t slot grant
+   \<lbrace>\<lambda>_. invs'\<rbrace>"
   apply (simp add: doReplyTransfer_def liftM_def)
   apply (rule hoare_seq_ext [OF _ gts_sp'])
   apply (rule hoare_seq_ext [OF _ assert_sp])
   apply (rule hoare_seq_ext [OF _ getCTE_sp])
   apply (wp, wpc)
-        apply (wp)
+        apply wp
           apply (wp (once) sts_invs_minor'')
-          apply (simp)
+          apply simp
           apply (wp (once) sts_st_tcb')
-          apply (wp)[1]
-         apply (rule_tac Q="\<lambda>rv s. invs' s
-                                   \<and> t \<noteq> ksIdleThread s
-                                   \<and> st_tcb_at' awaiting_reply' t s"
+          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 (frule_tac t=t in invs'_not_runnable_not_queued)
-           apply (erule pred_tcb'_weakenE, case_tac st, clarsimp+)
+          apply clarsimp
           apply (rule conjI, erule pred_tcb'_weakenE, case_tac st, clarsimp+)
-          apply (rule conjI, rule impI, erule pred_tcb'_weakenE, case_tac st)
-                  apply (clarsimp | drule(1) obj_at_conj')+
           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 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 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])
+                               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 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>rv 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 (frule_tac t=t in invs'_not_runnable_not_queued)
-               apply (erule pred_tcb'_weakenE, case_tac st, clarsimp+)
+             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 (rule conjI, rule impI, erule pred_tcb'_weakenE, case_tac st)
-                      apply (clarsimp | drule(1) obj_at_conj')+
               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 clarsimp
               apply (erule_tac P="\<lambda>st. awaiting_reply' st \<and> activatable' st"
-                      in pred_tcb'_weakenE)
+                            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 clarsimp
             apply (rule conjI)
-             apply (clarsimp simp: invs'_def valid_state'_def valid_idle'_def)
-             apply (rule conjI)
-              apply clarsimp
-             apply (clarsimp simp: obj_at'_def idle_tcb'_def pred_tcb_at'_def)
+             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 (rule conjI)
              apply (clarsimp simp : invs'_def valid_state'_def valid_idle'_def pred_tcb_at'_def
                                     obj_at'_def idle_tcb'_def)
-            apply (rule conjI)
-             apply clarsimp
-             apply (frule invs'_not_runnable_not_queued)
-              apply (erule pred_tcb'_weakenE, clarsimp)
-             apply (frule (1) not_tcbQueued_not_ksQ)
-             apply simp
-            apply clarsimp
            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)
@@ -850,35 +841,9 @@ lemma ct_active_runnable' [simp]:
   "ct_active' s \<Longrightarrow> ct_in_state' runnable' s"
   by (fastforce simp: ct_in_state'_def elim!: pred_tcb'_weakenE)
 
-lemma valid_irq_node_tcbSchedEnqueue[wp]:
-  "\<lbrace>\<lambda>s. valid_irq_node' (irq_node' s) s \<rbrace> tcbSchedEnqueue ptr
-  \<lbrace>\<lambda>rv s'. valid_irq_node' (irq_node' s') s'\<rbrace>"
-  apply (rule hoare_pre)
-  apply (simp add:valid_irq_node'_def )
-  apply (wp unless_wp hoare_vcg_all_lift | wps)+
-  apply (simp add:tcbSchedEnqueue_def)
-  apply (wp unless_wp| simp)+
-  apply (simp add:valid_irq_node'_def)
-  done
-
-lemma rescheduleRequired_valid_queues_but_ct_domain:
-  "\<lbrace>\<lambda>s. Invariants_H.valid_queues s \<and> valid_objs' s
-     \<and> (\<forall>x. ksSchedulerAction s = SwitchToThread x \<longrightarrow> st_tcb_at' runnable' x s) \<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | wpc | simp)+
-  done
-
-lemma rescheduleRequired_valid_queues'_but_ct_domain:
-  "\<lbrace>\<lambda>s. valid_queues' s
-     \<and> (\<forall>x. ksSchedulerAction s = SwitchToThread x \<longrightarrow> st_tcb_at' runnable' x s)
-   \<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | wpc | simp | fastforce simp: valid_queues'_def)+
-  done
+crunches tcbSchedEnqueue
+  for valid_irq_node[wp]: "\<lambda>s. valid_irq_node' (irq_node' s) s"
+  (rule: valid_irq_node_lift)
 
 lemma tcbSchedEnqueue_valid_action:
   "\<lbrace>\<lambda>s. \<forall>x. ksSchedulerAction s = SwitchToThread x \<longrightarrow> st_tcb_at' runnable' x s\<rbrace>
@@ -889,9 +854,10 @@ lemma tcbSchedEnqueue_valid_action:
   done
 
 abbreviation (input) "all_invs_but_sch_extra \<equiv>
-    \<lambda>s. valid_pspace' s \<and> Invariants_H.valid_queues s \<and>
+    \<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>
@@ -903,7 +869,6 @@ abbreviation (input) "all_invs_but_sch_extra \<equiv>
     valid_machine_state' s \<and>
     cur_tcb' s \<and>
     untyped_ranges_zero' s \<and>
-    valid_queues' 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)"
@@ -913,18 +878,13 @@ 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 (rule hoare_pre)
-  apply (wp add:rescheduleRequired_ct_not_inQ
-    rescheduleRequired_sch_act'
-    rescheduleRequired_valid_queues_but_ct_domain
-    rescheduleRequired_valid_queues'_but_ct_domain
-    valid_irq_node_lift valid_irq_handlers_lift''
-    irqs_masked_lift cur_tcb_lift)
+  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 (\<lambda>s. (\<forall>p. t \<notin> set (ksReadyQueues s p))) and
+  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
@@ -932,7 +892,7 @@ lemma threadSet_all_invs_but_sch_extra:
   apply (rule hoare_gen_asm)
   apply (rule hoare_pre)
   apply (wp threadSet_valid_pspace'T_P[where P = False and Q = \<top> and Q' = \<top>])
-  apply (simp add:tcb_cte_cases_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>]
@@ -944,13 +904,11 @@ lemma threadSet_all_invs_but_sch_extra:
      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
-     | simp add:tcb_cte_cases_def cteCaps_of_def o_def)+
+     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)
@@ -977,9 +935,7 @@ lemma setDomain_invs':
       \<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 (erule st_tcb_ex_cap'')
        apply simp
-      apply (case_tac st,simp_all)[1]
      apply (rule hoare_strengthen_post[OF hoare_vcg_conj_lift])
        apply (rule threadSet_all_invs_but_sch_extra)
       prefer 2
@@ -997,17 +953,14 @@ lemma setDomain_invs':
   done
 
 lemma performInv_invs'[wp]:
-  "\<lbrace>invs' and sch_act_simple
-          and (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))
-          and ct_active' and valid_invocation' i\<rbrace>
-     RetypeDecls_H.performInvocation block call i \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  "\<lbrace>invs' and sch_act_simple and ct_active' and valid_invocation' i\<rbrace>
+   RetypeDecls_H.performInvocation block call i
+   \<lbrace>\<lambda>_. invs'\<rbrace>"
   unfolding performInvocation_def
   apply (cases i)
-  apply ((clarsimp simp: simple_sane_strg sch_act_simple_def
-                         ct_not_ksQ sch_act_sane_def
-                  | wp tcbinv_invs' arch_performInvocation_invs'
-                       setDomain_invs'
-                  | rule conjI | erule active_ex_cap')+)
+  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]:
@@ -1192,16 +1145,18 @@ crunch valid_duplicates'[wp]: addToBitmap "\<lambda>s. vs_valid_duplicates' (ksP
   (wp: setObject_ksInterrupt updateObject_default_inv)
 
 lemma tcbSchedEnqueue_valid_duplicates'[wp]:
- "\<lbrace>\<lambda>s. vs_valid_duplicates' (ksPSpace s)\<rbrace>
-  tcbSchedEnqueue a \<lbrace>\<lambda>rv s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
-  by (simp add:tcbSchedEnqueue_def unless_def setQueue_def | wp | wpc)+
+ "tcbSchedEnqueue tcbPtr \<lbrace>\<lambda>s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
+  by (wpsimp simp: tcbSchedEnqueue_def tcbQueuePrepend_def unless_def setQueue_def)
 
 crunch valid_duplicates'[wp]: rescheduleRequired "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
   (wp: setObject_ksInterrupt updateObject_default_inv)
 
 crunch valid_duplicates'[wp]: setThreadState "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
 
-(*FIXME: move to Nondet_VCG.valid_validE_R *)
+crunches reply_from_kernel
+  for pspace_aligned[wp]: pspace_aligned
+  and pspace_distinct[wp]: pspace_distinct
+
 lemma handleInvocation_corres:
   "c \<longrightarrow> b \<Longrightarrow>
    corres (dc \<oplus> dc)
@@ -1233,11 +1188,9 @@ lemma handleInvocation_corres:
                 apply wp[1]
                apply (clarsimp simp: when_def)
                apply (rule replyFromKernel_corres)
-              apply (rule corres_split[OF setThreadState_corres])
-                 apply simp
-                apply (rule corres_splitEE)
-                   apply (rule performInvocation_corres; simp)
-                  apply simp
+              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]
@@ -1248,13 +1201,9 @@ lemma handleInvocation_corres:
                       apply simp
                      apply (simp add: when_def)
                      apply (rule conjI, rule impI)
-                      apply (rule reply_from_kernel_tcb_at)
+                      apply (wp reply_from_kernel_tcb_at)
                      apply (rule impI, wp+)
-                 apply simp+
-                 apply (wp hoare_drop_imps)+
-                apply simp
-                apply wp
-               apply simp
+                     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"
@@ -1270,7 +1219,6 @@ lemma handleInvocation_corres:
                                       and (\<lambda>s. vs_valid_duplicates' (ksPSpace s))"
                          in hoare_post_imp)
                apply (clarsimp simp: ct_in_state'_def)
-               apply (frule(1) ct_not_ksQ)
                apply (clarsimp)
               apply (wp setThreadState_nonqueued_state_update
                         setThreadState_st_tcb setThreadState_rct)[1]
@@ -1280,19 +1228,19 @@ lemma handleInvocation_corres:
                     | rule hoare_vcg_E_elim)+
    apply (clarsimp simp: tcb_at_invs invs_valid_objs
                          valid_tcb_state_def ct_in_state_def
-                         simple_from_active invs_mdb)
-   apply (clarsimp simp: msg_max_length_def word_bits_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)
   apply (frule tcb_at_invs')
   apply (clarsimp simp: invs'_def valid_state'_def
                         ct_in_state'_def ct_not_inQ_def)
-  apply (frule(1) valid_queues_not_tcbQueued_not_ksQ)
   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 (frule (1) st_tcb_at_idle_thread')
   apply (simp)
   done
 
@@ -1349,11 +1297,8 @@ lemma hinv_invs'[wp]:
                                 and st_tcb_at' active' thread"
                   in hoare_post_imp)
         apply (clarsimp simp: ct_in_state'_def)
-        apply (frule(1) ct_not_ksQ)
-        apply (clarsimp)
        apply (wp sts_invs_minor' setThreadState_st_tcb setThreadState_rct | simp)+
     apply (clarsimp)
-    apply (frule(1) ct_not_ksQ)
     apply (fastforce simp add: tcb_at_invs' ct_in_state'_def
                               simple_sane_strg
                               sch_act_simple_def
@@ -1498,7 +1443,6 @@ lemma handleRecv_isBlocking_corres':
                     and (\<lambda>s. ex_nonz_cap_to (cur_thread s) s))
               (invs' and ct_in_state' simple'
                      and sch_act_sane
-                     and (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))
                      and (\<lambda>s. ex_nonz_cap_to' (ksCurThread s) s))
                     (handle_recv isBlocking) (handleRecv isBlocking)"
   (is "corres dc (?pre1) (?pre2) (handle_recv _) (handleRecv _)")
@@ -1561,8 +1505,7 @@ lemma handleRecv_isBlocking_corres':
 
 lemma handleRecv_isBlocking_corres:
   "corres dc (einvs and ct_active)
-             (invs' and ct_active' and sch_act_sane and
-                    (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)))
+             (invs' and ct_active' and sch_act_sane)
             (handle_recv isBlocking) (handleRecv isBlocking)"
   apply (rule corres_guard_imp)
     apply (rule handleRecv_isBlocking_corres')
@@ -1577,42 +1520,27 @@ lemma lookupCap_refs[wp]:
   "\<lbrace>invs'\<rbrace> lookupCap t ref \<lbrace>\<lambda>rv s. \<forall>r\<in>zobj_refs' rv. ex_nonz_cap_to' r s\<rbrace>,-"
   by (simp add: lookupCap_def split_def | wp | simp add: o_def)+
 
-lemma deleteCallerCap_ksQ_ct':
-  "\<lbrace>invs' and ct_in_state' simple' and sch_act_sane and
-     (\<lambda>s. ksCurThread s \<notin> set (ksReadyQueues s p) \<and> thread = ksCurThread s)\<rbrace>
-      deleteCallerCap thread
-   \<lbrace>\<lambda>rv s. thread \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (rule_tac Q="\<lambda>rv s. thread = ksCurThread s \<and> ksCurThread s \<notin> set (ksReadyQueues s p)"
-            in hoare_strengthen_post)
-   apply (wp deleteCallerCap_ct_not_ksQ)
-    apply auto
-  done
-
 lemma hw_invs'[wp]:
   "\<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)
-          and (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))\<rbrace>
+          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
-                           deleteCallerCap_ksQ_ct'
                            hoare_lift_Pf2[OF deleteCallerCap_simple
                            deleteCallerCap_ct']
                       | wpc | simp)+)[1]
                apply simp
                apply (wp deleteCallerCap_nonz_cap hoare_vcg_all_lift
-                         deleteCallerCap_ksQ_ct'
                          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> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))
                              \<and> thread = ksCurThread s
                              \<and> ct_in_state' simple' s
                              \<and> ex_nonz_cap_to' thread s
@@ -1636,34 +1564,45 @@ lemma setSchedulerAction_obj_at'[wp]:
   by (wp, clarsimp elim!: obj_at'_pspaceI)
 
 lemma handleYield_corres:
-  "corres dc einvs (invs' and ct_active' and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)) handle_yield handleYield"
+  "corres dc
+     (einvs and ct_active)
+     (invs' and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread))
+     handle_yield handleYield"
   apply (clarsimp simp: handle_yield_def handleYield_def)
   apply (rule corres_guard_imp)
     apply (rule corres_split[OF getCurThread_corres])
       apply simp
-      apply (rule corres_split[OF tcbSchedDequeue_corres])
-        apply (rule corres_split[OF tcbSchedAppend_corres])
+      apply (rule corres_split[OF tcbSchedDequeue_corres], simp)
+        apply (rule corres_split[OF tcbSchedAppend_corres], simp)
           apply (rule rescheduleRequired_corres)
-         apply (wp weak_sch_act_wf_lift_linear tcbSchedDequeue_valid_queues | simp add: )+
-   apply (simp add: invs_def valid_sched_def valid_sched_action_def
-                cur_tcb_def tcb_at_is_etcb_at)
-  apply clarsimp
-  apply (frule ct_active_runnable')
-  apply (clarsimp simp: invs'_def valid_state'_def ct_in_state'_def sch_act_wf_weak cur_tcb'_def
+         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)
-  apply (erule(1) valid_objs_valid_tcbE[OF valid_pspace_valid_objs'])
-  apply (simp add:valid_tcb'_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 hy_invs':
   "\<lbrace>invs' and ct_active'\<rbrace> handleYield \<lbrace>\<lambda>r. invs' and ct_active'\<rbrace>"
   apply (simp add: handleYield_def)
-  apply (wp ct_in_state_thread_state_lift'
-            rescheduleRequired_all_invs_but_ct_not_inQ
-            tcbSchedAppend_invs_but_ct_not_inQ' | simp)+
-  apply (clarsimp simp add: 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
-                   )
+  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
 
@@ -1866,7 +1805,7 @@ 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 haskell_assert_wp doReplyTransfer_sane getCTE_wp'| wpc)+
+   apply (wp doReplyTransfer_sane getCTE_wp'| wpc)+
   apply (clarsimp simp: cte_wp_at_ctes_of)
   done
 
@@ -1882,74 +1821,6 @@ lemma handleReply_nonz_cap_to_ct:
 
 crunch ksQ[wp]: handleFaultReply "\<lambda>s. P (ksReadyQueues s p)"
 
-lemma doReplyTransfer_ct_not_ksQ:
-  "\<lbrace> invs' and sch_act_simple
-           and tcb_at' thread and tcb_at' word
-           and ct_in_state' simple'
-           and (\<lambda>s. ksCurThread s \<noteq> word)
-           and (\<lambda>s. \<forall>p. ksCurThread s \<notin> set(ksReadyQueues s p))\<rbrace>
-   doReplyTransfer thread word callerSlot g
-   \<lbrace>\<lambda>rv s. \<forall>p. ksCurThread s \<notin> set(ksReadyQueues s p)\<rbrace>"
-proof -
-  have astct: "\<And>t p.
-       \<lbrace>(\<lambda>s. ksCurThread s \<notin> set(ksReadyQueues s p) \<and> sch_act_sane s)
-             and (\<lambda>s. ksCurThread s \<noteq> t)\<rbrace>
-       possibleSwitchTo t \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set(ksReadyQueues s p)\<rbrace>"
-    apply (rule hoare_weaken_pre)
-     apply (wps possibleSwitchTo_ct')
-     apply (wp possibleSwitchTo_ksQ')
-    apply (clarsimp simp: sch_act_sane_def)
-    done
-  have stsct: "\<And>t st p.
-       \<lbrace>(\<lambda>s. ksCurThread s \<notin> set(ksReadyQueues s p)) and sch_act_simple\<rbrace>
-       setThreadState st t
-       \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set(ksReadyQueues s p)\<rbrace>"
-    apply (rule hoare_weaken_pre)
-     apply (wps setThreadState_ct')
-     apply (wp hoare_vcg_all_lift sts_ksQ)
-    apply (clarsimp)
-    done
-  show ?thesis
-    apply (simp add: doReplyTransfer_def)
-    apply (wp, wpc)
-            apply (wp astct stsct hoare_vcg_all_lift
-                      cteDeleteOne_ct_not_ksQ hoare_drop_imp
-                      hoare_lift_Pf2 [OF cteDeleteOne_sch_act_not cteDeleteOne_ct']
-                      hoare_lift_Pf2 [OF doIPCTransfer_pred_tcb_at' doIPCTransfer_ct']
-                      hoare_lift_Pf2 [OF doIPCTransfer_ksQ doIPCTransfer_ct']
-                      hoare_lift_Pf2 [OF threadSet_ksQ threadSet_ct]
-                      hoare_lift_Pf2 [OF handleFaultReply_ksQ handleFaultReply_ct']
-                   | simp add: ct_in_state'_def)+
-     apply (fastforce simp: sch_act_simple_def sch_act_sane_def ct_in_state'_def)+
-    done
-qed
-
-lemma handleReply_ct_not_ksQ:
-  "\<lbrace>invs' and sch_act_simple
-           and ct_in_state' simple'
-           and (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))\<rbrace>
-   handleReply
-   \<lbrace>\<lambda>rv s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: handleReply_def del: split_paired_All)
-  apply (subst haskell_assert_def)
-  apply (wp | wpc)+
-  apply (wp doReplyTransfer_ct_not_ksQ getThreadCallerSlot_inv)+
-    apply (rule_tac Q="\<lambda>cap.
-                              (\<lambda>s. \<forall>p. ksCurThread s \<notin> set(ksReadyQueues s p))
-                          and invs'
-                          and sch_act_simple
-                          and (\<lambda>s. thread = ksCurThread s)
-                          and tcb_at' thread
-                          and ct_in_state' simple'
-                          and cte_wp_at' (\<lambda>c. cteCap c = cap) callerSlot"
-             in hoare_post_imp)
-     apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def
-                           cte_wp_at_ctes_of valid_cap'_def
-                    dest!: ctes_of_valid')
-    apply (wp getSlotCap_cte_wp_at getThreadCallerSlot_inv)+
-  apply (clarsimp)
-  done
-
 crunches possible_switch_to, handle_recv
   for valid_etcbs[wp]: "valid_etcbs"
   (wp: crunch_wps simp: crunch_simps)
@@ -1963,11 +1834,10 @@ lemma handleReply_handleRecv_corres:
     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 handleReply_ct_not_ksQ handle_reply_valid_sched)+
+               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 (frule(1) ct_not_ksQ)
   apply (fastforce elim: pred_tcb'_weakenE)
   done
 
@@ -1975,7 +1845,6 @@ lemma handleHypervisorFault_corres:
   "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 (\<lambda>s. \<forall>p. thread \<notin> set(ksReadyQueues s p))
                     and st_tcb_at' simple' thread and ex_nonz_cap_to' thread)
           (handle_hypervisor_fault w fault)
           (handleHypervisorFault w fault)"
@@ -1993,14 +1862,13 @@ lemma handleEvent_corres:
   (is "?handleEvent_corres")
 proof -
   have hw:
-    "\<And>isBlocking. corres dc (einvs and ct_running and (\<lambda>s. scheduler_action s = resume_cur_thread))
+    "\<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
-                     dest!: ct_not_ksQ)+
+                     elim!: st_tcb_weakenE pred_tcb'_weakenE)+
     done
     show ?thesis
       apply (case_tac event)
@@ -2015,7 +1883,7 @@ proof -
                                      corres_guard_imp[OF handleCall_corres]
                                      corres_guard_imp[OF handleYield_corres]
                                      active_from_running active_from_running'
-                              simp: simple_sane_strg)[8]
+                              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)
@@ -2026,7 +1894,6 @@ proof -
                             simp: ct_in_state_def)
           apply wp
           apply (clarsimp)
-          apply (frule(1) ct_not_ksQ)
           apply (auto simp: ct_in_state'_def sch_act_simple_def
                             sch_act_sane_def
                       elim: pred_tcb'_weakenE st_tcb_ex_cap'')[1]
@@ -2039,12 +1906,11 @@ proof -
                            simp: ct_in_state_def valid_fault_def)
          apply wp
          apply clarsimp
-         apply (frule(1) ct_not_ksQ)
          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>rv. einvs"
+          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)
@@ -2054,7 +1920,6 @@ proof -
             apply (rule handleInterrupt_corres)
            apply (wp hoare_vcg_all_lift
                      doMachineOp_getActiveIRQ_IRQ_active'
-                    | simp
                     | simp add: imp_conjR | wp (once) hoare_drop_imps)+
         apply (simp add: invs'_def valid_state'_def)
        apply (rule_tac corres_underlying_split)
@@ -2071,7 +1936,6 @@ proof -
         apply (fastforce elim!: st_tcb_ex_cap st_tcb_weakenE simp: ct_in_state_def)
        apply wp
        apply (clarsimp)
-       apply (frule(1) ct_not_ksQ)
        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)
@@ -2083,7 +1947,6 @@ proof -
                         simp: ct_in_state_def)
       apply wp
       apply (clarsimp)
-      apply (frule(1) ct_not_ksQ)
       apply (auto simp: ct_in_state'_def sch_act_simple_def
                         sch_act_sane_def
                   elim: pred_tcb'_weakenE st_tcb_ex_cap'')[1]
@@ -2160,10 +2023,8 @@ proof -
         apply (rename_tac syscall)
         apply (case_tac syscall,
                (wp handleReply_sane handleReply_nonz_cap_to_ct handleReply_ksCurThread
-                   handleReply_ct_not_ksQ
                 | clarsimp simp: active_from_running' simple_from_running' simple_sane_strg simp del: split_paired_All
                 | rule conjI active_ex_cap'
-                | drule ct_not_ksQ[rotated]
                 | strengthen nidle)+)
         apply (rule hoare_strengthen_post,
                rule hoare_weaken_pre,
@@ -2175,7 +2036,6 @@ proof -
                  | 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'
-                 | drule ct_not_ksQ[rotated]
                  | wpc | wp (once) hoare_drop_imps)+
   done
 qed
diff --git a/proof/refine/ARM/TcbAcc_R.thy b/proof/refine/ARM/TcbAcc_R.thy
index 5dc688b212..f71e35bf68 100644
--- a/proof/refine/ARM/TcbAcc_R.thy
+++ b/proof/refine/ARM/TcbAcc_R.thy
@@ -58,10 +58,8 @@ lemma getHighestPrio_inv[wp]:
   unfolding bitmap_fun_defs by simp
 
 lemma valid_bitmapQ_bitmapQ_simp:
-  "\<lbrakk> valid_bitmapQ s \<rbrakk> \<Longrightarrow>
-   bitmapQ d p s = (ksReadyQueues s (d, p) \<noteq> [])"
-   unfolding valid_bitmapQ_def
-   by simp
+  "valid_bitmapQ s \<Longrightarrow> bitmapQ d p s = (\<not> tcbQueueEmpty (ksReadyQueues s (d, p)))"
+  by (simp add: valid_bitmapQ_def)
 
 lemma prioToL1Index_l1IndexToPrio_or_id:
   "\<lbrakk> unat (w'::priority) < 2 ^ wordRadix ; w < size w' \<rbrakk>
@@ -84,54 +82,156 @@ 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 and runnable' \<circ> tcbState) t s)
-    \<and>  distinct (ksReadyQueues s (d, p))
-    \<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
-
 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 objBits_simps)
-  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
-                        ARM_A.arch_kernel_obj.split_asm)+
-  apply fastforce
+                        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 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"
+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)
   done
 
-lemma valid_objs'_maxDomain:
-  "\<And>s t. \<lbrakk> valid_objs' s; tcb_at' t s \<rbrakk> \<Longrightarrow> obj_at' (\<lambda>tcb. tcbDomain tcb \<le> maxDomain) t s"
-  apply (erule (1) valid_objs_valid_tcbE)
-  apply (clarsimp simp: valid_tcb'_def)
+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
+  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 objBits_simps')
+  done
+
+definition valid_tcbs' :: "kernel_state \<Rightarrow> bool" where
+  "valid_tcbs' s' \<equiv> \<forall>ptr tcb. ksPSpace s' ptr = Some (KOTCB tcb) \<longrightarrow> valid_tcb' tcb s'"
+
+lemma valid_objs'_valid_tcbs'[elim!]:
+  "valid_objs' s \<Longrightarrow> valid_tcbs' s"
+  by (auto simp: valid_objs'_def valid_tcbs'_def valid_obj'_def split: kernel_object.splits)
+
+lemma invs'_valid_tcbs'[elim!]:
+  "invs' s \<Longrightarrow> valid_tcbs' s"
+  by (fastforce intro: valid_objs'_valid_tcbs')
+
+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 valid_tcb'_def projectKOs)
   done
 
-lemma valid_objs'_maxPriority:
-  "\<And>s t. \<lbrakk> valid_objs' s; tcb_at' t s \<rbrakk> \<Longrightarrow> obj_at' (\<lambda>tcb. tcbPriority tcb \<le> maxPriority) t s"
-  apply (erule (1) valid_objs_valid_tcbE)
-  apply (clarsimp simp: valid_tcb'_def)
+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 valid_tcb'_def projectKOs)
   done
 
+lemmas valid_objs'_maxPriority = valid_tcbs'_maxPriority[OF valid_objs'_valid_tcbs']
+
+lemma valid_tcbs'_obj_at':
+  assumes "valid_tcbs' 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"
+  using assms
+  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 (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"
+  "\<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_valid_tcbs'[simp]:
+  "\<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':
   assumes masks: "\<And>P. \<lbrace>\<lambda>s. P (irq_masks s)\<rbrace> f \<lbrace>\<lambda>_ s. P (irq_masks s)\<rbrace>"
   shows "\<lbrace>valid_irq_states'\<rbrace> doMachineOp f \<lbrace>\<lambda>rv. valid_irq_states'\<rbrace>"
@@ -229,56 +329,117 @@ lemma updateObject_tcb_inv:
   by simp (rule updateObject_default_inv)
 
 lemma setObject_update_TCB_corres':
-  assumes tcbs: "tcb_relation tcb tcb' \<Longrightarrow> tcb_relation tcbu tcbu'"
-  assumes tables: "\<forall>(getF, v) \<in> ran tcb_cap_cases. getF tcbu = getF tcb"
-  assumes tables': "\<forall>(getF, v) \<in> ran tcb_cte_cases. getF tcbu' = getF tcb'"
+  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"
+  assumes tables': "\<forall>(getF, v) \<in> ran tcb_cte_cases. getF new_tcb' = getF tcb'"
+  assumes sched_pointers: "tcbSchedPrev new_tcb' = tcbSchedPrev tcb'"
+                          "tcbSchedNext new_tcb' = tcbSchedNext tcb'"
+  assumes flag: "tcbQueued new_tcb' = tcbQueued tcb'"
   assumes r: "r () ()"
-  assumes exst: "exst_same tcb' tcbu'"
-  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' \<and> exst_same tcb' tcbu'" 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 exst)
-  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 () (); exst_same tcb' tcbu'\<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 fastforce
-  apply (clarsimp simp: getObject_def in_monad split_def obj_at'_def
-                        loadObject_default_def projectKOs objBits_simps'
-                        in_magnitude_check)
+    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:
-  "corres tcb_relation (tcb_at t) (tcb_at' t)
+  "corres tcb_relation (tcb_at t and pspace_aligned and pspace_distinct) \<top>
           (gets_the (get_tcb t)) (getObject t)"
+  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 (rule corres_gets_the)
     apply (rule corres_get_tcb)
@@ -288,7 +449,8 @@ 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)"
+  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
@@ -310,7 +472,8 @@ lemma ball_tcb_cte_casesI:
   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. P (Thread a b c d e f g h i j k l m n p q) \<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:
@@ -319,18 +482,24 @@ 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"
+  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)
-                        (tcb_at' t)
-                    (thread_set f t) (threadSet f' t)"
+  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 (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+
@@ -360,18 +529,20 @@ lemma threadSet_corres_noopT:
                          tcb_relation tcb (fn tcb')"
   assumes y: "\<forall>tcb. \<forall>(getF, setF) \<in> ran tcb_cte_cases.
                  getF (fn tcb) = getF tcb"
+  assumes s: "\<forall>tcb'. tcbSchedPrev (fn tcb') = tcbSchedPrev tcb'"
+             "\<forall>tcb'. tcbSchedNext (fn tcb') = tcbSchedNext tcb'"
+  assumes f: "\<And>tcb'. tcbQueued (fn tcb') = tcbQueued tcb'"
   assumes e: "\<And>tcb'. exst_same tcb' (fn tcb')"
-  shows      "corres dc \<top> (tcb_at' t)
-                           (return v) (threadSet fn t)"
+  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 (simp add: return_def thread_set_def gets_the_def
+    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 assert_def a_type_def[split_simps kernel_object.split arch_kernel_obj.split])
+                     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: get_tcb_SomeD map_upd_triv)
+     apply (simp add: map_upd_triv get_tcb_SomeD)+
     done
   show ?thesis
     apply (rule stronger_corres_guard_imp)
@@ -379,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 (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 wpsimp+
-      apply (erule pspace_relation_tcb_at[rotated])
-      apply clarsimp
-     apply simp
-    apply simp
+          apply simp
+         apply (rule no_fail_pre, wpsimp+)[1]
+        apply wpsimp+
     done
 qed
 
@@ -402,14 +574,20 @@ 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>"
+  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 P (tcb_at' t and P')
+  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)+
@@ -643,16 +821,23 @@ lemma threadSet_valid_pspace'T_P:
   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 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)\<rbrace>
-     threadSet F t
-   \<lbrace>\<lambda>rv. valid_pspace'\<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>_. valid_pspace'\<rbrace>"
   apply (simp add: valid_pspace'_def threadSet_def)
   apply (rule hoare_pre,
          wp setObject_tcb_valid_objs getObject_tcb_wp)
@@ -660,7 +845,7 @@ lemma threadSet_valid_pspace'T_P:
   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 v w')
+                            split_paired_Ball y u w v w' p n)
   done
 
 lemmas threadSet_valid_pspace'T =
@@ -734,6 +919,10 @@ lemma threadSet_iflive'T:
               \<and> tcbState (F tcb) \<noteq> Inactive
               \<and> tcbState (F tcb) \<noteq> IdleThreadState
               \<and> ko_at' tcb t s) \<longrightarrow> ex_nonz_cap_to' t s)
+      \<and> ((\<exists>tcb. tcbSchedNext tcb = None \<and> tcbSchedNext (F tcb) \<noteq> None
+              \<and> ko_at' tcb t s) \<longrightarrow> ex_nonz_cap_to' t s)
+      \<and> ((\<exists>tcb. tcbSchedPrev tcb = None \<and> tcbSchedPrev (F tcb) \<noteq> None
+              \<and> ko_at' tcb t s) \<longrightarrow> ex_nonz_cap_to' t s)
       \<and> ((\<exists>tcb. \<not> tcbQueued tcb \<and> tcbQueued (F tcb)
               \<and> ko_at' tcb t s) \<longrightarrow> ex_nonz_cap_to' t s)\<rbrace>
      threadSet F t
@@ -741,8 +930,7 @@ lemma threadSet_iflive'T:
   apply (simp add: threadSet_def)
   apply (wp setObject_tcb_iflive' getObject_tcb_wp)
   apply (clarsimp simp: obj_at'_def projectKOs)
-  apply (subst conj_assoc[symmetric], subst imp_disjL[symmetric])
-  apply (subst conj_assoc[symmetric], subst imp_disjL[symmetric])
+  apply (subst conj_assoc[symmetric], subst imp_disjL[symmetric])+
   apply (rule conjI)
    apply (rule impI, clarsimp)
    apply (erule if_live_then_nonz_capE')
@@ -788,6 +976,12 @@ lemmas threadSet_ctes_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)
+  \<Longrightarrow> threadSet f tptr \<lbrace>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 objBits_simps')
+
 lemma threadSet_idle'T:
   assumes x: "\<forall>tcb. \<forall>(getF, setF) \<in> ran tcb_cte_cases. getF (F tcb) = getF tcb"
   shows
@@ -826,30 +1020,6 @@ lemma set_tcb_bitmapQ_no_L2_orphans[wp]:
   apply (wp hoare_Ball_helper hoare_vcg_all_lift updateObject_default_inv | simp add: bitmapQ_def)+
   done
 
-lemma threadSet_valid_queues_no_bitmap:
-  "\<lbrace> valid_queues_no_bitmap and
-    (\<lambda>s. \<forall>d p. (\<exists>tcb. (inQ d p tcb \<and> runnable' (tcbState tcb)) \<and>
-                     \<not>(inQ d p (f tcb) \<and> runnable' (tcbState (f tcb))))
-                \<longrightarrow> obj_at' (\<lambda>tcb. (inQ d p tcb \<and> runnable' (tcbState tcb)) \<and>
-                                 \<not>(inQ d p (f tcb) \<and> runnable' (tcbState (f tcb)))) t s
-                \<longrightarrow> t \<notin> set (ksReadyQueues s (d, p))
-    )\<rbrace>
-     threadSet f t
-   \<lbrace>\<lambda>rv. valid_queues_no_bitmap \<rbrace>"
-  apply (simp add: threadSet_def)
-  apply wp
-   apply (simp add: Invariants_H.valid_queues_no_bitmap_def' pred_tcb_at'_def)
-
-   apply (wp setObject_queues_unchanged_tcb
-             hoare_Ball_helper
-             hoare_vcg_all_lift
-             setObject_tcb_strongest)[1]
-  apply (wp getObject_tcb_wp)
-  apply (clarsimp simp: valid_queues_no_bitmap_def' pred_tcb_at'_def)
-  apply (clarsimp simp: obj_at'_def projectKOs)
-  apply (fastforce)
-  done
-
 lemma threadSet_valid_bitmapQ[wp]:
   "\<lbrace> valid_bitmapQ \<rbrace> threadSet f t \<lbrace> \<lambda>rv. valid_bitmapQ \<rbrace>"
   unfolding bitmapQ_defs threadSet_def
@@ -868,73 +1038,6 @@ lemma threadSet_valid_bitmapQ_no_L2_orphans[wp]:
   by (clarsimp simp: setObject_def split_def)
      (wp | simp add: updateObject_default_def)+
 
-lemma threadSet_valid_queues:
-  "\<lbrace>Invariants_H.valid_queues and
-    (\<lambda>s. \<forall>d p. (\<exists>tcb. (inQ d p tcb \<and> runnable' (tcbState tcb)) \<and>
-                     \<not>(inQ d p (f tcb) \<and> runnable' (tcbState (f tcb))))
-                \<longrightarrow> obj_at' (\<lambda>tcb. (inQ d p tcb \<and> runnable' (tcbState tcb)) \<and>
-                                 \<not>(inQ d p (f tcb) \<and> runnable' (tcbState (f tcb)))) t s
-                \<longrightarrow> t \<notin> set (ksReadyQueues s (d, p))
-    )\<rbrace>
-     threadSet f t
-   \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  unfolding valid_queues_def
-  by (wp threadSet_valid_queues_no_bitmap;simp)
-
-definition
-  addToQs :: "(Structures_H.tcb \<Rightarrow> Structures_H.tcb)
-                       \<Rightarrow> word32 \<Rightarrow> (domain \<times> priority \<Rightarrow> word32 list)
-                       \<Rightarrow> (domain \<times> priority \<Rightarrow> word32 list)"
-where
- "addToQs F t \<equiv> \<lambda>qs (qdom, prio). if (\<forall>ko. \<not> inQ qdom prio (F ko))
-                             then t # qs (qdom, prio)
-                             else qs (qdom, prio)"
-
-lemma addToQs_set_def:
-  "(t' \<in> set (addToQs F t qs (qdom, prio))) = (t' \<in> set (qs (qdom, prio))
-      \<or> (t' = t \<and> (\<forall>ko. \<not> inQ qdom prio (F ko))))"
-  by (auto simp add: addToQs_def)
-
-lemma threadSet_valid_queues_addToQs:
-  "\<lbrace>\<lambda>s. (\<forall>ko qdom prio. ko_at' ko t s \<and> inQ qdom prio (F ko) \<and> \<not> inQ qdom prio ko
-            \<longrightarrow> t \<in> set (ksReadyQueues s (qdom, prio)))
-             \<and> valid_queues' (ksReadyQueues_update (addToQs F t) s)\<rbrace>
-     threadSet F t
-   \<lbrace>\<lambda>rv. 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_set_def
-             split del: if_split cong: if_cong)
-  apply (fastforce simp: projectKOs split: if_split_asm)
-  done
-
-lemma threadSet_valid_queues_Qf:
-  "\<lbrace>\<lambda>s. (\<forall>ko qdom prio. ko_at' ko t s \<and> inQ qdom prio (F ko) \<and> \<not> inQ qdom prio ko
-            \<longrightarrow> t \<in> set (ksReadyQueues s (qdom, prio)))
-             \<and> valid_queues' (ksReadyQueues_update Qf s)
-             \<and> (\<forall>prio. set (Qf (ksReadyQueues s) prio)
-                        \<subseteq> set (addToQs F t (ksReadyQueues s) prio))\<rbrace>
-     threadSet F t
-   \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (wp threadSet_valid_queues_addToQs)
-  apply (clarsimp simp: valid_queues'_def subset_iff)
-  done
-
-lemma addToQs_subset:
-  "set (qs p) \<subseteq> set (addToQs F t qs p)"
-by (clarsimp simp: addToQs_def split_def)
-
-lemmas threadSet_valid_queues'
-  = threadSet_valid_queues_Qf
-       [where Qf=id, simplified ksReadyQueues_update_id
-                                id_apply addToQs_subset simp_thms]
-
 lemma threadSet_cur:
   "\<lbrace>\<lambda>s. cur_tcb' s\<rbrace> threadSet f t \<lbrace>\<lambda>rv s. cur_tcb' s\<rbrace>"
   apply (simp add: threadSet_def cur_tcb'_def)
@@ -950,7 +1053,7 @@ lemma modifyReadyQueuesL1Bitmap_obj_at[wp]:
 
 crunches setThreadState, setBoundNotification
   for valid_arch' [wp]: valid_arch_state'
-  (simp: unless_def crunch_simps)
+  (simp: unless_def crunch_simps wp: crunch_wps)
 
 crunch ksInterrupt'[wp]: threadSet "\<lambda>s. P (ksInterruptState s)"
   (wp: setObject_ksInterrupt updateObject_default_inv)
@@ -1212,57 +1315,103 @@ lemma threadSet_valid_dom_schedule':
   unfolding threadSet_def
   by (wp setObject_ksDomSchedule_inv hoare_Ball_helper)
 
+lemma threadSet_wp:
+  "\<lbrace>\<lambda>s. \<forall>tcb. ko_at' tcb t s \<longrightarrow> P (s\<lparr>ksPSpace := (ksPSpace s)(t \<mapsto> injectKO (f tcb))\<rparr>)\<rbrace>
+   threadSet f t
+   \<lbrace>\<lambda>_. P\<rbrace>"
+  unfolding threadSet_def setObject_def
+  apply (wpsimp wp: getObject_tcb_wp simp: updateObject_default_def)
+  apply (auto simp: obj_at'_def split: if_splits)
+  apply (erule rsubst[where P=P])
+  apply (clarsimp simp: fun_upd_def)
+  apply (prop_tac "\<forall>ptr. psMap (ksPSpace s) ptr = ksPSpace s ptr")
+   apply fastforce
+  apply metis
+  done
+
+lemma threadSet_sched_pointers:
+  "\<lbrakk>\<And>tcb. tcbSchedNext (F tcb) = tcbSchedNext tcb; \<And>tcb. tcbSchedPrev (F tcb) = tcbSchedPrev tcb\<rbrakk>
+   \<Longrightarrow> threadSet F tcbPtr \<lbrace>\<lambda>s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)\<rbrace>"
+  apply (wpsimp wp: threadSet_wp getObject_tcb_wp)
+  apply (erule rsubst2[where P=P])
+   apply (fastforce simp: opt_map_def obj_at'_def projectKOs)
+  apply (fastforce simp: opt_map_def obj_at'_def projectKOs)
+  done
+
+lemma threadSet_valid_sched_pointers:
+  "\<lbrakk>\<And>tcb. tcbSchedNext (F tcb) = tcbSchedNext tcb; \<And>tcb. tcbSchedPrev (F tcb) = tcbSchedPrev tcb;
+    \<And>tcb. tcbQueued (F tcb) = tcbQueued tcb\<rbrakk>
+   \<Longrightarrow> threadSet F tcbPtr \<lbrace>valid_sched_pointers\<rbrace>"
+  unfolding valid_sched_pointers_def
+  apply (wpsimp wp: threadSet_wp getObject_tcb_wp)
+  by (fastforce simp: opt_pred_def opt_map_def obj_at'_def projectKOs split: option.splits if_splits)
+
+lemma threadSet_tcbSchedNexts_of:
+  "(\<And>tcb. tcbSchedNext (F tcb) = tcbSchedNext tcb) \<Longrightarrow>
+   threadSet F t \<lbrace>\<lambda>s. P (tcbSchedNexts_of s)\<rbrace>"
+  apply (wpsimp wp: threadSet_wp getObject_tcb_wp)
+  apply (erule rsubst[where P=P])
+  apply (fastforce simp: opt_map_def obj_at'_def projectKOs)
+  done
+
+lemma threadSet_tcbSchedPrevs_of:
+  "(\<And>tcb. tcbSchedPrev (F tcb) = tcbSchedPrev tcb) \<Longrightarrow>
+   threadSet F t \<lbrace>\<lambda>s. P (tcbSchedPrevs_of s)\<rbrace>"
+  apply (wpsimp wp: threadSet_wp getObject_tcb_wp)
+  apply (erule rsubst[where P=P])
+  apply (fastforce simp: opt_map_def obj_at'_def projectKOs)
+  done
+
+lemma threadSet_tcbQueued:
+  "(\<And>tcb. tcbQueued (F tcb) = tcbQueued tcb) \<Longrightarrow>
+   threadSet F t \<lbrace>\<lambda>s. P (tcbQueued |< tcbs_of' s)\<rbrace>"
+  apply (wpsimp wp: threadSet_wp getObject_tcb_wp)
+  apply (erule rsubst[where P=P])
+  apply (fastforce simp: opt_pred_def opt_map_def obj_at'_def projectKOs)
+  done
+
+crunches threadSet
+  for ksReadyQueues[wp]: "\<lambda>s. P (ksReadyQueues s)"
+  and ksReadyQueuesL1Bitmap[wp]: "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
+  and ksReadyQueuesL2Bitmap[wp]: "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
+
 lemma threadSet_invs_trivialT:
-  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 \<and> tcbDomain (F tcb) = tcbDomain tcb"
-  assumes w: "\<forall>tcb. is_aligned (tcbIPCBuffer tcb) msg_align_bits \<longrightarrow> is_aligned (tcbIPCBuffer (F tcb)) msg_align_bits"
-  assumes a: "\<forall>tcb. tcbBoundNotification (F tcb) = tcbBoundNotification tcb"
-  assumes w: "\<forall>tcb. is_aligned (tcbIPCBuffer tcb) msg_align_bits \<longrightarrow> is_aligned (tcbIPCBuffer (F tcb)) msg_align_bits"
-  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"
-  shows
-  "\<lbrace>\<lambda>s. invs' s \<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. \<not> tcbQueued tcb \<and> tcbQueued (F tcb)) \<longrightarrow> ex_nonz_cap_to' t s \<and> t \<noteq> ksCurThread s) \<and>
-       (\<forall>tcb. tcbQueued (F tcb) \<and> ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> tcbQueued tcb \<or> t \<noteq> ksCurThread s)\<rbrace>
-   threadSet F t
-   \<lbrace>\<lambda>rv. invs'\<rbrace>"
-proof -
-  from z have domains: "\<And>tcb. tcbDomain (F tcb) = tcbDomain tcb" by blast
-  note threadSet_sch_actT_P[where P=False, simplified]
-  have y: "\<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 valid_state'_def split del: if_split)
-    apply (rule hoare_pre)
-     apply (wp x w v u b
-              threadSet_valid_pspace'T
-              threadSet_sch_actT_P[where P=False, simplified]
-              threadSet_valid_queues
-              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_cur
-              untyped_ranges_zero_lift
-           |clarsimp simp: y z a domains cteCaps_of_def |rule refl)+
-   apply (clarsimp simp: obj_at'_def projectKOs pred_tcb_at'_def)
-   apply (clarsimp simp: cur_tcb'_def valid_irq_node'_def valid_queues'_def o_def)
-   by (fastforce simp: domains ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def z a)
-qed
+  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. is_aligned (tcbIPCBuffer tcb) msg_align_bits
+           \<longrightarrow> is_aligned (tcbIPCBuffer (F tcb)) msg_align_bits"
+    "\<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. tcbMCP tcb \<le> maxPriority \<longrightarrow> tcbMCP (F tcb) \<le> maxPriority"
+  shows "threadSet F t \<lbrace>invs'\<rbrace>"
+  apply (simp add: invs'_def valid_state'_def split del: if_split)
+  apply (wp threadSet_valid_pspace'T
+            threadSet_sch_actT_P[where P=False, simplified]
+            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_cur
+            untyped_ranges_zero_lift
+            sym_heap_sched_pointers_lift threadSet_valid_sched_pointers
+            threadSet_tcbQueued
+            threadSet_tcbSchedPrevs_of threadSet_tcbSchedNexts_of valid_bitmaps_lift
+         | clarsimp simp: assms cteCaps_of_def | rule refl)+
+  apply (clarsimp simp: o_def)
+  by (auto simp: assms obj_at'_def)
 
 lemmas threadSet_invs_trivial =
     threadSet_invs_trivialT [OF all_tcbI all_tcbI all_tcbI all_tcbI, OF ball_tcb_cte_casesI]
@@ -1302,19 +1451,84 @@ lemma threadSet_valid_objs':
   apply (clarsimp elim!: obj_at'_weakenE)
   done
 
+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']
+
+lemma setObject_valid_tcbs':
+  assumes preserve_valid_tcb': "\<And>s s' ko ko' x n tcb tcb'.
+            \<lbrakk> (ko', s') \<in> fst (updateObject val ko ptr x n s); P s;
+              lookupAround2 ptr (ksPSpace s) = (Some (x, ko), n);
+              projectKO_opt ko = Some tcb; projectKO_opt ko' = Some tcb';
+              valid_tcb' tcb s \<rbrakk> \<Longrightarrow> valid_tcb' tcb' s"
+  shows "\<lbrace>valid_tcbs' and P\<rbrace> setObject ptr val \<lbrace>\<lambda>rv. valid_tcbs'\<rbrace>"
+  unfolding valid_tcbs'_def
+  apply (clarsimp simp: valid_def)
+  apply (rename_tac s s' ptr' tcb)
+  apply (prop_tac "\<forall>tcb'. valid_tcb' tcb s \<longrightarrow> valid_tcb' tcb s'")
+   apply clarsimp
+   apply (erule (1) use_valid[OF _ setObject_valid_tcb'])
+  apply (drule spec, erule mp)
+  apply (clarsimp simp: setObject_def in_monad split_def lookupAround2_char1)
+  apply (rename_tac s ptr' new_tcb' ptr'' old_tcb_ko' s' f)
+  apply (case_tac "ptr'' = ptr'"; clarsimp)
+  apply (prop_tac "\<exists>old_tcb' :: tcb. projectKO_opt old_tcb_ko' = Some old_tcb'")
+   apply (frule updateObject_type)
+   apply (case_tac old_tcb_ko'; clarsimp simp: project_inject)
+  apply (erule exE)
+  apply (rule preserve_valid_tcb', assumption+)
+     apply (simp add: prod_eqI lookupAround2_char1)
+    apply force
+   apply (clarsimp simp: project_inject)
+  apply (clarsimp simp: project_inject)
+  done
+
+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 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>_. valid_tcb' tcb\<rbrace>"
+  apply (simp add: threadSet_def)
+  apply (wpsimp wp: setObject_valid_tcb')
+  done
+
+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>_. valid_tcbs'\<rbrace>"
+  apply (simp add: threadSet_def)
+  apply (rule hoare_seq_ext[OF _ getObject_tcb_sp])
+  apply (wpsimp wp: setObject_tcb_valid_tcbs')
+  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 objBits_simps')
+  done
+
 lemma asUser_corres':
   assumes y: "corres_underlying Id False True r \<top> \<top> f g"
-  shows      "corres r (tcb_at t)
-                       (tcb_at' t)
+  shows      "corres r (tcb_at t and pspace_aligned and pspace_distinct) \<top>
                        (as_user t f) (asUser t g)"
-  proof -
+proof -
   note arch_tcb_context_get_def[simp]
   note atcbContextGet_def[simp]
   note arch_tcb_context_set_def[simp]
   note atcbContextSet_def[simp]
   have L1: "corres (\<lambda>tcb con. (arch_tcb_context_get o tcb_arch) tcb = con)
-             (tcb_at t) (tcb_at' t)
-             (gets_the (get_tcb t)) (threadGet (atcbContextGet o tcbArch) t)"
+              (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+              (gets_the (get_tcb t)) (threadGet (atcbContextGet o tcbArch) t)"
+    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 (rule corres_gets_the)
       apply (simp add: threadGet_def)
@@ -1332,32 +1546,32 @@ lemma asUser_corres':
                      (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 exst_same_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'))"
     using y
     by (fastforce simp: corres_underlying_def select_f_def split_def Id_def)
   show ?thesis
-  apply (simp add: as_user_def asUser_def)
-  apply (rule corres_guard_imp)
-    apply (rule_tac r'="\<lambda>tcb con. (arch_tcb_context_get o tcb_arch) tcb = con"
-           in corres_split)
-       apply simp
-       apply (rule L1[simplified])
-      apply (rule corres_split)
-         apply (rule L4; simp)
-        apply clarsimp
-        apply (rule corres_split_nor)
-           apply (simp add: threadSet_def)
-           apply (rule corres_symb_exec_r)
-              prefer 4
-              apply (rule no_fail_pre_and, wp)
-             apply (rule L3[simplified])
-              apply simp
-             apply simp
-            apply (wp select_f_inv | simp)+
-  done
+    apply (rule corres_cross_over_guard[where Q="tcb_at' t"])
+     apply (fastforce simp: tcb_at_cross state_relation_def)
+    apply (simp add: as_user_def asUser_def)
+    apply (rule corres_guard_imp)
+      apply (rule_tac r'="\<lambda>tcb con. (arch_tcb_context_get o tcb_arch) tcb = con"
+              in corres_split)
+         apply simp
+         apply (rule L1[simplified])
+        apply (rule corres_split[OF L4])
+           apply simp
+          apply clarsimp
+          apply (rule corres_split_nor)
+             apply (simp add: threadSet_def)
+             apply (rule corres_symb_exec_r)
+                apply (rule L3[simplified])
+                 prefer 5
+                 apply (rule no_fail_pre_and, wp)
+                apply (wp select_f_inv | simp)+
+    done
 qed
 
 lemma asUser_corres:
@@ -1390,7 +1604,7 @@ proof -
 qed
 
 lemma asUser_getRegister_corres:
- "corres (=) (tcb_at t) (tcb_at' t)
+ "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
         (as_user t (getRegister r)) (asUser t (getRegister r))"
   apply (rule asUser_corres')
   apply (clarsimp simp: getRegister_def)
@@ -1438,14 +1652,6 @@ lemma asUser_valid_pspace'[wp]:
   apply (wp threadSet_valid_pspace' hoare_drop_imps | simp)+
   done
 
-lemma asUser_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> asUser t m \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: asUser_def split_def)
-  apply (wp hoare_drop_imps | simp)+
-
-  apply (wp threadSet_valid_queues hoare_drop_imps | simp)+
-  done
-
 lemma asUser_ifunsafe'[wp]:
   "\<lbrace>if_unsafe_then_cap'\<rbrace> asUser t m \<lbrace>\<lambda>rv. if_unsafe_then_cap'\<rbrace>"
   apply (simp add: asUser_def split_def)
@@ -1537,8 +1743,7 @@ lemma no_fail_asUser [wp]:
   done
 
 lemma asUser_setRegister_corres:
-  "corres dc (tcb_at t)
-             (tcb_at' t)
+  "corres dc (tcb_at t and pspace_aligned and pspace_distinct) \<top>
              (as_user t (setRegister r v))
              (asUser t (setRegister r v))"
   apply (simp add: setRegister_def)
@@ -1547,7 +1752,7 @@ lemma asUser_setRegister_corres:
   done
 
 lemma getThreadState_corres:
-  "corres thread_state_relation (tcb_at t) (tcb_at' t)
+  "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)
@@ -1578,7 +1783,7 @@ lemma gts_inv'[wp]: "\<lbrace>P\<rbrace> getThreadState t \<lbrace>\<lambda>rv.
   by (simp add: getThreadState_def) wp
 
 lemma getBoundNotification_corres:
-  "corres (=) (tcb_at t) (tcb_at' t)
+  "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
           (get_bound_notification t) (getBoundNotification t)"
   apply (simp add: get_bound_notification_def getBoundNotification_def)
   apply (rule threadGet_corres)
@@ -1719,19 +1924,22 @@ lemma ethreadget_corres:
   apply (simp add: x)
   done
 
-lemma setQueue_corres:
-  "corres dc \<top> \<top> (set_tcb_queue d p q) (setQueue d p q)"
-  apply (rule corres_no_failI)
-   apply wp
-  apply (clarsimp simp: setQueue_def in_monad set_tcb_queue_def return_def simpler_modify_def)
-  apply (fastforce simp: state_relation_def ready_queues_relation_def)
-  done
-
-
-lemma getQueue_corres: "corres (=) \<top> \<top> (get_tcb_queue qdom prio) (getQueue qdom prio)"
-  apply (clarsimp simp add: getQueue_def state_relation_def ready_queues_relation_def get_tcb_queue_def gets_def)
-  apply (fold gets_def)
-  apply simp
+lemma getQueue_corres:
+  "corres (\<lambda>ls q. (ls = [] \<longleftrightarrow> tcbQueueEmpty q) \<and> (ls \<noteq> [] \<longrightarrow> tcbQueueHead q = Some (hd ls))
+                  \<and> queue_end_valid ls q)
+     \<top> \<top> (get_tcb_queue qdom prio) (getQueue qdom prio)"
+  apply (clarsimp simp: get_tcb_queue_def getQueue_def tcbQueueEmpty_def)
+  apply (rule corres_bind_return2)
+  apply (rule corres_symb_exec_l[OF _ _ gets_sp])
+    apply (rule corres_symb_exec_r[OF _ gets_sp])
+      apply clarsimp
+      apply (drule state_relation_ready_queues_relation)
+      apply (clarsimp simp: ready_queues_relation_def ready_queue_relation_def Let_def
+                            list_queue_relation_def)
+      apply (drule_tac x=qdom in spec)
+      apply (drule_tac x=prio in spec)
+      apply (fastforce dest: heap_path_head)
+     apply wpsimp+
   done
 
 lemma no_fail_return:
@@ -1746,8 +1954,8 @@ lemma addToBitmap_noop_corres:
      (wp | simp add: state_relation_def | rule no_fail_pre)+
 
 lemma addToBitmap_if_null_noop_corres: (* used this way in Haskell code *)
-  "corres dc \<top> \<top> (return ()) (if null queue then addToBitmap d p else return ())"
-  by (cases "null queue", simp_all add: addToBitmap_noop_corres)
+  "corres dc \<top> \<top> (return ()) (if tcbQueueEmpty queue then addToBitmap d p else return ())"
+  by (cases "tcbQueueHead queue", simp_all add: addToBitmap_noop_corres)
 
 lemma removeFromBitmap_corres_noop:
   "corres dc \<top> \<top> (return ()) (removeFromBitmap tdom prioa)"
@@ -1764,54 +1972,704 @@ crunch typ_at'[wp]: removeFromBitmap "\<lambda>s. P (typ_at' T p s)"
 lemmas addToBitmap_typ_ats [wp] = typ_at_lifts [OF addToBitmap_typ_at']
 lemmas removeFromBitmap_typ_ats [wp] = typ_at_lifts [OF removeFromBitmap_typ_at']
 
+lemma ekheap_relation_tcb_domain_priority:
+  "\<lbrakk>ekheap_relation (ekheap s) (ksPSpace s'); ekheap s t = Some (tcb);
+    ksPSpace s' t = Some (KOTCB tcb')\<rbrakk>
+   \<Longrightarrow> tcbDomain tcb' = tcb_domain tcb \<and> tcbPriority tcb' = tcb_priority tcb"
+  apply (clarsimp simp: ekheap_relation_def)
+  apply (drule_tac x=t in bspec, blast)
+  apply (clarsimp simp: other_obj_relation_def etcb_relation_def)
+  done
+
+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
+
+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
+
+lemma tcbQueued_update_pspace_relation[wp]:
+  fixes s :: det_state
+  shows "threadSet (tcbQueued_update f) tcbPtr \<lbrace>\<lambda>s'. pspace_relation (kheap s) (ksPSpace s')\<rbrace>"
+  by (wpsimp wp: threadSet_pspace_relation simp: tcb_relation_def)
+
+lemma tcbQueued_update_ekheap_relation[wp]:
+  fixes s :: det_state
+  shows
+    "\<lbrace>\<lambda>s'. ekheap_relation (ekheap s) (ksPSpace s') \<and> pspace_relation (kheap s) (ksPSpace s')
+           \<and> valid_etcbs s\<rbrace>
+     threadSet (tcbQueued_update f) tcbPtr
+     \<lbrace>\<lambda>_ s'. ekheap_relation (ekheap s) (ksPSpace s')\<rbrace>"
+  by (wpsimp wp: threadSet_ekheap_relation simp: etcb_relation_def)
+
+lemma tcbQueueRemove_pspace_relation[wp]:
+  fixes s :: det_state
+  shows "tcbQueueRemove queue tcbPtr \<lbrace>\<lambda>s'. pspace_relation (kheap s) (ksPSpace s')\<rbrace>"
+  unfolding tcbQueueRemove_def
+  by (wpsimp wp: threadSet_pspace_relation hoare_drop_imps simp: tcb_relation_def)
+
+lemma tcbQueueRemove_ekheap_relation[wp]:
+  fixes s :: det_state
+  shows
+    "\<lbrace>\<lambda>s'. ekheap_relation (ekheap s) (ksPSpace s') \<and> pspace_relation (kheap s) (ksPSpace s')
+           \<and> valid_etcbs s\<rbrace>
+     tcbQueueRemove queue tcbPtr
+     \<lbrace>\<lambda>_ s'. ekheap_relation (ekheap s) (ksPSpace s')\<rbrace>"
+  unfolding tcbQueueRemove_def
+  by (wpsimp wp: threadSet_ekheap_relation threadSet_pspace_relation hoare_drop_imps
+           simp: tcb_relation_def etcb_relation_def)
+
+lemma threadSet_ghost_relation[wp]:
+  "threadSet f tcbPtr \<lbrace>\<lambda>s'. ghost_relation (kheap s) (gsUserPages s') (gsCNodes s')\<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 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)
+
+crunches 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)
+
+crunches 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
+
+crunches 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)
+
+crunches 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
+
+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>
+   isRunnable tcb_ptr
+   \<lbrace>\<lambda>rv s. \<exists>tcb'. ko_at' tcb' tcb_ptr s
+                  \<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_def)
+  apply (fastforce simp: obj_at'_def split: Structures_H.thread_state.splits)
+  done
+
+crunch (no_fail) no_fail[wp]: isRunnable
+
+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)
+
+crunches 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 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 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 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 tcbSchedEnqueue_corres:
-  "corres dc (is_etcb_at t) (tcb_at' t and Invariants_H.valid_queues and valid_queues')
-             (tcb_sched_action (tcb_sched_enqueue) t) (tcbSchedEnqueue t)"
-proof -
-  have ready_queues_helper:
-    "\<And>t tcb a b. \<lbrakk> ekheap a t = Some tcb;  obj_at' tcbQueued t b  ;  valid_queues' b  ;
-                   ekheap_relation (ekheap a) (ksPSpace b) \<rbrakk>
-                 \<Longrightarrow> t \<in> set (ksReadyQueues b (tcb_domain tcb, tcb_priority tcb))"
-  unfolding valid_queues'_def
-  by (fastforce dest: ekheap_relation_absD simp: obj_at'_def inQ_def etcb_relation_def projectKO_eq projectKO_tcb)
-
-  show ?thesis unfolding tcbSchedEnqueue_def tcb_sched_action_def
-    apply (rule corres_symb_exec_r [OF _ _ threadGet_inv,
-             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 (rule no_fail_pre, wp, blast)
-    apply (case_tac queued; simp_all)
-     apply (rule corres_no_failI; simp add: no_fail_return)
-     apply (clarsimp simp: in_monad ethread_get_def gets_the_def bind_assoc
-                           assert_opt_def exec_gets is_etcb_at_def get_etcb_def get_tcb_queue_def
-                           set_tcb_queue_def simpler_modify_def ready_queues_relation_def
-                           state_relation_def tcb_sched_enqueue_def)
-     apply (rule ready_queues_helper; auto)
-    apply (clarsimp simp: when_def)
-    apply (rule stronger_corres_guard_imp)
-      apply (rule corres_split[where r'="(=)"])
-         apply (rule ethreadget_corres)
-         apply (simp add: etcb_relation_def)
-        apply (rule corres_split[where r'="(=)"])
-           apply (rule ethreadget_corres)
-           apply (simp add: etcb_relation_def)
-          apply (rule corres_split[where r'="(=)"])
-             apply simp
-             apply (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
-               apply (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 exst_same_def)
-               apply (wp getObject_tcb_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
+  "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)?)
+
+  \<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)
+
+  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"
@@ -1838,7 +2696,10 @@ lemma getSchedulerAction_corres:
   done
 
 lemma rescheduleRequired_corres:
-  "corres dc (weak_valid_sched_action and valid_etcbs) (Invariants_H.valid_queues and valid_queues' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s))
+  "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)
@@ -1849,15 +2710,14 @@ lemma rescheduleRequired_corres:
          apply (case_tac action)
            apply simp
           apply simp
-          apply (rule tcbSchedEnqueue_corres)
+          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
+   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 simp
-  apply (clarsimp simp: weak_sch_act_wf_def pred_tcb_at' split: scheduler_action.splits)
+  apply (clarsimp split: scheduler_action.splits)
   done
 
 lemma rescheduleRequired_corres_simple:
@@ -1925,20 +2785,18 @@ lemmas addToBitmap_weak_sch_act_wf[wp]
   = weak_sch_act_wf_lift[OF addToBitmap_nosch]
 
 crunch st_tcb_at'[wp]: removeFromBitmap "st_tcb_at' P t"
-crunch pred_tcb_at'[wp]: removeFromBitmap "pred_tcb_at' proj P t"
+crunch pred_tcb_at'[wp]: removeFromBitmap "\<lambda>s. Q (pred_tcb_at' proj P t s)"
 
 crunch not_st_tcb_at'[wp]: removeFromBitmap "\<lambda>s. \<not> (st_tcb_at' P' t) s"
-crunch not_pred_tcb_at'[wp]: removeFromBitmap "\<lambda>s. \<not> (pred_tcb_at' proj P' t) s"
 
 crunch st_tcb_at'[wp]: addToBitmap "st_tcb_at' P' t"
-crunch pred_tcb_at'[wp]: addToBitmap "pred_tcb_at' proj P' t"
+crunch pred_tcb_at'[wp]: addToBitmap "\<lambda>s. Q (pred_tcb_at' proj P t s)"
 
 crunch not_st_tcb_at'[wp]: addToBitmap "\<lambda>s. \<not> (st_tcb_at' P' t) s"
-crunch not_pred_tcb_at'[wp]: addToBitmap "\<lambda>s. \<not> (pred_tcb_at' proj P' t) s"
 
-crunch obj_at'[wp]: removeFromBitmap "obj_at' P t"
+crunch obj_at'[wp]: removeFromBitmap "\<lambda>s. Q (obj_at' P t s)"
 
-crunch obj_at'[wp]: addToBitmap "obj_at' P t"
+crunch obj_at'[wp]: addToBitmap "\<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>"
@@ -1955,9 +2813,11 @@ lemma addToBitmap_tcb_in_cur_domain'[wp]:
   done
 
 lemma tcbSchedDequeue_weak_sch_act_wf[wp]:
-  "\<lbrace> \<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s \<rbrace> tcbSchedDequeue a \<lbrace> \<lambda>_ s. weak_sch_act_wf (ksSchedulerAction s) s \<rbrace>"
-  apply (simp add: tcbSchedDequeue_def)
-  apply (wp threadSet_weak_sch_act_wf removeFromBitmap_weak_sch_act_wf | simp add: crunch_simps)+
+  "tcbSchedDequeue tcbPtr \<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
+  apply (simp add: tcbSchedDequeue_def tcbQueueRemove_def)
+  apply (wp threadSet_weak_sch_act_wf getObject_tcb_wp removeFromBitmap_weak_sch_act_wf
+         | simp add: crunch_simps threadGet_def)+
+  apply (clarsimp simp: obj_at'_def)
   done
 
 lemma dequeue_nothing_eq[simp]:
@@ -1973,44 +2833,345 @@ lemma gets_the_exec: "f s \<noteq> None \<Longrightarrow>  (do x \<leftarrow> ge
                    return_def assert_opt_def)
   done
 
-lemma tcbSchedDequeue_corres:
-  "corres dc (is_etcb_at t) (tcb_at' t and Invariants_H.valid_queues)
-             (tcb_sched_action tcb_sched_dequeue t) (tcbSchedDequeue t)"
-  apply (simp only: tcbSchedDequeue_def tcb_sched_action_def)
-  apply (rule corres_symb_exec_r[OF _ _ threadGet_inv, where Q'="\<lambda>rv. tcb_at' t and Invariants_H.valid_queues and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"])
-    defer
-    apply (wp threadGet_obj_at', simp, simp)
-   apply (rule no_fail_pre, wp, simp)
-  apply (case_tac queued)
-   defer
-   apply (simp add: when_def)
-   apply (rule corres_no_failI)
-    apply (wp)
-   apply (clarsimp simp: in_monad ethread_get_def set_tcb_queue_def is_etcb_at_def state_relation_def)
-   apply (subgoal_tac "t \<notin> set (ready_queues a (tcb_domain y) (tcb_priority y))")
-    prefer 2
-    subgoal by (force simp: tcb_sched_dequeue_def Invariants_H.valid_queues_def valid_queues_no_bitmap_def
-                            ready_queues_relation_def obj_at'_def inQ_def projectKO_eq project_inject)
-   apply (subst gets_the_exec)
-    apply (simp add: get_etcb_def)
-   apply (subst gets_the_exec)
-    apply (simp add: get_etcb_def)
-   apply (simp add: exec_gets simpler_modify_def get_etcb_def ready_queues_relation_def cong: if_cong get_tcb_queue_def)
-  apply (simp add: when_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[where r'="(=)"])
-       apply (rule ethreadget_corres, simp add: etcb_relation_def)
-      apply (rule corres_split[where r'="(=)"])
-         apply (rule ethreadget_corres, simp add: etcb_relation_def)
-        apply (rule corres_split[where r'="(=)"])
-           apply (simp, rule getQueue_corres)
-          apply (rule corres_split_noop_rhs2)
-             apply (simp add: tcb_sched_dequeue_def)
-             apply (rule setQueue_corres)
-            apply (rule corres_split_noop_rhs)
-              apply (clarsimp, rule removeFromBitmap_corres_noop)
-             apply (rule threadSet_corres_noop; simp_all add: tcb_relation_def exst_same_def)
-            apply (wp | simp)+
+lemma tcbQueueRemove_no_fail:
+  "no_fail (\<lambda>s. tcb_at' tcbPtr s
+                \<and> (\<exists>ts. list_queue_relation ts queue (tcbSchedNexts_of s) (tcbSchedPrevs_of s)
+                        \<and> tcbPtr \<in> set ts)
+                \<and> sym_heap_sched_pointers s \<and> valid_objs' s)
+           (tcbQueueRemove queue tcbPtr)"
+  unfolding tcbQueueRemove_def
+  apply (wpsimp wp: getObject_tcb_wp)
+  apply normalise_obj_at'
+  apply (frule (1) ko_at_valid_objs')
+   apply (fastforce simp: projectKOs)
+  apply (clarsimp simp: list_queue_relation_def)
+  apply (prop_tac "tcbQueueHead queue \<noteq> Some tcbPtr \<longrightarrow> tcbSchedPrevs_of s tcbPtr \<noteq> None")
+   apply (rule impI)
+   apply (frule not_head_prev_not_None[where p=tcbPtr])
+      apply (fastforce simp: inQ_def opt_pred_def opt_map_def obj_at'_def)
+     apply (fastforce dest: heap_path_head)
+    apply fastforce
+   apply (fastforce simp: opt_map_def obj_at'_def valid_tcb'_def valid_bound_tcb'_def)
+  by (fastforce dest!: not_last_next_not_None[where p=tcbPtr]
+                 simp: queue_end_valid_def opt_map_def obj_at'_def projectKOs valid_obj'_def
+                       valid_tcb'_def)
+
+crunch (no_fail) no_fail[wp]: removeFromBitmap
+
+crunches removeFromBitmap
+  for ready_queues_relation[wp]: "ready_queues_relation s"
+  and list_queue_relation[wp]:
+   "\<lambda>s'. list_queue_relation ts (P (ksReadyQueues s'))
+                             (tcbSchedNexts_of s') (tcbSchedPrevs_of s')"
+  (simp: bitmap_fun_defs ready_queues_relation_def)
+
+\<comment> \<open>
+  A direct analogue of tcbQueueRemove, used in tcb_sched_dequeue' below, so that within the proof of
+  tcbQueueRemove_corres, we may reason in terms of the list operations used within this function
+  rather than @{term filter}.\<close>
+definition tcb_queue_remove :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
+  "tcb_queue_remove a ls \<equiv>
+     if ls = [a]
+     then []
+     else if a = hd ls
+          then tl ls
+          else if a = last ls
+               then butlast ls
+               else list_remove ls a"
+
+definition tcb_sched_dequeue' :: "obj_ref \<Rightarrow> unit det_ext_monad" where
+  "tcb_sched_dequeue' tcb_ptr \<equiv> do
+     d \<leftarrow> ethread_get tcb_domain tcb_ptr;
+     prio \<leftarrow> ethread_get tcb_priority tcb_ptr;
+     queue \<leftarrow> get_tcb_queue d prio;
+     when (tcb_ptr \<in> set queue) $ set_tcb_queue d prio (tcb_queue_remove tcb_ptr queue)
+   od"
+
+lemma filter_tcb_queue_remove:
+  "\<lbrakk>a \<in> set ls; distinct ls \<rbrakk> \<Longrightarrow> filter ((\<noteq>) a) ls = tcb_queue_remove a ls"
+  apply (clarsimp simp: tcb_queue_remove_def)
+  apply (intro conjI impI)
+     apply (fastforce elim: filter_hd_equals_tl)
+    apply (fastforce elim: filter_last_equals_butlast)
+   apply (fastforce elim: filter_hd_equals_tl)
+  apply (frule split_list)
+  apply (clarsimp simp: list_remove_middle_distinct)
+  apply (subst filter_True | clarsimp simp: list_remove_none)+
+  done
+
+lemma tcb_sched_dequeue_monadic_rewrite:
+  "monadic_rewrite False True (is_etcb_at t and (\<lambda>s. \<forall>d p. distinct (ready_queues s d p)))
+     (tcb_sched_action tcb_sched_dequeue t) (tcb_sched_dequeue' t)"
+  supply if_split[split del]
+  apply (clarsimp simp: tcb_sched_dequeue'_def tcb_sched_dequeue_def tcb_sched_action_def
+                        set_tcb_queue_def)
+  apply (rule monadic_rewrite_bind_tail)+
+     apply (clarsimp simp: when_def)
+     apply (rule monadic_rewrite_if_r)
+      apply (rule_tac P="\<lambda>_. distinct queue" in monadic_rewrite_guard_arg_cong)
+      apply (frule (1) filter_tcb_queue_remove)
+      apply (metis (mono_tags, lifting) filter_cong)
+     apply (rule monadic_rewrite_modify_noop)
+    apply (wpsimp wp: thread_get_wp)+
+  apply (clarsimp simp: etcb_at_def split: option.splits)
+  apply (prop_tac "(\<lambda>d' p. if d' = tcb_domain x2 \<and> p = tcb_priority x2
+                           then filter (\<lambda>x. x \<noteq> t) (ready_queues s (tcb_domain x2) (tcb_priority x2))
+                           else ready_queues s d' p)
+                   = ready_queues s")
+   apply (subst filter_True)
+    apply fastforce
+   apply (clarsimp intro!: ext split: if_splits)
+  apply fastforce
+  done
+
+crunches removeFromBitmap
+  for ksReadyQueues[wp]: "\<lambda>s. P (ksReadyQueues s)"
+
+lemma list_queue_relation_neighbour_in_set:
+  "\<lbrakk>list_queue_relation ls q hp hp'; sym_heap hp hp'; p \<in> set ls\<rbrakk>
+   \<Longrightarrow> \<forall>nbr. (hp p = Some nbr \<longrightarrow> nbr \<in> set ls) \<and> (hp' p = Some nbr \<longrightarrow> nbr \<in> set ls)"
+  apply (rule heap_ls_neighbour_in_set)
+     apply (fastforce simp: list_queue_relation_def)
+    apply fastforce
+   apply (clarsimp simp: list_queue_relation_def prev_queue_head_def)
+  apply fastforce
+  done
+
+lemma in_queue_not_head_or_not_tail_length_gt_1:
+  "\<lbrakk>tcbPtr \<in> set ls; tcbQueueHead q \<noteq> Some tcbPtr \<or> tcbQueueEnd q \<noteq> Some tcbPtr;
+    list_queue_relation ls q nexts prevs\<rbrakk>
+   \<Longrightarrow> Suc 0 < length ls"
+  apply (clarsimp simp: list_queue_relation_def)
+  apply (cases ls; fastforce simp: queue_end_valid_def)
+  done
+
+lemma tcbSchedDequeue_corres:
+  "tcb_ptr = tcbPtr \<Longrightarrow>
+   corres dc
+     (in_correct_ready_q and ready_qs_distinct and valid_etcbs and tcb_at tcb_ptr
+      and pspace_aligned and pspace_distinct)
+     (sym_heap_sched_pointers and valid_objs')
+     (tcb_sched_action tcb_sched_dequeue tcb_ptr) (tcbSchedDequeue tcbPtr)"
+  supply heap_path_append[simp del] fun_upd_apply[simp del] distinct_append[simp del]
+         list_remove_append[simp del]
+  apply (rule_tac Q'="tcb_at' tcbPtr" in corres_cross_add_guard)
+   apply (fastforce intro!: tcb_at_cross simp: obj_at_def is_tcb_def)
+  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 monadic_rewrite_corres_l[where P=P and Q=P for P, simplified])
+   apply (rule monadic_rewrite_guard_imp[OF tcb_sched_dequeue_monadic_rewrite])
+   apply (fastforce dest: tcb_at_is_etcb_at simp: in_correct_ready_q_def ready_qs_distinct_def)
+  apply (clarsimp simp: tcb_sched_dequeue'_def get_tcb_queue_def tcbSchedDequeue_def getQueue_def
+                        unless_def when_def)
+  apply (rule corres_symb_exec_l[OF _ _ ethread_get_sp]; wpsimp?)
+  apply (rename_tac dom)
+  apply (rule corres_symb_exec_l[OF _ _ ethread_get_sp]; wpsimp?)
+  apply (rename_tac prio)
+  apply (rule corres_symb_exec_l[OF _ _ gets_sp]; (solves wpsimp)?)
+  apply (rule corres_stateAssert_ignore)
+   apply (fastforce intro: ksReadyQueues_asrt_cross)
+  apply (rule corres_symb_exec_r[OF _ threadGet_sp]; (solves wpsimp)?)
+  apply (rule corres_if_strong'; fastforce?)
+    apply (frule state_relation_ready_queues_relation)
+    apply (frule in_ready_q_tcbQueued_eq[where t=tcbPtr])
+    apply (fastforce simp: obj_at'_def projectKOs opt_pred_def opt_map_def obj_at_def is_tcb_def
+                           in_correct_ready_q_def etcb_at_def is_etcb_at_def)
+  apply (rule corres_symb_exec_r[OF _ threadGet_sp]; wpsimp?)
+  apply (rule corres_symb_exec_r[OF _ threadGet_sp]; wpsimp?)
+  apply (rule corres_symb_exec_r[OF _ gets_sp]; wpsimp?)
+  apply (rule corres_from_valid_det)
+    apply (fastforce intro: det_wp_modify det_wp_pre simp: set_tcb_queue_def)
+   apply (wpsimp wp: tcbQueueRemove_no_fail)
+   apply (fastforce dest: state_relation_ready_queues_relation
+                    simp: ex_abs_underlying_def ready_queues_relation_def ready_queue_relation_def
+                          Let_def inQ_def opt_pred_def opt_map_def obj_at'_def projectKOs)
+  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 tcbQueueRemove_def
+         split_del: if_split)
+  apply (frule (1) tcb_at_is_etcb_at)
+  apply (clarsimp simp: obj_at_def is_etcb_at_def etcb_at_def)
+  apply normalise_obj_at'
+  apply (rename_tac s d p s' tcb' tcb etcb)
+  apply (frule_tac t=tcbPtr in ekheap_relation_tcb_domain_priority)
+    apply (force simp: obj_at_def)
+   apply (force simp: obj_at'_def projectKOs)
+
+  apply (case_tac "d \<noteq> tcb_domain etcb \<or> p \<noteq> tcb_priority etcb")
+   apply clarsimp
+   apply (cut_tac p=tcbPtr and ls="ready_queues s (tcb_domain etcb) (tcb_priority etcb)"
+               in list_queue_relation_neighbour_in_set)
+      apply (fastforce dest!: spec)
+     apply fastforce
+    apply fastforce
+   apply (cut_tac xs="ready_queues s d p" in heap_path_head')
+    apply (force dest!: spec simp: ready_queues_relation_def Let_def list_queue_relation_def)
+   apply (cut_tac d=d and d'="tcb_domain etcb" and p=p and p'="tcb_priority etcb"
+               in ready_queues_disjoint)
+      apply force
+     apply fastforce
+    apply fastforce
+   apply (cut_tac ts="ready_queues s d p" in list_queue_relation_nil)
+    apply fast
+   apply (clarsimp simp: tcbQueueEmpty_def)
+   apply (prop_tac "Some tcbPtr \<noteq> tcbQueueHead (ksReadyQueues s' (d, p))")
+    apply (metis hd_in_set not_emptyI option.sel option.simps(2))
+   apply (prop_tac "tcbPtr \<notin> set (ready_queues s d p)")
+    apply blast
+   apply (clarsimp simp: list_queue_relation_def)
+   apply (intro conjI; clarsimp)
+
+    \<comment> \<open>the ready queue is the singleton consisting of tcbPtr\<close>
+    apply (intro conjI)
+         apply (force intro!: heap_path_heap_upd_not_in simp: fun_upd_apply)
+        apply (clarsimp simp: queue_end_valid_def fun_upd_apply)
+       apply (force simp: prev_queue_head_heap_upd fun_upd_apply)
+      apply (clarsimp simp: inQ_def in_opt_pred fun_upd_apply)
+     apply (clarsimp simp: fun_upd_apply)
+    apply (clarsimp simp: fun_upd_apply)
+
+   apply (clarsimp simp: etcb_at_def obj_at'_def projectKOs)
+   apply (intro conjI; clarsimp)
+
+    \<comment> \<open>tcbPtr is the head of the ready queue\<close>
+    apply (intro conjI)
+         apply (intro heap_path_heap_upd_not_in)
+           apply (force simp: fun_upd_apply)
+          apply (force simp: not_emptyI opt_map_red)
+         apply assumption
+        apply (clarsimp simp: queue_end_valid_def fun_upd_apply)
+       apply (clarsimp simp: prev_queue_head_def fun_upd_apply)
+      apply (clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply split: option.splits)
+     apply (clarsimp simp: fun_upd_apply)
+    apply (clarsimp simp: fun_upd_apply)
+   apply (intro conjI; clarsimp)
+
+    \<comment> \<open>tcbPtr is the end of the ready queue\<close>
+    apply (intro conjI)
+         apply (intro heap_path_heap_upd_not_in)
+           apply (simp add: fun_upd_apply split: if_splits)
+          apply (force simp: not_emptyI opt_map_red)
+         apply (clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply split: option.splits)
+        apply (clarsimp simp: queue_end_valid_def fun_upd_apply)
+       apply (force simp: prev_queue_head_def fun_upd_apply opt_map_red opt_map_upd_triv)
+      apply (clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply split: option.splits)
+     apply (clarsimp simp: fun_upd_apply)
+    apply (clarsimp simp: fun_upd_apply)
+
+   \<comment> \<open>tcbPtr is in the middle of the ready queue\<close>
+   apply (intro conjI)
+     apply (intro heap_path_heap_upd_not_in)
+        apply (simp add: fun_upd_apply)
+       apply (force simp: not_emptyI opt_map_red)
+      apply (force simp: not_emptyI opt_map_red)
+     apply fastforce
+    apply (clarsimp simp: opt_map_red opt_map_upd_triv)
+    apply (intro prev_queue_head_heap_upd)
+      apply (force dest!: spec)
+     apply (metis hd_in_set not_emptyI option.sel option.simps(2))
+    apply fastforce
+   subgoal
+     by (clarsimp simp: inQ_def opt_map_def opt_pred_def fun_upd_apply
+                 split: if_splits option.splits)
+
+  \<comment> \<open>d = tcb_domain tcb \<and> p = tcb_priority tcb\<close>
+  apply clarsimp
+  apply (drule_tac x="tcb_domain etcb" in spec)
+  apply (drule_tac x="tcb_priority etcb" in spec)
+  apply (clarsimp simp: list_queue_relation_def)
+  apply (frule heap_path_head')
+  apply (frule heap_ls_distinct)
+  apply (intro conjI; clarsimp simp: tcbQueueEmpty_def)
+
+   \<comment> \<open>the ready queue is the singleton consisting of tcbPtr\<close>
+   apply (intro conjI)
+      apply (simp add: fun_upd_apply tcb_queue_remove_def queue_end_valid_def heap_ls_unique
+                       heap_path_last_end)
+     apply (simp add: fun_upd_apply tcb_queue_remove_def queue_end_valid_def heap_ls_unique
+                      heap_path_last_end)
+    apply (simp add: fun_upd_apply prev_queue_head_def)
+   apply (case_tac "ready_queues s (tcb_domain etcb) (tcb_priority etcb)";
+          clarsimp simp: tcb_queue_remove_def inQ_def opt_pred_def fun_upd_apply)
+  apply (intro conjI; clarsimp)
+
+   \<comment> \<open>tcbPtr is the head of the ready queue\<close>
+   apply (frule set_list_mem_nonempty)
+   apply (frule in_queue_not_head_or_not_tail_length_gt_1)
+     apply fastforce
+    apply (fastforce simp: list_queue_relation_def)
+   apply (frule list_not_head)
+   apply (clarsimp simp: tcb_queue_remove_def)
+   apply (frule length_tail_nonempty)
+   apply (frule (2) heap_ls_next_of_hd)
+   apply (clarsimp simp: obj_at'_def)
+   apply (intro conjI impI allI)
+      apply (drule (1) heap_ls_remove_head_not_singleton)
+      apply (clarsimp simp: opt_map_red opt_map_upd_triv fun_upd_apply projectKOs)
+     apply (clarsimp simp: queue_end_valid_def fun_upd_apply last_tl)
+    apply (clarsimp simp: prev_queue_head_def fun_upd_apply projectKOs)
+   apply (case_tac "ready_queues s (tcb_domain etcb) (tcb_priority etcb)";
+          clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply projectKOs
+                  split: option.splits)
+  apply (intro conjI; clarsimp)
+
+   \<comment> \<open>tcbPtr is the end of the ready queue\<close>
+   apply (frule set_list_mem_nonempty)
+   apply (frule in_queue_not_head_or_not_tail_length_gt_1)
+     apply fast
+    apply (force dest!: spec simp: list_queue_relation_def)
+   apply (clarsimp simp: queue_end_valid_def)
+   apply (frule list_not_last)
+   apply (clarsimp simp: tcb_queue_remove_def)
+   apply (frule length_gt_1_imp_butlast_nonempty)
+   apply (frule (3) heap_ls_prev_of_last)
+   apply (clarsimp simp: obj_at'_def)
+   apply (intro conjI impI; clarsimp?)
+      apply (drule (1) heap_ls_remove_last_not_singleton)
+      apply (force elim!: rsubst3[where P=heap_ls] simp: opt_map_def fun_upd_apply obj_at'_def projectKOs)
+     apply (clarsimp simp: opt_map_def fun_upd_apply projectKOs)
+    apply (clarsimp simp: prev_queue_head_def fun_upd_apply opt_map_def projectKOs)
+   apply (clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply projectKOs
+                  split: option.splits)
+   apply (meson distinct_in_butlast_not_last in_set_butlastD last_in_set not_last_in_set_butlast)
+
+  \<comment> \<open>tcbPtr is in the middle of the ready queue\<close>
+  apply (clarsimp simp: obj_at'_def)
+  apply (frule set_list_mem_nonempty)
+  apply (frule split_list)
+  apply clarsimp
+  apply (rename_tac xs ys)
+  apply (prop_tac "xs \<noteq> [] \<and> ys \<noteq> []", fastforce simp: queue_end_valid_def)
+  apply clarsimp
+  apply (frule (2) ptr_in_middle_prev_next)
+   apply fastforce
+  apply (clarsimp simp: tcb_queue_remove_def)
+  apply (prop_tac "tcbPtr \<noteq> last xs")
+   apply (clarsimp simp: distinct_append)
+  apply (prop_tac "tcbPtr \<noteq> hd ys")
+   apply (fastforce dest: hd_in_set simp: distinct_append)
+  apply (prop_tac "last xs \<noteq> hd ys")
+   apply (metis distinct_decompose2 hd_Cons_tl last_in_set)
+  apply (prop_tac "list_remove (xs @ tcbPtr # ys) tcbPtr = xs @ ys")
+   apply (simp add: list_remove_middle_distinct del: list_remove_append)
+  apply (intro conjI impI allI; (solves \<open>clarsimp simp: distinct_append\<close>)?)
+     apply (fastforce elim!: rsubst3[where P=heap_ls]
+                      dest!: heap_ls_remove_middle hd_in_set last_in_set
+                       simp: distinct_append not_emptyI opt_map_def fun_upd_apply projectKOs)
+    apply (clarsimp simp: queue_end_valid_def fun_upd_apply)
+   apply (case_tac xs;
+          fastforce simp: prev_queue_head_def opt_map_def fun_upd_apply distinct_append projectKOs)
+  apply (clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply distinct_append projectKOs
+                 split: option.splits)
   done
 
 lemma thread_get_test: "do cur_ts \<leftarrow> get_thread_state cur; g (test cur_ts) od =
@@ -2018,7 +3179,9 @@ lemma thread_get_test: "do cur_ts \<leftarrow> get_thread_state cur; g (test cur
   apply (simp add: get_thread_state_def thread_get_def)
   done
 
-lemma thread_get_isRunnable_corres: "corres (=) (tcb_at t) (tcb_at' t) (thread_get (\<lambda>tcb. runnable (tcb_state tcb)) t) (isRunnable t)"
+lemma thread_get_isRunnable_corres:
+  "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+              (thread_get (\<lambda>tcb. runnable (tcb_state tcb)) t) (isRunnable t)"
   apply (simp add:  isRunnable_def getThreadState_def threadGet_def
                    thread_get_def)
   apply (fold liftM_def)
@@ -2032,8 +3195,8 @@ lemma thread_get_isRunnable_corres: "corres (=) (tcb_at t) (tcb_at' t) (thread_g
 lemma setThreadState_corres:
   "thread_state_relation ts ts' \<Longrightarrow>
    corres dc
-          (tcb_at t)
-          (tcb_at' t)
+          (tcb_at t and pspace_aligned and pspace_distinct)
+          \<top>
           (set_thread_state t ts) (setThreadState ts' t)"
   (is "?tsr \<Longrightarrow> corres dc ?Pre ?Pre' ?sts ?sts'")
   apply (simp add: set_thread_state_def setThreadState_def)
@@ -2057,8 +3220,8 @@ lemma setThreadState_corres:
 
 lemma setBoundNotification_corres:
   "corres dc
-          (tcb_at t)
-          (tcb_at' t)
+          (tcb_at t and pspace_aligned and pspace_distinct)
+          \<top>
           (set_bound_notification t ntfn) (setBoundNotification ntfn t)"
   apply (simp add: set_bound_notification_def setBoundNotification_def)
   apply (subst thread_set_def[simplified, symmetric])
@@ -2068,29 +3231,84 @@ lemma setBoundNotification_corres:
 crunches rescheduleRequired, tcbSchedDequeue, setThreadState, setBoundNotification
   for tcb'[wp]: "tcb_at' addr"
 
+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
+
+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
+
+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)
+
+crunches addToBitmap
+  for valid_objs'[wp]: valid_objs'
+  (simp: unless_def crunch_simps wp: crunch_wps)
+
+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
+
 crunches rescheduleRequired, removeFromBitmap
   for valid_objs'[wp]: valid_objs'
   (simp: crunch_simps)
 
-lemma tcbSchedDequeue_valid_objs' [wp]: "\<lbrace> valid_objs' \<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>_. valid_objs' \<rbrace>"
-  unfolding tcbSchedDequeue_def
-  apply (wp threadSet_valid_objs')
-        apply (clarsimp simp add: valid_tcb'_def tcb_cte_cases_def)
-        apply wp
-       apply (simp add: if_apply_def2)
-       apply (wp hoare_drop_imps)
-       apply (wp | simp cong: if_cong add: valid_tcb'_def tcb_cte_cases_def if_apply_def2)+
+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]
+
+lemma tcbQueueRemove_valid_objs'[wp]:
+  "tcbQueueRemove queue tcbPtr \<lbrace>valid_objs'\<rbrace>"
+  unfolding tcbQueueRemove_def
+  apply (wpsimp wp: getObject_tcb_wp)
+  apply normalise_obj_at'
+  apply (fastforce dest!: tcb_ko_at_valid_objs_valid_tcb'
+                    simp: valid_tcb'_def  valid_bound_tcb'_def obj_at'_def)
   done
 
+lemma tcbSchedDequeue_valid_objs'[wp]:
+  "tcbSchedDequeue t \<lbrace>valid_objs'\<rbrace>"
+  unfolding tcbSchedDequeue_def setQueue_def
+  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>"
-  apply (simp add: setThreadState_def setQueue_def isRunnable_def isStopped_def)
-  apply (wp threadSet_valid_objs')
-     apply (simp add: valid_tcb'_def tcb_cte_cases_def)
-     apply (wp threadSet_valid_objs' | simp)+
-  apply (clarsimp simp: valid_tcb'_def tcb_cte_cases_def)
+  "\<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')
+   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':
@@ -2176,18 +3394,6 @@ lemma setQueue_valid_bitmapQ_except[wp]:
   unfolding setQueue_def bitmapQ_defs
   by (wp, clarsimp simp: bitmapQ_def)
 
-lemma setQueue_valid_bitmapQ: (* enqueue only *)
-  "\<lbrace> valid_bitmapQ and (\<lambda>s. (ksReadyQueues s (d, p) = []) = (ts = [])) \<rbrace>
-  setQueue d p ts
-  \<lbrace>\<lambda>_. valid_bitmapQ \<rbrace>"
-  unfolding setQueue_def bitmapQ_defs
-  by (wp, clarsimp simp: bitmapQ_def)
-
-lemma setQueue_valid_queues':
-  "\<lbrace>valid_queues' and (\<lambda>s. \<forall>t. obj_at' (inQ d p) t s \<longrightarrow> t \<in> set ts)\<rbrace>
-    setQueue d p ts \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  by (wp | simp add: valid_queues'_def setQueue_def)+
-
 lemma setQueue_cur:
   "\<lbrace>\<lambda>s. cur_tcb' s\<rbrace> setQueue d p ts \<lbrace>\<lambda>rv s. cur_tcb' s\<rbrace>"
   unfolding setQueue_def cur_tcb'_def
@@ -2325,9 +3531,17 @@ lemma threadSet_queued_sch_act_wf[wp]:
   apply (wp tcb_in_cur_domain'_lift | simp add: obj_at'_def)+
   done
 
+lemma tcbSchedNext_update_pred_tcb_at'[wp]:
+  "threadSet (tcbSchedNext_update f) t \<lbrace>\<lambda>s. P (pred_tcb_at' proj P' t' s)\<rbrace>"
+  by (wp threadSet_pred_tcb_no_state crunch_wps | clarsimp simp: tcb_to_itcb'_def)+
+
+lemma tcbSchedPrev_update_pred_tcb_at'[wp]:
+  "threadSet (tcbSchedPrev_update f) t \<lbrace>\<lambda>s. P (pred_tcb_at' proj P' t' s)\<rbrace>"
+  by (wp threadSet_pred_tcb_no_state crunch_wps | clarsimp simp: tcb_to_itcb'_def)+
+
 lemma tcbSchedEnqueue_pred_tcb_at'[wp]:
   "\<lbrace>\<lambda>s. pred_tcb_at' proj P' t' s \<rbrace> tcbSchedEnqueue t \<lbrace>\<lambda>_ s. pred_tcb_at' proj P' t' s\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def when_def unless_def)
+  apply (simp add: tcbSchedEnqueue_def tcbQueuePrepend_def when_def unless_def)
   apply (wp threadSet_pred_tcb_no_state crunch_wps | clarsimp simp: tcb_to_itcb'_def)+
   done
 
@@ -2335,8 +3549,9 @@ lemma tcbSchedDequeue_sch_act_wf[wp]:
   "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>
     tcbSchedDequeue t
    \<lbrace>\<lambda>_ s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  unfolding tcbSchedDequeue_def
-  by (wp setQueue_sch_act | wp sch_act_wf_lift | simp add: if_apply_def2)+
+  unfolding tcbSchedDequeue_def tcbQueueRemove_def
+  by (wp setQueue_sch_act threadSet_tcbDomain_triv hoare_drop_imps
+      | wp sch_act_wf_lift | simp add: if_apply_def2)+
 
 crunch nosch: tcbSchedDequeue "\<lambda>s. P (ksSchedulerAction s)"
 
@@ -2432,21 +3647,22 @@ lemma tcbSchedEnqueue_sch_act[wp]:
   "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>
     tcbSchedEnqueue t
    \<lbrace>\<lambda>_ s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  by (simp add: tcbSchedEnqueue_def unless_def)
-     (wp setQueue_sch_act | wp sch_act_wf_lift  | clarsimp)+
+  by (simp add: tcbSchedEnqueue_def tcbQueuePrepend_def unless_def)
+     (wp setQueue_sch_act threadSet_tcbDomain_triv | wp sch_act_wf_lift  | clarsimp)+
 
 lemma tcbSchedEnqueue_weak_sch_act[wp]:
   "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
     tcbSchedEnqueue t
    \<lbrace>\<lambda>_ s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
+  apply (simp add: tcbSchedEnqueue_def tcbQueuePrepend_def unless_def)
   apply (wp setQueue_sch_act threadSet_weak_sch_act_wf | clarsimp)+
   done
 
-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>"
+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
+  apply (clarsimp simp: obj_at'_def)
   done
 
 lemma threadGet_const:
@@ -2488,14 +3704,6 @@ lemma addToBitmap_bitmapQ:
   by (wpsimp simp: bitmap_fun_defs bitmapQ_def prioToL1Index_bit_set prioL2Index_bit_set
              simp_del: bit_exp_iff)
 
-lemma addToBitmap_valid_queues_no_bitmap_except:
-" \<lbrace> valid_queues_no_bitmap_except t \<rbrace>
-     addToBitmap d p
-  \<lbrace>\<lambda>_. valid_queues_no_bitmap_except t \<rbrace>"
-  unfolding addToBitmap_def modifyReadyQueuesL1Bitmap_def modifyReadyQueuesL2Bitmap_def
-             getReadyQueuesL1Bitmap_def getReadyQueuesL2Bitmap_def valid_queues_no_bitmap_except_def
-  by (wp, clarsimp)
-
 crunch norq[wp]: addToBitmap "\<lambda>s. P (ksReadyQueues s)"
   (wp: updateObject_cte_inv hoare_drop_imps)
 crunch norq[wp]: removeFromBitmap "\<lambda>s. P (ksReadyQueues s)"
@@ -2527,9 +3735,8 @@ lemma prioToL1Index_complement_nth_w2p:
 
 lemma valid_bitmapQ_exceptE:
   "\<lbrakk> valid_bitmapQ_except d' p' s ; d \<noteq> d' \<or> p \<noteq> p' \<rbrakk>
-   \<Longrightarrow> bitmapQ d p s = (ksReadyQueues s (d, p) \<noteq> [])"
-   unfolding valid_bitmapQ_except_def
-   by blast
+   \<Longrightarrow> bitmapQ d p s = (\<not> tcbQueueEmpty (ksReadyQueues s (d, p)))"
+  by (fastforce simp: valid_bitmapQ_except_def)
 
 lemma invertL1Index_eq_cancelD:
   "\<lbrakk>  invertL1Index i = invertL1Index j ; i < l2BitmapSize ; j < l2BitmapSize \<rbrakk>
@@ -2643,22 +3850,15 @@ lemma addToBitmap_valid_bitmapQ_except:
   done
 
 lemma addToBitmap_valid_bitmapQ:
-" \<lbrace> valid_bitmapQ_except d p and bitmapQ_no_L2_orphans and
-    (\<lambda>s. ksReadyQueues s (d,p) \<noteq> []) \<rbrace>
-     addToBitmap d p
-  \<lbrace>\<lambda>_. valid_bitmapQ \<rbrace>"
-proof -
-  have "\<lbrace> valid_bitmapQ_except d p and bitmapQ_no_L2_orphans and
-            (\<lambda>s. ksReadyQueues s (d,p) \<noteq> []) \<rbrace>
-         addToBitmap d p
-         \<lbrace>\<lambda>_. valid_bitmapQ_except d p and
-              bitmapQ_no_L2_orphans and (\<lambda>s. bitmapQ d p s \<and> ksReadyQueues s (d,p) \<noteq> []) \<rbrace>"
-  by (wp addToBitmap_valid_queues_no_bitmap_except addToBitmap_valid_bitmapQ_except
-            addToBitmap_bitmapQ_no_L2_orphans addToBitmap_bitmapQ; simp)
-
-  thus ?thesis
-    by - (erule hoare_strengthen_post; fastforce elim: valid_bitmap_valid_bitmapQ_exceptE)
-qed
+  "\<lbrace>valid_bitmapQ_except d p and bitmapQ_no_L2_orphans
+    and (\<lambda>s. \<not> tcbQueueEmpty (ksReadyQueues s (d,p)))\<rbrace>
+   addToBitmap d p
+   \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
+  (is "\<lbrace>?pre\<rbrace> _ \<lbrace>_\<rbrace>")
+  apply (rule_tac Q="\<lambda>_ s. ?pre s \<and> bitmapQ d p s" in hoare_strengthen_post)
+   apply (wpsimp wp: addToBitmap_valid_bitmapQ_except addToBitmap_bitmapQ)
+  apply (fastforce elim: valid_bitmap_valid_bitmapQ_exceptE)
+  done
 
 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>"
@@ -2676,12 +3876,6 @@ lemma threadGet_const_tcb_at_imp_lift:
   apply (clarsimp simp: obj_at'_def)
   done
 
-lemma valid_queues_no_bitmap_objD:
-  "\<lbrakk> valid_queues_no_bitmap s; t \<in> set (ksReadyQueues s (d, p))\<rbrakk>
-   \<Longrightarrow> obj_at' (inQ d p and runnable' \<circ> tcbState) t s"
-   unfolding valid_queues_no_bitmap_def
-   by blast
-
 lemma setQueue_bitmapQ_no_L1_orphans[wp]:
   "\<lbrace> bitmapQ_no_L1_orphans \<rbrace>
        setQueue d p ts
@@ -2701,126 +3895,6 @@ lemma setQueue_sets_queue[wp]:
   unfolding setQueue_def
   by (wp, simp)
 
-lemma tcbSchedEnqueueOrAppend_valid_queues:
-  (* f is either (t#ts) or (ts @ [t]), so we define its properties generally *)
-  assumes f_set[simp]: "\<And>ts. t \<in> set (f ts)"
-  assumes f_set_insert[simp]: "\<And>ts. set (f ts) = insert t (set ts)"
-  assumes f_not_empty[simp]: "\<And>ts. f ts \<noteq> []"
-  assumes f_distinct: "\<And>ts. \<lbrakk> distinct ts ; t \<notin> set ts \<rbrakk> \<Longrightarrow> distinct (f ts)"
-  shows "\<lbrace>Invariants_H.valid_queues and st_tcb_at' runnable' t and valid_objs' \<rbrace>
-    do queued \<leftarrow> threadGet tcbQueued t;
-       unless queued $
-       do tdom \<leftarrow> threadGet tcbDomain t;
-          prio \<leftarrow> threadGet tcbPriority t;
-          queue \<leftarrow> getQueue tdom prio;
-          setQueue tdom prio $ f queue;
-          when (null queue) $ addToBitmap tdom prio;
-          threadSet (tcbQueued_update (\<lambda>_. True)) t
-       od
-    od
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-proof -
-
-  define could_run where "could_run ==
-    \<lambda>d p t. obj_at' (\<lambda>tcb. inQ d p (tcbQueued_update (\<lambda>_. True) tcb) \<and> runnable' (tcbState tcb)) t"
-
-  have addToBitmap_could_run:
-  "\<And>d p. \<lbrace>\<lambda>s. \<forall>d p. t \<in> set (ksReadyQueues s (d, p)) \<longrightarrow> could_run d p t s\<rbrace>
-         addToBitmap d p
-         \<lbrace>\<lambda>_ s. \<forall>d p. t \<in> set (ksReadyQueues s (d, p)) \<longrightarrow> could_run d p t s\<rbrace>"
-    unfolding bitmap_fun_defs
-    by (wp, clarsimp simp: could_run_def)
-
-  have setQueue_valid_queues_no_bitmap_except:
-    "\<And>d p ts.
-     \<lbrace> valid_queues_no_bitmap_except t and
-       (\<lambda>s. ksReadyQueues s (d, p) = ts \<and> p \<le> maxPriority \<and> d \<le> maxDomain \<and> t \<notin> set ts) \<rbrace>
-         setQueue d p (f ts)
-     \<lbrace>\<lambda>rv. valid_queues_no_bitmap_except t\<rbrace>"
-    unfolding setQueue_def valid_queues_no_bitmap_except_def null_def
-    by (wp, auto intro: f_distinct)
-
-  have threadSet_valid_queues_could_run:
-   "\<And>f. \<lbrace> valid_queues_no_bitmap_except t and
-          (\<lambda>s. \<forall>d p. t \<in> set (ksReadyQueues s (d,p)) \<longrightarrow> could_run d p t s) and
-          valid_bitmapQ and bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans \<rbrace>
-            threadSet (tcbQueued_update (\<lambda>_. True)) t
-         \<lbrace>\<lambda>rv. Invariants_H.valid_queues \<rbrace>"
-    unfolding threadSet_def could_run_def
-    apply (rule hoare_seq_ext[OF _ getObject_tcb_sp])
-    apply (rule hoare_pre)
-     apply (simp add: valid_queues_def valid_queues_no_bitmap_def)
-     apply (wp setObject_queues_unchanged_tcb hoare_Ball_helper hoare_vcg_all_lift
-               setObject_tcb_strongest)
-    apply (clarsimp simp: valid_queues_no_bitmap_except_def obj_at'_def)
-    done
-
-  have setQueue_could_run: "\<And>d p ts.
-    \<lbrace> valid_queues and (\<lambda>_. t \<in> set ts) and
-      (\<lambda>s. could_run d p t s) \<rbrace>
-    setQueue d p ts
-    \<lbrace>\<lambda>rv s. (\<forall>d p. t \<in> set (ksReadyQueues s (d, p)) \<longrightarrow> could_run d p t s)\<rbrace>"
-    unfolding setQueue_def valid_queues_def could_run_def
-    by wp (fastforce dest: valid_queues_no_bitmap_objD simp: obj_at'_def inQ_def)
-
-  note hoare_vcg_if_lift[wp] hoare_vcg_conj_lift[wp] hoare_vcg_const_imp_lift[wp]
-
-  show ?thesis
-  unfolding tcbSchedEnqueue_def null_def
-  apply (rule hoare_pre)
-   apply (rule hoare_seq_ext)
-    apply (simp add: unless_def)
-    apply (wp threadSet_valid_queues_could_run)
-        apply (wp addToBitmap_could_run addToBitmap_valid_bitmapQ
-                  addToBitmap_valid_queues_no_bitmap_except addToBitmap_bitmapQ_no_L2_orphans)+
-       apply (wp setQueue_valid_queues_no_bitmap_except setQueue_could_run
-                 setQueue_valid_bitmapQ_except setQueue_sets_queue setQueue_valid_bitmapQ)+
-      apply (wp threadGet_const_tcb_at_imp_lift | simp add: if_apply_def2)+
-  apply clarsimp
-  apply (frule pred_tcb_at')
-  apply (frule (1) valid_objs'_maxDomain)
-  apply (frule (1) valid_objs'_maxPriority)
-  apply (clarsimp simp: valid_queues_def st_tcb_at'_def obj_at'_def valid_queues_no_bitmap_exceptI)
-  apply (fastforce dest!: valid_queues_no_bitmap_objD simp: obj_at'_def inQ_def could_run_def)
-  done
-qed
-
-lemma tcbSchedEnqueue_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues
-    and st_tcb_at' runnable' t
-    and valid_objs' \<rbrace>
-     tcbSchedEnqueue t
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-   unfolding tcbSchedEnqueue_def
-   by (fastforce intro:  tcbSchedEnqueueOrAppend_valid_queues)
-
-lemma tcbSchedAppend_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues
-    and st_tcb_at' runnable' t
-    and valid_objs' \<rbrace>
-     tcbSchedAppend t
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-   unfolding tcbSchedAppend_def
-   by (fastforce intro:  tcbSchedEnqueueOrAppend_valid_queues)
-
-lemma rescheduleRequired_valid_queues[wp]:
-  "\<lbrace>\<lambda>s. Invariants_H.valid_queues s \<and> valid_objs' s \<and>
-        weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | wpc | simp)+
-  apply (fastforce simp: weak_sch_act_wf_def elim: valid_objs'_maxDomain valid_objs'_maxPriority)
-  done
-
-lemma rescheduleRequired_valid_queues_sch_act_simple:
-  "\<lbrace>Invariants_H.valid_queues and sch_act_simple\<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | wpc | simp | fastforce simp: Invariants_H.valid_queues_def sch_act_simple_def)+
-  done
-
 lemma rescheduleRequired_valid_bitmapQ_sch_act_simple:
   "\<lbrace> valid_bitmapQ and sch_act_simple\<rbrace>
     rescheduleRequired
@@ -2862,151 +3936,32 @@ lemma rescheduleRequired_bitmapQ_no_L2_orphans_sch_act_simple:
 
 lemma sts_valid_bitmapQ_sch_act_simple:
   "\<lbrace>valid_bitmapQ and sch_act_simple\<rbrace>
-    setThreadState st t
+   setThreadState st t
    \<lbrace>\<lambda>_. valid_bitmapQ \<rbrace>"
   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 Invariants_H.valid_queues_def inQ_def)+
+   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>"
+  "\<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 Invariants_H.valid_queues_def inQ_def)+
+   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>bitmapQ_no_L1_orphans and sch_act_simple\<rbrace>
+   setThreadState st t
    \<lbrace>\<lambda>_. bitmapQ_no_L1_orphans \<rbrace>"
   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 Invariants_H.valid_queues_def inQ_def)+
-  done
-
-lemma sts_valid_queues:
-  "\<lbrace>\<lambda>s. Invariants_H.valid_queues s \<and>
-    ((\<exists>p. t \<in> set(ksReadyQueues s p)) \<longrightarrow> runnable' st)\<rbrace>
-   setThreadState st t \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: setThreadState_def)
-  apply (wp rescheduleRequired_valid_queues_sch_act_simple
-            threadSet_valid_queues [THEN hoare_strengthen_post])
-   apply (clarsimp simp: sch_act_simple_def Invariants_H.valid_queues_def inQ_def)+
-  done
-
-lemma sbn_valid_queues:
-  "\<lbrace>\<lambda>s. Invariants_H.valid_queues s\<rbrace>
-   setBoundNotification ntfn t \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: setBoundNotification_def)
-  apply (wp threadSet_valid_queues [THEN hoare_strengthen_post])
-   apply (clarsimp simp: sch_act_simple_def Invariants_H.valid_queues_def inQ_def)+
-  done
-
-
-
-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]:
-  "\<lbrace>valid_queues' and st_tcb_at' runnable' t \<rbrace>
-    tcbSchedEnqueue t
-   \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def)
-  apply (rule hoare_pre)
-   apply (rule_tac B="\<lambda>rv. valid_queues' and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"
-           in hoare_seq_ext)
-    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_def)+
-     apply (clarsimp simp: obj_at'_def inQ_def projectKOs valid_queues'_def)
-    apply (wp getObject_tcb_wp | simp add: threadGet_def)+
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-lemma rescheduleRequired_valid_queues'_weak[wp]:
-  "\<lbrace>\<lambda>s. valid_queues' s \<and> weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply wpsimp
-  apply (clarsimp simp: weak_sch_act_wf_def)
-  done
-
-lemma rescheduleRequired_valid_queues'_sch_act_simple:
-  "\<lbrace>valid_queues' and sch_act_simple\<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | wpc | simp | fastforce simp: valid_queues'_def sch_act_simple_def)+
-  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)
-  apply (wp rescheduleRequired_valid_queues'_sch_act_simple)
-  apply (rule_tac Q="\<lambda>_. valid_queues'" in hoare_post_imp)
-   apply (clarsimp simp: sch_act_simple_def)
-  apply (wp threadSet_valid_queues')
-  apply (fastforce simp: inQ_def obj_at'_def pred_tcb_at'_def)
-  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 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)
-  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)
-  apply (wp threadSet_valid_objs' | clarsimp simp: valid_tcb'_tcbState_update)+
-  done
-
-lemma rescheduleRequired_ksQ:
-  "\<lbrace>\<lambda>s. sch_act_simple s \<and> P (ksReadyQueues s p)\<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_ s. P (ksReadyQueues s p)\<rbrace>"
-  including no_pre
-  apply (simp add: rescheduleRequired_def sch_act_simple_def)
-  apply (rule_tac B="\<lambda>rv s. (rv = ResumeCurrentThread \<or> rv = ChooseNewThread)
-                            \<and> P (ksReadyQueues s p)" in hoare_seq_ext)
-   apply wpsimp
-   apply (case_tac x; simp)
-  apply wp
+   apply (clarsimp simp: sch_act_simple_def inQ_def)+
   done
 
 lemma setSchedulerAction_ksQ[wp]:
@@ -3021,17 +3976,6 @@ lemma sbn_ksQ:
   "\<lbrace>\<lambda>s. P (ksReadyQueues s p)\<rbrace> setBoundNotification ntfn t \<lbrace>\<lambda>rv s. P (ksReadyQueues s p)\<rbrace>"
   by (simp add: setBoundNotification_def, wp)
 
-lemma sts_ksQ:
-  "\<lbrace>\<lambda>s. sch_act_simple s \<and> P (ksReadyQueues s p)\<rbrace>
-    setThreadState st t
-   \<lbrace>\<lambda>_ s. P (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: setThreadState_def)
-  apply (wp rescheduleRequired_ksQ)
-  apply (rule_tac Q="\<lambda>_ s. P (ksReadyQueues s p)" in hoare_post_imp)
-   apply (clarsimp simp: sch_act_simple_def)+
-  apply (wp, simp)
-  done
-
 lemma setQueue_ksQ[wp]:
   "\<lbrace>\<lambda>s. P ((ksReadyQueues s)((d, p) := q))\<rbrace>
      setQueue d p q
@@ -3039,22 +3983,6 @@ lemma setQueue_ksQ[wp]:
   by (simp add: setQueue_def fun_upd_def[symmetric]
            | wp)+
 
-lemma tcbSchedEnqueue_ksQ:
-  "\<lbrace>\<lambda>s. t' \<notin> set (ksReadyQueues s p) \<and> t' \<noteq> t \<rbrace>
-   tcbSchedEnqueue t \<lbrace>\<lambda>_ s. t' \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply (wpsimp wp: hoare_vcg_imp_lift threadGet_wp)
-  apply (drule obj_at_ko_at')
-  apply fastforce
-  done
-
-lemma rescheduleRequired_ksQ':
-  "\<lbrace>\<lambda>s. t \<notin> set (ksReadyQueues s p) \<and> sch_act_not t s \<rbrace>
-   rescheduleRequired \<lbrace>\<lambda>_ s. t \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wpsimp wp: tcbSchedEnqueue_ksQ)
-  done
-
 lemma threadSet_tcbState_st_tcb_at':
   "\<lbrace>\<lambda>s. P st \<rbrace> threadSet (tcbState_update (\<lambda>_. st)) t \<lbrace>\<lambda>_. st_tcb_at' P t\<rbrace>"
   apply (simp add: threadSet_def pred_tcb_at'_def)
@@ -3065,36 +3993,6 @@ lemma isRunnable_const:
   "\<lbrace>st_tcb_at' runnable' t\<rbrace> isRunnable t \<lbrace>\<lambda>runnable _. runnable \<rbrace>"
   by (rule isRunnable_wp)
 
-lemma sts_ksQ':
-  "\<lbrace>\<lambda>s. (runnable' st \<or> ksCurThread s \<noteq> t) \<and> P (ksReadyQueues s p)\<rbrace>
-   setThreadState st t
-   \<lbrace>\<lambda>_ s. P (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: setThreadState_def)
-  apply (rule hoare_pre_disj')
-   apply (rule hoare_seq_ext [OF _
-                 hoare_vcg_conj_lift
-                   [OF threadSet_tcbState_st_tcb_at' [where P=runnable']
-                       threadSet_ksQ]])
-   apply (rule hoare_seq_ext [OF _
-                 hoare_vcg_conj_lift [OF isRunnable_const isRunnable_inv]])
-   apply (clarsimp simp: when_def)
-   apply (case_tac x)
-    apply (clarsimp, wp)[1]
-   apply (clarsimp)
-  apply (rule hoare_seq_ext [OF _
-                hoare_vcg_conj_lift
-                  [OF threadSet_ct threadSet_ksQ]])
-  apply (rule hoare_seq_ext [OF _ isRunnable_inv])
-  apply (rule hoare_seq_ext [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 valid_ipc_buffer_ptr'D:
   assumes yv: "y < unat max_ipc_words"
   and    buf: "valid_ipc_buffer_ptr' a s"
@@ -3212,14 +4110,16 @@ lemmas msgRegisters_unfold
          unfolded toEnum_def enum_register, simplified]
 
 lemma getMRs_corres:
-  "corres (=) (tcb_at t)
-              (tcb_at' t and case_option \<top> valid_ipc_buffer_ptr' buf)
+  "corres (=) (tcb_at t and pspace_aligned and pspace_distinct)
+              (case_option \<top> valid_ipc_buffer_ptr' buf)
               (get_mrs t buf mi) (getMRs t buf (message_info_map mi))"
   proof -
   have S: "get = gets id"
     by (simp add: gets_def)
-  have T: "corres (\<lambda>con regs. regs = map con msg_registers) (tcb_at t) (tcb_at' t)
-     (thread_get (arch_tcb_get_registers o tcb_arch) t) (asUser t (mapM getRegister ARM_H.msgRegisters))"
+  have T: "corres (\<lambda>con regs. regs = map con msg_registers)
+                  (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 (rule asUser_corres')
@@ -3303,8 +4203,8 @@ lemma storeWordUser_valid_ipc_buffer_ptr' [wp]:
 lemma setMRs_corres:
   assumes m: "mrs' = mrs"
   shows
-  "corres (=) (tcb_at t and case_option \<top> in_user_frame buf)
-              (tcb_at' t and case_option \<top> valid_ipc_buffer_ptr' buf)
+  "corres (=) (tcb_at t and pspace_aligned and pspace_distinct and case_option \<top> in_user_frame buf)
+              (case_option \<top> valid_ipc_buffer_ptr' buf)
               (set_mrs t buf mrs) (setMRs t buf mrs')"
 proof -
   have setRegister_def2: "setRegister = (\<lambda>r v. modify (\<lambda>s. s ( r := v )))"
@@ -3364,13 +4264,12 @@ proof -
 qed
 
 lemma copyMRs_corres:
-  "corres (=) (tcb_at s and tcb_at r
+  "corres (=) (tcb_at s and tcb_at r and pspace_aligned and pspace_distinct
                and case_option \<top> in_user_frame sb
                and case_option \<top> in_user_frame rb
                and K (unat n \<le> msg_max_length))
-              (tcb_at' s and tcb_at' r
-               and case_option \<top> valid_ipc_buffer_ptr' sb
-               and case_option \<top> valid_ipc_buffer_ptr' rb)
+              (case_option \<top> valid_ipc_buffer_ptr' sb
+                and case_option \<top> valid_ipc_buffer_ptr' rb)
               (copy_mrs s sb r rb n) (copyMRs s sb r rb n)"
 proof -
   have U: "unat n \<le> msg_max_length \<Longrightarrow>
@@ -3380,7 +4279,7 @@ proof -
   note R=R'[simplified]
 
   have as_user_bit:
-    "\<And>v :: word32. corres dc (tcb_at s and tcb_at r) (tcb_at' s and tcb_at' r)
+    "\<And>v :: word32. corres dc (tcb_at s and tcb_at r and pspace_aligned and pspace_distinct) \<top>
            (mapM
              (\<lambda>ra. do v \<leftarrow> as_user s (getRegister ra);
                       as_user r (setRegister ra v)
@@ -3523,7 +4422,7 @@ qed
 lemmas valid_ipc_buffer_cap_simps = valid_ipc_buffer_cap_def [split_simps cap.split arch_cap.split]
 
 lemma lookupIPCBuffer_corres':
-  "corres (=) (tcb_at t and valid_objs and pspace_aligned)
+  "corres (=) (tcb_at t and valid_objs and pspace_aligned and pspace_distinct)
                (tcb_at' t and valid_objs' and pspace_aligned'
                 and pspace_distinct' and no_0_obj')
                (lookup_ipc_buffer w t) (lookupIPCBuffer w t)"
@@ -3635,7 +4534,7 @@ lemma ct_in_state'_set:
 
 crunches setQueue, rescheduleRequired, tcbSchedDequeue
   for idle'[wp]: "valid_idle'"
-  (simp: crunch_simps )
+  (simp: crunch_simps wp: crunch_wps)
 
 lemma sts_valid_idle'[wp]:
   "\<lbrace>valid_idle' and valid_pspace' and
@@ -3675,8 +4574,9 @@ lemma gbn_sp':
 
 lemma tcbSchedDequeue_tcbState_obj_at'[wp]:
   "\<lbrace>obj_at' (P \<circ> tcbState) t'\<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>rv. obj_at' (P \<circ> tcbState) t'\<rbrace>"
-  apply (simp add: tcbSchedDequeue_def)
-  apply (wp | simp add: o_def split del: if_split cong: if_cong)+
+  apply (simp add: tcbSchedDequeue_def tcbQueueRemove_def)
+  apply (wpsimp wp: getObject_tcb_wp simp: o_def threadGet_def)
+  apply (clarsimp simp: obj_at'_def)
   done
 
 crunch typ_at'[wp]: setQueue "\<lambda>s. P' (typ_at' P t s)"
@@ -3695,10 +4595,14 @@ lemma setQueue_pred_tcb_at[wp]:
 lemma tcbSchedDequeue_pred_tcb_at'[wp]:
   "\<lbrace>\<lambda>s. P' (pred_tcb_at' proj P t' s)\<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>_ s. P' (pred_tcb_at' proj P t' s)\<rbrace>"
   apply (rule_tac P=P' in P_bool_lift)
-   apply (simp add: tcbSchedDequeue_def)
-   apply (wp threadSet_pred_tcb_no_state | clarsimp simp: tcb_to_itcb'_def)+
-  apply (simp add: tcbSchedDequeue_def)
-  apply (wp threadSet_pred_tcb_no_state | clarsimp simp: tcb_to_itcb'_def)+
+   apply (simp add: tcbSchedDequeue_def tcbQueueRemove_def)
+   apply (wpsimp wp: threadSet_pred_tcb_no_state getObject_tcb_wp
+               simp: threadGet_def tcb_to_itcb'_def)
+   apply (clarsimp simp: obj_at'_def)
+  apply (simp add: tcbSchedDequeue_def tcbQueueRemove_def)
+  apply (wpsimp wp: threadSet_pred_tcb_no_state getObject_tcb_wp
+              simp: threadGet_def tcb_to_itcb'_def)
+  apply (clarsimp simp: obj_at'_def)
   done
 
 lemma sts_st_tcb':
@@ -3783,39 +4687,155 @@ crunch nonz_cap[wp]: addToBitmap "ex_nonz_cap_to' t"
 crunch iflive'[wp]: removeFromBitmap if_live_then_nonz_cap'
 crunch nonz_cap[wp]: removeFromBitmap "ex_nonz_cap_to' t"
 
-lemma tcbSchedEnqueue_iflive'[wp]:
-  "\<lbrace>if_live_then_nonz_cap' and ex_nonz_cap_to' tcb\<rbrace>
-    tcbSchedEnqueue tcb \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply (wp threadSet_iflive' hoare_drop_imps | simp add: crunch_simps)+
+crunches rescheduleRequired
+  for cap_to'[wp]: "ex_nonz_cap_to' p"
+
+lemma tcbQueued_update_tcb_cte_cases:
+  "(getF, setF) \<in> ran tcb_cte_cases \<Longrightarrow> getF (tcbQueued_update f tcb) = getF tcb"
+  unfolding tcb_cte_cases_def
+  by (case_tac tcb; fastforce simp: objBits_simps')
+
+lemma tcbSchedNext_update_tcb_cte_cases:
+  "(getF, setF) \<in> ran tcb_cte_cases \<Longrightarrow> getF (tcbSchedNext_update f tcb) = getF tcb"
+  unfolding tcb_cte_cases_def
+  by (case_tac tcb; fastforce simp: objBits_simps')
+
+lemma tcbSchedPrev_update_tcb_cte_cases:
+  "(getF, setF) \<in> ran tcb_cte_cases \<Longrightarrow> getF (tcbSchedPrev_update f tcb) = getF tcb"
+  unfolding tcb_cte_cases_def
+  by (case_tac tcb; fastforce simp: objBits_simps')
+
+lemma tcbSchedNext_update_ctes_of[wp]:
+  "threadSet (tcbSchedNext_update f) tptr \<lbrace>\<lambda>s. P (ctes_of s)\<rbrace>"
+  by (wpsimp wp: threadSet_ctes_ofT simp: tcbSchedNext_update_tcb_cte_cases)
+
+lemma tcbSchedPrev_update_ctes_of[wp]:
+  "threadSet (tcbSchedPrev_update f) tptr \<lbrace>\<lambda>s. P (ctes_of s)\<rbrace>"
+  by (wpsimp wp: threadSet_ctes_ofT simp: tcbSchedPrev_update_tcb_cte_cases)
+
+lemma tcbSchedNext_ex_nonz_cap_to'[wp]:
+  "threadSet (tcbSchedNext_update f) tptr \<lbrace>ex_nonz_cap_to' p\<rbrace>"
+  by (wpsimp wp: threadSet_cap_to simp: tcbSchedNext_update_tcb_cte_cases)
+
+lemma tcbSchedPrev_ex_nonz_cap_to'[wp]:
+  "threadSet (tcbSchedPrev_update f) tptr \<lbrace>ex_nonz_cap_to' p\<rbrace>"
+  by (wpsimp wp: threadSet_cap_to simp: tcbSchedPrev_update_tcb_cte_cases)
+
+lemma tcbSchedNext_update_iflive':
+  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s \<and> ex_nonz_cap_to' t s\<rbrace>
+   threadSet (tcbSchedNext_update f) t
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  by (wpsimp wp: threadSet_iflive'T simp: tcbSchedNext_update_tcb_cte_cases)
+
+lemma tcbSchedPrev_update_iflive':
+  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s \<and> ex_nonz_cap_to' t s\<rbrace>
+   threadSet (tcbSchedPrev_update f) t
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  by (wpsimp wp: threadSet_iflive'T simp: tcbSchedPrev_update_tcb_cte_cases)
+
+lemma tcbQueued_update_iflive'[wp]:
+  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s \<and> ex_nonz_cap_to' t s\<rbrace>
+   threadSet (tcbQueued_update f) t
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  by (wpsimp wp: threadSet_iflive'T simp: tcbQueued_update_tcb_cte_cases)
+
+lemma getTCB_wp:
+  "\<lbrace>\<lambda>s. \<forall>ko :: tcb. ko_at' ko p s \<longrightarrow> Q ko s\<rbrace> getObject p \<lbrace>Q\<rbrace>"
+  apply (wpsimp wp: getObject_tcb_wp)
+  apply (clarsimp simp: obj_at'_def)
   done
 
-lemma rescheduleRequired_iflive'[wp]:
-  "\<lbrace>if_live_then_nonz_cap'
-        and (\<lambda>s. \<forall>t. ksSchedulerAction s = SwitchToThread t
-                \<longrightarrow> st_tcb_at' runnable' t s)\<rbrace>
-      rescheduleRequired
-   \<lbrace>\<lambda>rv. if_live_then_nonz_cap'\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | wpc | simp)+
-  apply (clarsimp simp: pred_tcb_at'_def obj_at'_real_def)
-  apply (erule(1) if_live_then_nonz_capD')
-  apply (fastforce simp: projectKOs)
+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]:
+  "tcbQueueRemove q tcbPtr \<lbrace>ex_nonz_cap_to' tcbPtr'\<rbrace>"
+  unfolding tcbQueueRemove_def
+  by (wpsimp wp: threadSet_cap_to' hoare_drop_imps getTCB_wp)
+
+(* We could write this one as "\<forall>t. tcbQueueHead t \<longrightarrow> ..." instead, but we can't do the same in
+   tcbQueueAppend_if_live_then_nonz_cap', and it's nicer if the two lemmas are symmetric *)
+lemma tcbQueuePrepend_if_live_then_nonz_cap':
+  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s \<and> ex_nonz_cap_to' tcbPtr s
+        \<and> (\<not> tcbQueueEmpty q \<longrightarrow> ex_nonz_cap_to' (the (tcbQueueHead q)) s)\<rbrace>
+   tcbQueuePrepend q tcbPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  unfolding tcbQueuePrepend_def
+  by (wpsimp wp: tcbSchedPrev_update_iflive' tcbSchedNext_update_iflive'
+                 hoare_vcg_if_lift2 hoare_vcg_imp_lift')
+
+lemma tcbQueueAppend_if_live_then_nonz_cap':
+  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s \<and> ex_nonz_cap_to' tcbPtr s
+        \<and> (\<not> tcbQueueEmpty q \<longrightarrow> ex_nonz_cap_to' (the (tcbQueueEnd q)) s)\<rbrace>
+   tcbQueueAppend q tcbPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  unfolding tcbQueueAppend_def
+  by (wpsimp wp: tcbSchedPrev_update_iflive' tcbSchedNext_update_iflive')
+
+lemma tcbQueueInsert_if_live_then_nonz_cap':
+  "\<lbrace>if_live_then_nonz_cap' and ex_nonz_cap_to' tcbPtr and valid_objs' and sym_heap_sched_pointers\<rbrace>
+   tcbQueueInsert tcbPtr afterPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  unfolding tcbQueueInsert_def
+  apply (wpsimp wp: tcbSchedPrev_update_iflive' tcbSchedNext_update_iflive' getTCB_wp)
+  apply (intro conjI)
+   apply (erule if_live_then_nonz_capE')
+   apply (clarsimp simp: ko_wp_at'_def obj_at'_def projectKOs)
+  apply (erule if_live_then_nonz_capE')
+  apply (frule_tac p'=afterPtr in sym_heapD2)
+   apply (fastforce simp: opt_map_def obj_at'_def projectKOs)
+  apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+  apply (clarsimp simp: valid_tcb'_def ko_wp_at'_def obj_at'_def projectKOs opt_map_def)
+  done
+
+lemma tcbSchedEnqueue_iflive'[wp]:
+  "\<lbrace>if_live_then_nonz_cap' and pspace_aligned' and pspace_distinct'\<rbrace>
+   tcbSchedEnqueue tcbPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  unfolding tcbSchedEnqueue_def
+  apply (wpsimp wp: tcbQueuePrepend_if_live_then_nonz_cap' threadGet_wp)
+  apply normalise_obj_at'
+  apply (rename_tac tcb)
+  apply (frule_tac p=tcbPtr in if_live_then_nonz_capE')
+   apply (fastforce simp: ko_wp_at'_def obj_at'_def projectKOs)
+  apply clarsimp
+  apply (erule if_live_then_nonz_capE')
+  apply (clarsimp simp: ksReadyQueues_asrt_def)
+  apply (drule_tac x="tcbDomain tcb" in spec)
+  apply (drule_tac x="tcbPriority tcb" in spec)
+  apply (fastforce dest!: obj_at'_tcbQueueHead_ksReadyQueues
+                    simp: ready_queue_relation_def ko_wp_at'_def inQ_def opt_pred_def opt_map_def
+                          obj_at'_def projectKOs
+                   split: option.splits)
   done
 
+crunches rescheduleRequired
+  for iflive'[wp]: if_live_then_nonz_cap'
+
 lemma sts_iflive'[wp]:
   "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s
-      \<and> (st \<noteq> Inactive \<and> \<not> idle' st \<longrightarrow> ex_nonz_cap_to' t s)\<rbrace>
+      \<and> (st \<noteq> Inactive \<and> \<not> idle' st \<longrightarrow> ex_nonz_cap_to' t s)
+      \<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 setQueue_def)
-  apply (rule hoare_pre)
-   apply (wp | simp)+
-      apply (rule_tac Q="\<lambda>rv. if_live_then_nonz_cap'" in hoare_post_imp)
-       apply clarsimp
-      apply (wp threadSet_iflive' | simp)+
-   apply auto
- done
+  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
+  done
 
 lemma sbn_iflive'[wp]:
   "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s
@@ -3928,6 +4948,19 @@ lemma setBoundNotification_vms'[wp]:
   apply (intro hoare_vcg_all_lift hoare_vcg_disj_lift; wp)
   done
 
+lemma threadSet_ct_not_inQ:
+  "(\<And>tcb. tcbQueued tcb = tcbQueued (F tcb))
+   \<Longrightarrow> threadSet F tcbPtr \<lbrace>\<lambda>s. P (ct_not_inQ s)\<rbrace>"
+  unfolding threadSet_def
+  apply (wpsimp wp: getTCB_wp simp: setObject_def updateObject_default_def)
+  apply (erule rsubst[where P=P])
+  by (fastforce simp: ct_not_inQ_def obj_at'_def projectKOs objBits_simps ps_clear_def
+               split: if_splits)
+
+crunches tcbQueuePrepend, tcbQueueAppend, tcbQueueInsert, tcbQueueRemove, addToBitmap
+  for ct_not_inQ[wp]: ct_not_inQ
+  (wp: threadSet_ct_not_inQ crunch_wps)
+
 lemma tcbSchedEnqueue_ct_not_inQ:
   "\<lbrace>ct_not_inQ and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t)\<rbrace>
     tcbSchedEnqueue t \<lbrace>\<lambda>_. ct_not_inQ\<rbrace>"
@@ -3951,12 +4984,7 @@ lemma tcbSchedEnqueue_ct_not_inQ:
       done
     show ?thesis
       apply (simp add: tcbSchedEnqueue_def unless_def null_def)
-      apply (wp ts sq hoare_convert_imp [OF addToBitmap_nosch addToBitmap_ct'])+
-           apply (rule_tac Q="\<lambda>_. ?PRE" in hoare_post_imp, clarsimp)
-           apply (wp sq hoare_convert_imp [OF setQueue_nosch setQueue_ct])+
-       apply (rule_tac Q="\<lambda>_. ?PRE" in hoare_post_imp, clarsimp)
-       apply wp
-      apply assumption
+      apply (wpsimp wp: ts sq hoare_vcg_imp_lift' getTCB_wp simp: threadGet_def)+
       done
   qed
 
@@ -3983,12 +5011,7 @@ lemma tcbSchedAppend_ct_not_inQ:
       done
     show ?thesis
       apply (simp add: tcbSchedAppend_def unless_def null_def)
-      apply (wp ts sq hoare_convert_imp [OF addToBitmap_nosch addToBitmap_ct'])+
-           apply (rule_tac Q="\<lambda>_. ?PRE" in hoare_post_imp, clarsimp)
-           apply (wp sq hoare_convert_imp [OF setQueue_nosch setQueue_ct])+
-       apply (rule_tac Q="\<lambda>_. ?PRE" in hoare_post_imp, clarsimp)
-       apply wp
-      apply assumption
+      apply (wpsimp wp: ts sq hoare_vcg_imp_lift' getTCB_wp simp: threadGet_def)+
       done
   qed
 
@@ -4017,12 +5040,10 @@ lemma rescheduleRequired_sa_cnt[wp]:
 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>"
-  (is "\<lbrace>?PRE\<rbrace> _ \<lbrace>_\<rbrace>")
   apply (simp add: possibleSwitchTo_def curDomain_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)
+         | (rule hoare_post_imp[OF _ rescheduleRequired_sa_cnt], fastforce))+
   done
 
 lemma threadSet_tcbState_update_ct_not_inQ[wp]:
@@ -4102,29 +5123,6 @@ lemma tcbSchedDequeue_ct_not_inQ[wp]:
       done
   qed
 
-lemma tcbSchedEnqueue_not_st:
-  "(\<And>tcb st qd. P (tcb\<lparr>tcbState := st, tcbQueued := qd\<rparr>) \<longleftrightarrow> P tcb)
-     \<Longrightarrow> \<lbrace>obj_at' P t'\<rbrace> tcbSchedEnqueue t \<lbrace>\<lambda>_. obj_at' P t'\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply (wp threadGet_wp | simp)+
-  apply (clarsimp simp: obj_at'_def)
-  apply (case_tac obja)
-  apply fastforce
-  done
-
-lemma setThreadState_not_st:
-  "(\<And>tcb st qd. P (tcb\<lparr>tcbState := st, tcbQueued := qd\<rparr>) \<longleftrightarrow> P tcb)
-     \<Longrightarrow> \<lbrace>obj_at' P t'\<rbrace> setThreadState st t \<lbrace>\<lambda>_. obj_at' P t'\<rbrace>"
-  apply (simp add: setThreadState_def rescheduleRequired_def)
-  apply (wp hoare_vcg_conj_lift tcbSchedEnqueue_not_st
-          | wpc
-          | rule hoare_drop_imps
-          | simp)+
-  apply (clarsimp simp: obj_at'_def)
-  apply (case_tac obj)
-  apply fastforce
-  done
-
 crunch ct_idle_or_in_cur_domain'[wp]: setQueue ct_idle_or_in_cur_domain'
   (simp: ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def)
 
@@ -4153,17 +5151,8 @@ lemma removeFromBitmap_ct_idle_or_in_cur_domain'[wp]:
            | clarsimp simp: updateObject_default_def in_monad setNotification_def)+
   done
 
-lemma tcbSchedEnqueue_ksCurDomain[wp]:
-  "\<lbrace> \<lambda>s. P (ksCurDomain s)\<rbrace> tcbSchedEnqueue tptr \<lbrace>\<lambda>_ s. P (ksCurDomain s)\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply wpsimp
-  done
-
-lemma tcbSchedEnqueue_ksDomSchedule[wp]:
-  "\<lbrace> \<lambda>s. P (ksDomSchedule s)\<rbrace> tcbSchedEnqueue tptr \<lbrace>\<lambda>_ s. P (ksDomSchedule s)\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply wpsimp
-  done
+crunches tcbQueuePrepend
+  for ct_idle_or_in_cur_domain'[wp]: ct_idle_or_in_cur_domain'
 
 lemma tcbSchedEnqueue_ct_idle_or_in_cur_domain'[wp]:
   "\<lbrace>ct_idle_or_in_cur_domain'\<rbrace> tcbSchedEnqueue tptr \<lbrace>\<lambda>_. ct_idle_or_in_cur_domain'\<rbrace>"
@@ -4241,12 +5230,383 @@ lemma sts_utr[wp]:
   apply (wp untyped_ranges_zero_lift)
   done
 
+lemma removeFromBitmap_bitmapQ:
+  "\<lbrace>\<top>\<rbrace> removeFromBitmap d p \<lbrace>\<lambda>_ s. \<not> bitmapQ d p s \<rbrace>"
+  unfolding bitmapQ_defs bitmap_fun_defs
+  by (wpsimp simp: bitmap_fun_defs)
+
+lemma removeFromBitmap_valid_bitmapQ[wp]:
+  "\<lbrace>valid_bitmapQ_except d p and bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans
+    and (\<lambda>s. tcbQueueEmpty (ksReadyQueues s (d,p)))\<rbrace>
+   removeFromBitmap d p
+   \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
+  (is "\<lbrace>?pre\<rbrace> _ \<lbrace>_\<rbrace>")
+  apply (rule_tac Q="\<lambda>_ s. ?pre s \<and> \<not> bitmapQ d p s" in hoare_strengthen_post)
+   apply (wpsimp wp: removeFromBitmap_valid_bitmapQ_except removeFromBitmap_bitmapQ)
+  apply (fastforce elim: valid_bitmap_valid_bitmapQ_exceptE)
+  done
+
+crunches tcbSchedDequeue
+  for bitmapQ_no_L1_orphans[wp]: bitmapQ_no_L1_orphans
+  and bitmapQ_no_L2_orphans[wp]: bitmapQ_no_L2_orphans
+  (wp: crunch_wps simp: crunch_simps)
+
+lemma setQueue_nonempty_valid_bitmapQ':
+  "\<lbrace>\<lambda>s. valid_bitmapQ s \<and> \<not> tcbQueueEmpty (ksReadyQueues s (d, p))\<rbrace>
+   setQueue d p queue
+   \<lbrace>\<lambda>_ s. \<not> tcbQueueEmpty queue \<longrightarrow> valid_bitmapQ s\<rbrace>"
+  apply (wpsimp simp: setQueue_def)
+  apply (fastforce simp: valid_bitmapQ_def bitmapQ_def)
+  done
+
+lemma threadSet_valid_bitmapQ_except[wp]:
+  "threadSet f tcbPtr \<lbrace>valid_bitmapQ_except d p\<rbrace>"
+  unfolding threadSet_def
+  apply (wpsimp wp: getTCB_wp simp: setObject_def updateObject_default_def)
+  apply (clarsimp simp: valid_bitmapQ_except_def bitmapQ_def)
+  done
+
+lemma threadSet_bitmapQ:
+  "threadSet F t \<lbrace>bitmapQ domain priority\<rbrace>"
+  unfolding threadSet_def
+  apply (wpsimp wp: getTCB_wp simp: setObject_def updateObject_default_def)
+  by (clarsimp simp: bitmapQ_def)
+
+crunches tcbQueueRemove, tcbQueuePrepend, tcbQueueAppend
+  for valid_bitmapQ_except[wp]: "valid_bitmapQ_except d p"
+  and valid_bitmapQ[wp]: valid_bitmapQ
+  and bitmapQ[wp]: "bitmapQ tdom prio"
+  (wp: crunch_wps)
+
+lemma tcbQueued_imp_queue_nonempty:
+  "\<lbrakk>list_queue_relation ts (ksReadyQueues s (tcbDomain tcb, tcbPriority tcb)) nexts prevs;
+    \<forall>t. t \<in> set ts \<longleftrightarrow> (inQ (tcbDomain tcb) (tcbPriority tcb) |< tcbs_of' s) t;
+    ko_at' tcb tcbPtr s; tcbQueued tcb\<rbrakk>
+   \<Longrightarrow> \<not> tcbQueueEmpty (ksReadyQueues s (tcbDomain tcb, tcbPriority tcb))"
+  apply (clarsimp simp: list_queue_relation_def tcbQueueEmpty_def)
+  apply (drule_tac x=tcbPtr in spec)
+  apply (fastforce dest: heap_path_head
+                   simp: inQ_def opt_map_def opt_pred_def obj_at'_def projectKOs)
+  done
+
+lemma tcbSchedDequeue_valid_bitmapQ[wp]:
+  "\<lbrace>valid_bitmaps\<rbrace> tcbSchedDequeue tcbPtr \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
+  unfolding tcbSchedDequeue_def tcbQueueRemove_def
+  apply (wpsimp wp: setQueue_nonempty_valid_bitmapQ' hoare_vcg_conj_lift
+                    hoare_vcg_if_lift2 hoare_vcg_const_imp_lift threadGet_wp
+         | wp (once) hoare_drop_imps)+
+  by (fastforce dest!: tcbQueued_imp_queue_nonempty
+                 simp: ready_queue_relation_def ksReadyQueues_asrt_def obj_at'_def)
+
+lemma tcbSchedDequeue_valid_bitmaps[wp]:
+  "tcbSchedDequeue tcbPtr \<lbrace>valid_bitmaps\<rbrace>"
+  by (wpsimp simp: valid_bitmaps_def)
+
+lemma setQueue_valid_bitmapQ': (* enqueue only *)
+  "\<lbrace>valid_bitmapQ_except d p and bitmapQ d p and K (\<not> tcbQueueEmpty q)\<rbrace>
+   setQueue d p q
+   \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
+  unfolding setQueue_def bitmapQ_defs
+  by (wpsimp simp: bitmapQ_def)
+
+lemma tcbSchedEnqueue_valid_bitmapQ[wp]:
+  "\<lbrace>valid_bitmaps\<rbrace> tcbSchedEnqueue tcbPtr \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
+  supply if_split[split del]
+  unfolding tcbSchedEnqueue_def
+  apply (wpsimp simp: tcbQueuePrepend_def
+                  wp: setQueue_valid_bitmapQ' addToBitmap_valid_bitmapQ_except addToBitmap_bitmapQ
+                      threadGet_wp)
+  apply (fastforce simp: valid_bitmaps_def valid_bitmapQ_def tcbQueueEmpty_def split: if_splits)
+  done
+
+crunches tcbSchedEnqueue, tcbSchedAppend
+  for bitmapQ_no_L1_orphans[wp]: bitmapQ_no_L1_orphans
+  and bitmapQ_no_L2_orphans[wp]: bitmapQ_no_L2_orphans
+
+lemma tcbSchedEnqueue_valid_bitmaps[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>valid_bitmaps\<rbrace>"
+  unfolding valid_bitmaps_def
+  apply wpsimp
+  apply (clarsimp simp: valid_bitmaps_def)
+  done
+
+crunches rescheduleRequired, threadSet, setThreadState
+  for valid_bitmaps[wp]: valid_bitmaps
+  (rule: valid_bitmaps_lift)
+
+lemma tcbSchedEnqueue_valid_sched_pointers[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>valid_sched_pointers\<rbrace>"
+  apply (clarsimp simp: tcbSchedEnqueue_def getQueue_def unless_def)
+  \<comment> \<open>we step forwards until we can step over the addToBitmap in order to avoid state blow-up\<close>
+  apply (intro hoare_seq_ext[OF _ stateAssert_sp] hoare_seq_ext[OF _ isRunnable_inv]
+               hoare_seq_ext[OF _ assert_sp] hoare_seq_ext[OF _ threadGet_sp]
+               hoare_seq_ext[OF _ gets_sp]
+         | rule hoare_when_cases, fastforce)+
+  apply (forward_inv_step wp: hoare_vcg_ex_lift)
+  supply if_split[split del]
+  apply (wpsimp wp: getTCB_wp
+              simp: threadSet_def setObject_def updateObject_default_def tcbQueuePrepend_def
+                    setQueue_def)
+  apply (clarsimp simp: valid_sched_pointers_def)
+  apply (intro conjI impI)
+   apply (fastforce simp: opt_pred_def opt_map_def split: if_splits)
+  apply normalise_obj_at'
+  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: valid_sched_pointers_def list_queue_relation_def)
+  apply (case_tac "ts = []", fastforce simp: tcbQueueEmpty_def)
+  by (intro conjI impI;
+      force dest!: hd_in_set heap_path_head
+             simp: inQ_def opt_pred_def opt_map_def obj_at'_def projectKOs split: if_splits)
+
+lemma tcbSchedAppend_valid_sched_pointers[wp]:
+  "tcbSchedAppend tcbPtr \<lbrace>valid_sched_pointers\<rbrace>"
+  apply (clarsimp simp: tcbSchedAppend_def getQueue_def unless_def)
+  \<comment> \<open>we step forwards until we can step over the addToBitmap in order to avoid state blow-up\<close>
+  apply (intro hoare_seq_ext[OF _ stateAssert_sp] hoare_seq_ext[OF _ isRunnable_inv]
+               hoare_seq_ext[OF _ assert_sp] hoare_seq_ext[OF _ threadGet_sp]
+               hoare_seq_ext[OF _ gets_sp]
+         | rule hoare_when_cases, fastforce)+
+  apply (forward_inv_step wp: hoare_vcg_ex_lift)
+  supply if_split[split del]
+  apply (wpsimp wp: getTCB_wp
+              simp: threadSet_def setObject_def updateObject_default_def tcbQueueAppend_def
+                    setQueue_def)
+  apply (clarsimp simp: valid_sched_pointers_def)
+  apply (intro conjI impI)
+   apply (fastforce simp: opt_pred_def opt_map_def split: if_splits)
+  apply normalise_obj_at'
+  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)
+  by (intro conjI impI;
+      clarsimp dest: last_in_set
+               simp: valid_sched_pointers_def opt_map_def list_queue_relation_def tcbQueueEmpty_def
+                     queue_end_valid_def inQ_def opt_pred_def obj_at'_def projectKOs
+              split: if_splits option.splits;
+      fastforce)
+
+lemma tcbSchedDequeue_valid_sched_pointers[wp]:
+  "\<lbrace>valid_sched_pointers and sym_heap_sched_pointers\<rbrace>
+   tcbSchedDequeue tcbPtr
+   \<lbrace>\<lambda>_. valid_sched_pointers\<rbrace>"
+  supply if_split[split del] fun_upd_apply[simp del]
+  apply (clarsimp simp: tcbSchedDequeue_def getQueue_def setQueue_def)
+  apply (wpsimp wp: threadSet_wp getTCB_wp threadGet_wp simp: tcbQueueRemove_def)
+  apply normalise_obj_at'
+  apply (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 split: if_splits)
+  apply (frule (1) list_queue_relation_neighbour_in_set[where p=tcbPtr])
+   apply (fastforce simp: inQ_def opt_pred_def opt_map_def obj_at'_def projectKOs)
+  apply (clarsimp simp: list_queue_relation_def)
+  apply (intro conjI impI)
+     \<comment> \<open>the ready queue is the singleton consisting of tcbPtr\<close>
+     apply (clarsimp simp: valid_sched_pointers_def)
+     apply (case_tac "ptr = tcbPtr")
+      apply (force dest!: heap_ls_last_None
+                    simp: prev_queue_head_def queue_end_valid_def inQ_def opt_map_def
+                          obj_at'_def projectKOs)
+     apply (simp add: fun_upd_def opt_pred_def)
+    \<comment> \<open>tcbPtr is the head of the ready queue\<close>
+    subgoal
+      by (auto dest!: heap_ls_last_None
+                simp: valid_sched_pointers_def fun_upd_apply prev_queue_head_def
+                      inQ_def opt_pred_def opt_map_def obj_at'_def projectKOs
+               split: if_splits option.splits)
+   \<comment> \<open>tcbPtr is the end of the ready queue\<close>
+   subgoal
+     by (auto dest!: heap_ls_last_None
+               simp: valid_sched_pointers_def queue_end_valid_def inQ_def opt_pred_def
+                     opt_map_def fun_upd_apply obj_at'_def projectKOs
+              split: if_splits option.splits)
+  \<comment> \<open>tcbPtr is in the middle of the ready queue\<close>
+  apply (intro conjI impI allI)
+  by (clarsimp simp: valid_sched_pointers_def inQ_def opt_pred_def opt_map_def fun_upd_apply
+                     obj_at'_def projectKOs
+              split: if_splits option.splits;
+      auto)
+
+lemma tcbQueueRemove_sym_heap_sched_pointers:
+  "\<lbrace>\<lambda>s. sym_heap_sched_pointers s
+        \<and> (\<exists>ts. list_queue_relation ts q (tcbSchedNexts_of s) (tcbSchedPrevs_of s)
+                \<and> tcbPtr \<in> set ts)\<rbrace>
+   tcbQueueRemove q tcbPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  supply heap_path_append[simp del]
+  apply (clarsimp simp: tcbQueueRemove_def)
+  apply (wpsimp wp: threadSet_wp getTCB_wp)
+  apply (rename_tac tcb ts)
+
+  \<comment> \<open>tcbPtr is the head of q, which is not a singleton\<close>
+  apply (rule conjI)
+   apply clarsimp
+   apply (clarsimp simp: list_queue_relation_def Let_def)
+   apply (prop_tac "tcbSchedNext tcb \<noteq> Some tcbPtr")
+    apply (fastforce dest: heap_ls_no_loops[where p=tcbPtr] simp: opt_map_def obj_at'_def projectKOs)
+   apply (fastforce intro: sym_heap_remove_only'
+                     simp: prev_queue_head_def opt_map_red opt_map_upd_triv obj_at'_def projectKOs)
+
+  \<comment> \<open>tcbPtr is the end of q, which is not a singleton\<close>
+  apply (intro impI)
+  apply (rule conjI)
+   apply clarsimp
+   apply (prop_tac "tcbSchedPrev tcb \<noteq> Some tcbPtr")
+    apply (fastforce dest!: heap_ls_prev_no_loops[where p=tcbPtr]
+                      simp: list_queue_relation_def opt_map_def obj_at'_def projectKOs)
+   apply (subst fun_upd_swap, fastforce)
+   apply (fastforce intro: sym_heap_remove_only
+                     simp: opt_map_red opt_map_upd_triv obj_at'_def projectKOs)
+
+  \<comment> \<open>tcbPtr is in the middle of q\<close>
+  apply (intro conjI impI allI)
+  apply (frule (2) list_queue_relation_neighbour_in_set[where p=tcbPtr])
+  apply (frule split_list)
+  apply clarsimp
+  apply (rename_tac xs ys)
+  apply (prop_tac "xs \<noteq> [] \<and> ys \<noteq> []")
+   apply (fastforce simp: list_queue_relation_def queue_end_valid_def)
+  apply (clarsimp simp: list_queue_relation_def)
+  apply (frule (3) ptr_in_middle_prev_next)
+  apply (frule heap_ls_distinct)
+  apply (rename_tac afterPtr beforePtr xs ys)
+  apply (frule_tac before=beforePtr and middle=tcbPtr and after=afterPtr
+                in sym_heap_remove_middle_from_chain)
+      apply (fastforce dest: last_in_set simp: opt_map_def obj_at'_def projectKOs)
+     apply (fastforce dest: hd_in_set simp: opt_map_def obj_at'_def projectKOs)
+    apply (rule_tac hp="tcbSchedNexts_of s" in sym_heapD2)
+     apply fastforce
+    apply (fastforce simp: opt_map_def obj_at'_def projectKOs)
+   apply (fastforce simp: opt_map_def obj_at'_def projectKOs)
+  apply (fastforce simp: fun_upd_swap opt_map_red opt_map_upd_triv obj_at'_def projectKOs
+                  split: if_splits)
+  done
+
+lemma tcbQueuePrepend_sym_heap_sched_pointers:
+  "\<lbrace>\<lambda>s. sym_heap_sched_pointers s
+        \<and> (\<exists>ts. list_queue_relation ts q (tcbSchedNexts_of s) (tcbSchedPrevs_of s)
+                \<and> tcbPtr \<notin> set ts)
+        \<and> tcbSchedNexts_of s tcbPtr = None \<and> tcbSchedPrevs_of s tcbPtr = None\<rbrace>
+   tcbQueuePrepend q tcbPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  supply if_split[split del]
+  apply (clarsimp simp: tcbQueuePrepend_def)
+  apply (wpsimp wp: threadSet_wp)
+  apply (prop_tac "tcbPtr \<noteq> the (tcbQueueHead q)")
+   apply (case_tac "ts = []";
+          fastforce dest: heap_path_head simp: list_queue_relation_def tcbQueueEmpty_def)
+  apply (drule_tac a=tcbPtr and b="the (tcbQueueHead q)" in sym_heap_connect)
+    apply assumption
+   apply (clarsimp simp: list_queue_relation_def prev_queue_head_def tcbQueueEmpty_def)
+  apply (fastforce simp: fun_upd_swap opt_map_red opt_map_upd_triv obj_at'_def projectKOs
+                         tcbQueueEmpty_def)
+  done
+
+lemma tcbQueueInsert_sym_heap_sched_pointers:
+  "\<lbrace>\<lambda>s. sym_heap_sched_pointers s
+        \<and> tcbSchedNexts_of s tcbPtr = None \<and> tcbSchedPrevs_of s tcbPtr = None\<rbrace>
+   tcbQueueInsert tcbPtr afterPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  apply (clarsimp simp: tcbQueueInsert_def)
+  \<comment> \<open>forwards step in order to name beforePtr below\<close>
+  apply (rule hoare_seq_ext[OF _ getObject_tcb_sp])
+  apply (rule hoare_seq_ext[OF _ assert_sp])
+  apply (rule hoare_ex_pre_conj[simplified conj_commute], rename_tac beforePtr)
+  apply (rule hoare_seq_ext[OF _ assert_sp])
+  apply (wpsimp wp: threadSet_wp)
+  apply normalise_obj_at'
+  apply (prop_tac "tcbPtr \<noteq> afterPtr")
+   apply (clarsimp simp: list_queue_relation_def opt_map_red obj_at'_def projectKOs)
+  apply (prop_tac "tcbPtr \<noteq> beforePtr")
+   apply (fastforce dest: sym_heap_None simp: opt_map_def obj_at'_def projectKOs
+                   split: option.splits)
+  apply (prop_tac "tcbSchedNexts_of s beforePtr = Some afterPtr")
+   apply (fastforce intro: sym_heapD2 simp: opt_map_def obj_at'_def projectKOs)
+  apply (fastforce dest: sym_heap_insert_into_middle_of_chain
+                   simp: fun_upd_swap opt_map_red opt_map_upd_triv obj_at'_def projectKOs)
+  done
+
+lemma tcbQueueAppend_sym_heap_sched_pointers:
+  "\<lbrace>\<lambda>s. sym_heap_sched_pointers s
+        \<and> (\<exists>ts. list_queue_relation ts q (tcbSchedNexts_of s) (tcbSchedPrevs_of s)
+                \<and> tcbPtr \<notin> set ts)
+        \<and> tcbSchedNexts_of s tcbPtr = None \<and> tcbSchedPrevs_of s tcbPtr = None\<rbrace>
+   tcbQueueAppend q tcbPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  supply if_split[split del]
+  apply (clarsimp simp: tcbQueueAppend_def)
+  apply (wpsimp wp: threadSet_wp)
+  apply (clarsimp simp: tcbQueueEmpty_def list_queue_relation_def queue_end_valid_def
+                        obj_at'_def projectKOs
+                 split: if_splits)
+   apply fastforce
+  apply (drule_tac a="last ts" and b=tcbPtr in sym_heap_connect)
+    apply (fastforce dest: heap_ls_last_None)
+   apply assumption
+  apply (simp add: opt_map_red tcbQueueEmpty_def)
+  apply (subst fun_upd_swap, simp)
+  apply (fastforce simp: opt_map_red opt_map_upd_triv)
+  done
+
+lemma tcbQueued_update_sym_heap_sched_pointers[wp]:
+  "threadSet (tcbQueued_update f) tcbPtr \<lbrace>sym_heap_sched_pointers\<rbrace>"
+  by (rule sym_heap_sched_pointers_lift;
+      wpsimp wp: threadSet_tcbSchedPrevs_of threadSet_tcbSchedNexts_of)
+
+lemma tcbSchedEnqueue_sym_heap_sched_pointers[wp]:
+  "\<lbrace>sym_heap_sched_pointers and valid_sched_pointers\<rbrace>
+   tcbSchedEnqueue tcbPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  unfolding tcbSchedEnqueue_def
+  apply (wpsimp wp: tcbQueuePrepend_sym_heap_sched_pointers threadGet_wp
+              simp: addToBitmap_def 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 (fastforce dest!: spec[where x=tcbPtr] inQ_implies_tcbQueueds_of
+                    simp: valid_sched_pointers_def opt_pred_def opt_map_def obj_at'_def projectKOs)
+  done
+
+lemma tcbSchedAppend_sym_heap_sched_pointers[wp]:
+  "\<lbrace>sym_heap_sched_pointers and valid_sched_pointers\<rbrace>
+   tcbSchedAppend tcbPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  unfolding tcbSchedAppend_def
+  apply (wpsimp wp: tcbQueueAppend_sym_heap_sched_pointers threadGet_wp
+              simp: addToBitmap_def 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 (fastforce dest!: spec[where x=tcbPtr] inQ_implies_tcbQueueds_of
+                    simp: valid_sched_pointers_def opt_pred_def opt_map_def obj_at'_def projectKOs)
+  done
+
+lemma tcbSchedDequeue_sym_heap_sched_pointers[wp]:
+  "\<lbrace>sym_heap_sched_pointers and valid_sched_pointers\<rbrace>
+   tcbSchedDequeue tcbPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  unfolding tcbSchedDequeue_def
+  apply (wpsimp wp: tcbQueueRemove_sym_heap_sched_pointers hoare_vcg_if_lift2 threadGet_wp
+              simp: bitmap_fun_defs)
+  apply (fastforce simp: ready_queue_relation_def ksReadyQueues_asrt_def inQ_def opt_pred_def
+                         opt_map_def obj_at'_def projectKOs)
+  done
+
+crunches setThreadState
+  for valid_sched_pointers[wp]: valid_sched_pointers
+  and sym_heap_sched_pointers[wp]: sym_heap_sched_pointers
+  (simp: crunch_simps wp: crunch_wps threadSet_valid_sched_pointers threadSet_sched_pointers)
+
 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. (\<exists>p. t \<in> set(ksReadyQueues s p)) \<longrightarrow> runnable' st)
       and (\<lambda>s. runnable' st \<and> obj_at' tcbQueued t s \<longrightarrow> st_tcb_at' runnable' t s)
       and sch_act_simple
       and invs'\<rbrace>
@@ -4255,21 +5615,21 @@ lemma sts_invs_minor':
   including no_pre
   apply (simp add: invs'_def valid_state'_def)
   apply (rule hoare_pre)
-   apply (wp sts_valid_queues valid_irq_node_lift irqs_masked_lift
-              setThreadState_ct_not_inQ
+   apply (wp valid_irq_node_lift irqs_masked_lift
+             setThreadState_ct_not_inQ
             | simp add: cteCaps_of_def o_def)+
   apply (clarsimp simp: sch_act_simple_def)
   apply (intro conjI)
-     apply clarsimp
-    defer
-    apply (clarsimp dest!: st_tcb_at_state_refs_ofD'
-                    elim!: rsubst[where P=sym_refs]
-                   intro!: ext)
-   apply (clarsimp elim!: st_tcb_ex_cap'')
+       apply clarsimp
+      defer
+      apply (clarsimp dest!: st_tcb_at_state_refs_ofD'
+                      elim!: rsubst[where P=sym_refs]
+                     intro!: ext)
+      apply (clarsimp elim!: st_tcb_ex_cap'')
+    apply fastforce
+   apply fastforce
   apply (frule tcb_in_valid_state', clarsimp+)
-  apply (cases st, simp_all add: valid_tcb_state'_def
-                  split: Structures_H.thread_state.split_asm)
-  done
+  by (cases st; simp add: valid_tcb_state'_def split: Structures_H.thread_state.split_asm)
 
 lemma sts_cap_to'[wp]:
   "\<lbrace>ex_nonz_cap_to' p\<rbrace> setThreadState st t \<lbrace>\<lambda>rv. ex_nonz_cap_to' p\<rbrace>"
@@ -4306,12 +5666,56 @@ lemma threadSet_ct_running':
   apply wp
   done
 
+lemma tcbQueuePrepend_tcbPriority_obj_at'[wp]:
+  "tcbQueuePrepend queue tptr \<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
+  unfolding tcbQueuePrepend_def
+  apply (wpsimp wp: threadSet_wp)
+  by (auto simp: obj_at'_def projectKOs objBits_simps ps_clear_def split: if_splits)
+
+lemma tcbQueuePrepend_tcbDomain_obj_at'[wp]:
+  "tcbQueuePrepend queue tptr \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  unfolding tcbQueuePrepend_def
+  apply (wpsimp wp: threadSet_wp)
+  by (auto simp: obj_at'_def projectKOs objBits_simps ps_clear_def split: if_splits)
+
+lemma tcbSchedDequeue_tcbPriority[wp]:
+  "tcbSchedDequeue t \<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
+  unfolding tcbSchedDequeue_def tcbQueueRemove_def
+  by (wpsimp wp: hoare_when_weak_wp hoare_drop_imps)
+
+lemma tcbSchedDequeue_tcbDomain[wp]:
+  "tcbSchedDequeue t \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  unfolding tcbSchedDequeue_def tcbQueueRemove_def
+  by (wpsimp wp: hoare_when_weak_wp hoare_drop_imps)
+
+lemma tcbSchedEnqueue_tcbPriority_obj_at'[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
+  unfolding tcbSchedEnqueue_def setQueue_def
+  by wpsimp
+
+lemma tcbSchedEnqueue_tcbDomain_obj_at'[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  unfolding tcbSchedEnqueue_def setQueue_def
+  by wpsimp
+
+crunches rescheduleRequired
+  for tcbPriority_obj_at'[wp]: "obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'"
+  and tcbDomain_obj_at'[wp]: "obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'"
+
+lemma setThreadState_tcbPriority_obj_at'[wp]:
+  "setThreadState ts tptr \<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
+  unfolding setThreadState_def
+  apply (wpsimp wp: threadSet_wp)
+  apply (fastforce simp: obj_at'_def projectKOs objBits_simps ps_clear_def)
+  done
+
 lemma setThreadState_tcb_in_cur_domain'[wp]:
   "\<lbrace>tcb_in_cur_domain' t'\<rbrace> setThreadState 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 setThreadState_not_st | simp)+
+  apply (simp add: setThreadState_def)
+  apply (wpsimp wp: threadSet_ct_idle_or_in_cur_domain' hoare_drop_imps)+
   done
 
 lemma asUser_global_refs':   "\<lbrace>valid_global_refs'\<rbrace> asUser t f \<lbrace>\<lambda>rv. valid_global_refs'\<rbrace>"
@@ -4432,10 +5836,13 @@ 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)
-            (set_eobject ptr etcb) (setObject ptr tcb')"
+  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
@@ -4456,20 +5863,34 @@ lemma set_eobject_corres':
    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 cte_relation_def tcb_relation_def projectKOs split: if_split_asm)+
+     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 (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 (clarsimp simp: projectKOs)
-  apply (insert e)
-  apply (clarsimp simp: other_obj_relation_def etcb_relation_def is_other_obj_relation_type split: Structures_A.kernel_object.splits Structures_H.kernel_object.splits ARM_A.arch_kernel_obj.splits)
+  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
 
 lemma set_eobject_corres:
@@ -4477,9 +5898,13 @@ lemma set_eobject_corres:
   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)
-                  (set_eobject add etcbu) (setObject add tcbu')"
+  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)
@@ -4506,24 +5931,27 @@ lemma set_eobject_corres:
 
 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)
-                    (ethread_set f t) (threadSet f' t)"
+  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+
+     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 simp
+  apply (clarsimp simp: obj_at'_def)
   done
 
 lemmas ethread_set_corres =
diff --git a/proof/refine/ARM/Tcb_R.thy b/proof/refine/ARM/Tcb_R.thy
index 6e158808df..cf8ea5ac22 100644
--- a/proof/refine/ARM/Tcb_R.thy
+++ b/proof/refine/ARM/Tcb_R.thy
@@ -46,14 +46,14 @@ lemma activateThread_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)
+          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
+   apply (clarsimp simp: ct_in_state_def tcb_at_invs invs_distinct invs_psp_aligned
                   elim!: st_tcb_weakenE)
   apply (clarsimp simp: tcb_at_invs' ct_in_state'_def
                  elim!: pred_tcb'_weakenE)
@@ -197,13 +197,13 @@ lemma setupReplyMaster_weak_sch_act_wf[wp]:
   apply assumption
   done
 
-crunches setupReplyMaster
-  for valid_queues[wp]: "Invariants_H.valid_queues"
-  and valid_queues'[wp]: "valid_queues'"
+crunches 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) (invs' and tcb_at' t)
+  "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)
@@ -212,20 +212,22 @@ lemma restart_corres:
       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])
-             apply clarsimp
+          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_valid_queues sts_st_tcb'
-                    | clarsimp simp: valid_tcb_state'_def)+
-       apply (rule_tac Q="\<lambda>rv. valid_sched and cur_tcb" in hoare_strengthen_post)
-        apply wp
-       apply (simp add: valid_sched_def valid_sched_action_def)
-      apply (rule_tac Q="\<lambda>rv. invs' and tcb_at' t" in hoare_strengthen_post)
-       apply wp
-      apply (clarsimp simp: invs'_def valid_state'_def sch_act_wf_weak valid_pspace'_def)
-     apply wp+
-   apply (simp add: valid_sched_def invs_def tcb_at_is_etcb_at)
-  apply (clarsimp simp add: invs'_def valid_state'_def sch_act_wf_weak)
+              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
 
 lemma restart_invs':
@@ -309,12 +311,6 @@ lemma invokeTCB_ReadRegisters_corres:
 crunch sch_act_simple [wp]: asUser "sch_act_simple"
   (rule: sch_act_simple_lift)
 
-lemma invs_valid_queues':
-  "invs' s \<longrightarrow> valid_queues' s"
-  by (clarsimp simp:invs'_def valid_state'_def)
-
-declare invs_valid_queues'[rule_format, elim!]
-
 lemma einvs_valid_etcbs: "einvs s \<longrightarrow> valid_etcbs s"
   by (clarsimp simp: valid_sched_def)
 
@@ -327,6 +323,11 @@ lemma asUser_postModifyRegisters_corres:
   apply (rule corres_stateAssert_assume)
    by simp+
 
+crunches restart
+  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 tcb_at dest and ex_nonz_cap_to dest)
         (invs' and sch_act_simple and tcb_at' dest and ex_nonz_cap_to' dest)
@@ -349,10 +350,12 @@ lemma invokeTCB_WriteRegisters_corres:
               apply simp
              apply (wp+)[2]
            apply ((wp hoare_weak_lift_imp restart_invs'
-                 | strengthen valid_sched_weak_strg einvs_valid_etcbs
-                              invs_valid_queues' invs_queues invs_weak_sch_act_wf
-                 | 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]
+                   | 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
@@ -383,6 +386,10 @@ lemma suspend_ResumeCurrentThread_imp_notct[wp]:
    \<lbrace>\<lambda>rv s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>"
   by (wpsimp simp: suspend_def)
 
+crunches restart, suspend
+  for cur_tcb'[wp]: cur_tcb'
+  (wp: crunch_wps threadSet_cur ignore: threadSet)
+
 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
@@ -411,6 +418,7 @@ proof -
          apply simp
         apply simp
        apply (simp | wp)+
+     apply fastforce+
     done
   have R: "\<And>src src' des des' xs ys. \<lbrakk> src = src'; des = des'; xs = ys \<rbrakk> \<Longrightarrow>
            corres dc (tcb_at src and tcb_at des and invs)
@@ -433,7 +441,7 @@ proof -
       apply (rule corres_split_eqr[OF asUser_getRestartPC_corres])
         apply (rule asUser_setNextPC_corres)
        apply wp+
-     apply simp+
+     apply fastforce+
     done
   show ?thesis
     apply (simp add: invokeTCB_def performTransfer_def)
@@ -457,21 +465,18 @@ proof -
                   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 ((wp hoare_weak_lift_imp)+)[6]
-             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)
+                   apply (solves \<open>wp hoare_weak_lift_imp\<close>)+
+             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_state'_def invs_weak_sch_act_wf)
-             apply ((wp mapM_x_wp' hoare_weak_lift_imp | simp)+)[2]
-           apply ((wp mapM_x_wp' hoare_weak_lift_imp | simp)+)[1]
-          apply (wp mapM_x_wp' hoare_weak_lift_imp | simp)+
-         apply ((wp mapM_x_wp' hoare_weak_lift_imp restart_invs' | wpc | clarsimp simp add: if_apply_def2)+)[2]
+             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 valid_state'_def dest!: global'_no_ex_cap)
-    done
+                     dest!: idle_no_ex_cap)
+    by (fastforce simp: invs'_def valid_state'_def dest!: global'_no_ex_cap)
 qed
 
 lemma readreg_invs':
@@ -517,41 +522,10 @@ lemma copyreg_invs':
    \<lbrace>\<lambda>rv. invs'\<rbrace>"
   by (rule hoare_strengthen_post, rule copyreg_invs'', simp)
 
-lemma threadSet_valid_queues_no_state:
-  "\<lbrace>Invariants_H.valid_queues and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))\<rbrace>
-     threadSet f t \<lbrace>\<lambda>_. Invariants_H.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 setObject_queues_unchanged_tcb
-             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 isRunnable_corres:
-  "corres (\<lambda>ts runn. runnable ts = runn) (tcb_at t) (tcb_at' t)
-     (get_thread_state t) (isRunnable t)"
+  "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)
@@ -572,16 +546,6 @@ lemma tcbSchedDequeue_not_queued:
   apply (wp tg_sp' [where P=\<top>, simplified] | simp)+
   done
 
-lemma tcbSchedDequeue_not_in_queue:
-  "\<And>p. \<lbrace>Invariants_H.valid_queues and tcb_at' t and valid_objs'\<rbrace> tcbSchedDequeue t
-   \<lbrace>\<lambda>rv s. t \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (rule_tac Q="\<lambda>rv. Invariants_H.valid_queues and obj_at' (Not \<circ> tcbQueued) t"
-               in hoare_post_imp)
-   apply (fastforce simp: valid_queues_def valid_queues_no_bitmap_def obj_at'_def projectKOs inQ_def )
-  apply (wp tcbSchedDequeue_not_queued tcbSchedDequeue_valid_queues |
-         simp add: valid_objs'_maxDomain valid_objs'_maxPriority)+
-  done
-
 lemma threadSet_ct_in_state':
   "(\<And>tcb. tcbState (f tcb) = tcbState tcb) \<Longrightarrow>
   \<lbrace>ct_in_state' test\<rbrace> threadSet f t \<lbrace>\<lambda>rv. ct_in_state' test\<rbrace>"
@@ -625,14 +589,19 @@ lemma threadSet_valid_objs_tcbPriority_update:
 
 crunch cur[wp]: tcbSchedDequeue cur_tcb'
 
+crunches tcbSchedDequeue
+  for st_tcb_at'[wp]: "\<lambda>s. P (st_tcb_at' st tcbPtr s)"
+
 lemma sp_corres2:
-  "corres dc (valid_etcbs and weak_valid_sched_action and cur_tcb)
-             (Invariants_H.valid_queues and valid_queues' and cur_tcb' and tcb_at' t
-              and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and valid_objs' and (\<lambda>_. x \<le> maxPriority))
-                     (set_priority t x) (setPriority t x)"
+  "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])
+    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])
@@ -644,37 +613,42 @@ lemma sp_corres2:
            apply ((clarsimp
                    | wp hoare_weak_lift_imp hoare_vcg_if_lift hoare_wp_combs gts_wp
                         isRunnable_wp)+)[4]
-       apply (wp hoare_vcg_imp_lift' hoare_vcg_if_lift hoare_vcg_all_lift)
-      apply clarsimp
-      apply ((wp hoare_drop_imps hoare_vcg_if_lift hoare_vcg_all_lift
-                 isRunnable_wp threadSet_pred_tcb_no_state threadSet_valid_queues_no_state
-                 threadSet_valid_queues'_no_state threadSet_cur threadSet_valid_objs_tcbPriority_update
-                 threadSet_weak_sch_act_wf threadSet_ct_in_state'[simplified ct_in_state'_def]
-              | simp add: etcb_relation_def)+)[1]
-     apply ((wp hoare_vcg_imp_lift' hoare_vcg_if_lift hoare_vcg_all_lift hoare_vcg_disj_lift
-                tcbSchedDequeue_not_in_queue tcbSchedDequeue_valid_queues
-                tcbSchedDequeue_ct_in_state'[simplified ct_in_state'_def]
-             | simp add: etcb_relation_def)+)[2]
+       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 (force simp: state_relation_def elim: valid_objs'_maxDomain valid_objs'_maxPriority)
+  apply clarsimp
   done
 
-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)"
+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 (clarsimp simp: valid_sched_def valid_sched_action_def)
+   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 x) (setMCPriority t x)"
+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 exst_same_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>
@@ -686,17 +660,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)
-               (tcb_at' t)
+     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
-  apply (clarsimp simp add: threadset_corresT [OF _ x y e])
+  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]
@@ -705,109 +680,40 @@ lemma tcbSchedDequeue_sch_act_simple[wp]:
   "tcbSchedDequeue t \<lbrace>sch_act_simple\<rbrace>"
   by (wpsimp simp: sch_act_simple_def)
 
-lemma setP_vq[wp]:
-  "\<lbrace>\<lambda>s. Invariants_H.valid_queues s \<and> tcb_at' t s \<and> sch_act_wf (ksSchedulerAction s) s \<and> valid_objs' s \<and> p \<le> maxPriority\<rbrace>
-     setPriority t p
-   \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: setPriority_def)
-  apply (wpsimp )
-    apply (wp hoare_vcg_imp_lift')
-      unfolding st_tcb_at'_def
-      apply (strengthen not_obj_at'_strengthen)
-      apply (wp hoare_wp_combs)
-     apply (wp hoare_vcg_imp_lift')
-      apply (wp threadSet_valid_queues threadSet_valid_objs_tcbPriority_update)
-      apply(wp threadSet_weak_sch_act_wf)
-       apply clarsimp
-      apply clarsimp
-     apply (wp hoare_vcg_imp_lift')
-     apply (wp threadSet_valid_queues threadSet_valid_objs_tcbPriority_update threadSet_sch_act, clarsimp)
-    apply (wp add: threadSet_valid_queues comb:hoare_drop_imps )
-   apply (clarsimp simp: eq_commute[where a=t])
-   apply (wp add: threadSet_valid_queues threadSet_valid_objs_tcbPriority_update threadSet_weak_sch_act_wf
-                  hoare_vcg_imp_lift'[where P="\<lambda>_ s. ksCurThread s \<noteq> _"] hoare_drop_imps hoare_vcg_all_lift
-                  tcbSchedDequeue_not_in_queue tcbSchedEnqueue_valid_objs' tcbSchedDequeue_valid_queues
-          | clarsimp simp: valid_objs'_maxDomain valid_objs'_maxPriority)+
-  done
-
-lemma valid_queues_subsetE':
-  "\<lbrakk> valid_queues' s; ksPSpace s = ksPSpace s';
-     \<forall>x. set (ksReadyQueues s x) \<subseteq> set (ksReadyQueues s' x) \<rbrakk>
-   \<Longrightarrow> valid_queues' s'"
-  by (simp add: valid_queues'_def obj_at'_def
-                ps_clear_def subset_iff projectKOs)
-
-crunch vq'[wp]: getCurThread valid_queues'
-
-lemma setP_vq'[wp]:
-  "\<lbrace>\<lambda>s. valid_queues' s \<and> tcb_at' t s \<and> sch_act_wf (ksSchedulerAction s) s \<and> p \<le> maxPriority\<rbrace>
-     setPriority t p
-   \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (simp add: setPriority_def)
-  apply (wpsimp wp: threadSet_valid_queues' hoare_drop_imps
-                    threadSet_weak_sch_act_wf threadSet_sch_act)
-   apply (rule_tac Q="\<lambda>_ s. valid_queues' s \<and> obj_at' (Not \<circ> tcbQueued) t s \<and> sch_act_wf (ksSchedulerAction s) s
-              \<and> weak_sch_act_wf (ksSchedulerAction s) s" in hoare_strengthen_post,
-          wp tcbSchedDequeue_valid_queues' tcbSchedDequeue_not_queued)
-   apply (clarsimp simp: inQ_def)
-   apply normalise_obj_at'
-  apply clarsimp
-  done
-
-lemma setQueue_invs_bits[wp]:
-  "\<lbrace>valid_pspace'\<rbrace> setQueue d p q \<lbrace>\<lambda>rv. valid_pspace'\<rbrace>"
-  "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace> setQueue d p q \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  "\<lbrace>\<lambda>s. sym_refs (state_refs_of' s)\<rbrace> setQueue d p q \<lbrace>\<lambda>rv s. sym_refs (state_refs_of' s)\<rbrace>"
-  "\<lbrace>if_live_then_nonz_cap'\<rbrace> setQueue d p q \<lbrace>\<lambda>rv. if_live_then_nonz_cap'\<rbrace>"
-  "\<lbrace>if_unsafe_then_cap'\<rbrace> setQueue d p q \<lbrace>\<lambda>rv. if_unsafe_then_cap'\<rbrace>"
-  "\<lbrace>cur_tcb'\<rbrace> setQueue d p q \<lbrace>\<lambda>rv. cur_tcb'\<rbrace>"
-  "\<lbrace>valid_global_refs'\<rbrace> setQueue d p q \<lbrace>\<lambda>rv. valid_global_refs'\<rbrace>"
-  "\<lbrace>valid_irq_handlers'\<rbrace> setQueue d p q \<lbrace>\<lambda>rv. valid_irq_handlers'\<rbrace>"
-   by (simp add: setQueue_def tcb_in_cur_domain'_def
-         | wp sch_act_wf_lift cur_tcb_lift
-         | fastforce)+
-
-lemma setQueue_ex_idle_cap[wp]:
-  "\<lbrace>\<lambda>s. ex_nonz_cap_to' (ksIdleThread s) s\<rbrace>
-   setQueue d p q
-   \<lbrace>\<lambda>rv s. ex_nonz_cap_to' (ksIdleThread s) s\<rbrace>"
-  by (simp add: setQueue_def, wp,
-      simp add: ex_nonz_cap_to'_def cte_wp_at_pspaceI)
-
-lemma tcbPriority_caps_safe:
-  "\<forall>tcb. \<forall>x\<in>ran tcb_cte_cases. (\<lambda>(getF, setF). getF (tcbPriority_update f tcb) = getF tcb) x"
-  by (rule all_tcbI, rule ball_tcb_cte_casesI, simp+)
+lemma tcbSchedNext_update_tcb_cte_cases:
+  "(a, b) \<in> ran tcb_cte_cases \<Longrightarrow> a (tcbPriority_update f tcb) = a tcb"
+  unfolding tcb_cte_cases_def
+  by (case_tac tcb; fastforce simp: objBits_simps')
 
-lemma tcbPriority_Queued_caps_safe:
-  "\<forall>tcb. \<forall>x\<in>ran tcb_cte_cases. (\<lambda>(getF, setF). getF (tcbPriority_update f (tcbQueued_update g tcb)) = getF tcb) x"
-  by (rule all_tcbI, rule ball_tcb_cte_casesI, simp+)
+lemma threadSet_priority_invs':
+  "\<lbrace>invs' and tcb_at' t and K (p \<le> maxPriority)\<rbrace>
+   threadSet (tcbPriority_update (\<lambda>_. p)) t
+   \<lbrace>\<lambda>_. invs'\<rbrace>"
+  apply (rule hoare_gen_asm)
+  apply (simp add: invs'_def valid_state'_def split del: if_split)
+  apply (wp threadSet_valid_pspace'
+            threadSet_sch_actT_P[where P=False, simplified]
+            threadSet_state_refs_of'T[where f'=id]
+            threadSet_iflive'T
+            threadSet_ifunsafe'T
+            threadSet_idle'T
+            valid_irq_node_lift
+            valid_irq_handlers_lift''
+            threadSet_ctes_ofT
+            threadSet_not_inQ
+            threadSet_ct_idle_or_in_cur_domain'
+            threadSet_cur
+            untyped_ranges_zero_lift
+            sym_heap_sched_pointers_lift threadSet_valid_sched_pointers
+            threadSet_tcbSchedPrevs_of threadSet_tcbSchedNexts_of
+         | clarsimp simp: cteCaps_of_def tcbSchedNext_update_tcb_cte_cases | rule refl)+
+  apply (clarsimp simp: o_def)
+  by (auto simp: obj_at'_def)
 
 lemma setP_invs':
   "\<lbrace>invs' and tcb_at' t and K (p \<le> maxPriority)\<rbrace> setPriority t p \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (rule hoare_gen_asm)
-  apply (simp add: setPriority_def)
-  apply (wp rescheduleRequired_all_invs_but_ct_not_inQ)
-    apply simp
-    apply (wp hoare_vcg_conj_lift hoare_vcg_imp_lift')
-    unfolding st_tcb_at'_def
-      apply (strengthen not_obj_at'_strengthen, wp)
-     apply (wp hoare_vcg_imp_lift')
-      apply (rule_tac Q="\<lambda>rv s. invs' s" in hoare_post_imp)
-       apply (clarsimp simp: invs_sch_act_wf' invs'_def invs_queues)
-       apply (clarsimp simp: valid_state'_def)
-      apply (wp hoare_drop_imps threadSet_invs_trivial,
-             simp_all add: inQ_def cong: conj_cong)[1]
-     apply (wp hoare_drop_imps threadSet_invs_trivial,
-            simp_all add: inQ_def cong: conj_cong)[1]
-    apply (wp hoare_drop_imps threadSet_invs_trivial,
-           simp_all add: inQ_def cong: conj_cong)[1]
-   apply (rule_tac Q="\<lambda>_. invs' and obj_at' (Not \<circ> tcbQueued) t
-                                  and (\<lambda>s. \<forall>d p. t \<notin> set (ksReadyQueues s (d,p)))"
-              in hoare_post_imp)
-    apply (clarsimp simp: obj_at'_def inQ_def)
-   apply (wp tcbSchedDequeue_not_queued)+
-  apply clarsimp
-  done
+  unfolding setPriority_def
+  by (wpsimp wp: rescheduleRequired_invs' threadSet_priority_invs')
 
 crunches setPriority, setMCPriority
   for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
@@ -1109,11 +1015,6 @@ lemma setMCPriority_valid_objs'[wp]:
 crunch sch_act_simple[wp]: setMCPriority sch_act_simple
   (wp: ssa_sch_act_simple crunch_wps rule: sch_act_simple_lift simp: crunch_simps)
 
-(* For some reason, when this was embedded in a larger expression clarsimp wouldn't remove it. Adding it as a simp rule does *)
-lemma inQ_tc_corres_helper:
-  "(\<forall>d p. (\<exists>tcb. tcbQueued tcb \<and> tcbPriority tcb = p \<and> tcbDomain tcb = d \<and> (tcbQueued tcb \<longrightarrow> tcbDomain tcb \<noteq> d)) \<longrightarrow> a \<notin> set (ksReadyQueues s (d, p))) = True"
-  by clarsimp
-
 abbreviation "valid_option_prio \<equiv> case_option True (\<lambda>(p, auth). p \<le> maxPriority)"
 
 definition valid_tcb_invocation :: "tcbinvocation \<Rightarrow> bool" where
@@ -1137,108 +1038,87 @@ lemma threadcontrol_corres_helper1:
   apply (clarsimp simp: is_tcb_def)
   done
 
-lemma threadcontrol_corres_helper2:
-  "is_aligned a msg_align_bits \<Longrightarrow> \<lbrace>invs' and tcb_at' t\<rbrace>
-      threadSet (tcbIPCBuffer_update (\<lambda>_. a)) t
-           \<lbrace>\<lambda>x s. Invariants_H.valid_queues s \<and> valid_queues' s \<and> weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  by (wp threadSet_invs_trivial
-      | strengthen  invs_valid_queues' invs_queues invs_weak_sch_act_wf
-      | clarsimp simp: inQ_def )+
-
-lemma threadcontrol_corres_helper3:
+lemma thread_set_ipc_weak_valid_sched_action:
   "\<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>x. weak_valid_sched_action and valid_etcbs \<rbrace>"
+   thread_set (tcb_ipc_buffer_update f) a
+   \<lbrace>\<lambda>x. weak_valid_sched_action\<rbrace>"
   apply (rule hoare_pre)
-   apply (wp check_cap_inv | simp add:)+
-  by (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 (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 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 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>x. Invariants_H.valid_queues and valid_queues' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)\<rbrace>"
-  apply (wp
-       | strengthen  invs_valid_queues' invs_queues invs_weak_sch_act_wf
-       | clarsimp simp: )+
+  \<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>_ 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 isArchObjectCap_def isNotificationCap_def isEndpointCap_def
-                     isReplyCap_def isIRQControlCap_def tcb_cnode_index_def cte_map_def cte_wp_at'_def
+      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 \<and> tcbDomain (F tcb) = tcbDomain tcb"
-  assumes a: "\<forall>tcb. tcbBoundNotification (F tcb) = tcbBoundNotification 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. \<not> tcbQueued tcb \<and> tcbQueued (F tcb)) \<longrightarrow> ex_nonz_cap_to' t s \<and> t \<noteq> ksCurThread s)
-        \<and> (\<forall>tcb. tcbQueued (F tcb) \<and> ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> tcbQueued tcb \<or> t \<noteq> ksCurThread s)\<rbrace>
-        threadSet F t
-   \<lbrace>\<lambda>rv. invs'\<rbrace>"
-proof -
-  from z have domains: "\<And>tcb. tcbDomain (F tcb) = tcbDomain tcb" by blast
-  note threadSet_sch_actT_P[where P=False, simplified]
-  have y: "\<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 valid_state'_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_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_cur
-               untyped_ranges_zero_lift
-            |clarsimp simp: y z a domains cteCaps_of_def |rule refl)+
-   apply (clarsimp simp: obj_at'_def projectKOs pred_tcb_at'_def)
-   apply (clarsimp simp: cur_tcb'_def valid_irq_node'_def valid_queues'_def o_def)
-   by (fastforce simp: domains ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def z a)
-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>"
@@ -1269,6 +1149,12 @@ 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'"
@@ -1311,8 +1197,8 @@ lemma transferCaps_corres:
     (invokeTCB (tcbinvocation.ThreadControl a sl' b' mcp_auth p_auth e' f' g'))"
 proof -
   have P: "\<And>t v. corres dc
-               (tcb_at t)
-               (tcb_at' t)
+               (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 ()
@@ -1322,8 +1208,8 @@ proof -
     apply (safe, case_tac tcb', simp add: tcb_relation_def split: option.split)
     done
   have R: "\<And>t v. corres dc
-               (tcb_at t)
-               (tcb_at' t)
+               (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)"
@@ -1336,7 +1222,9 @@ proof -
                    (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) (tcb_at' t)
+  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)
@@ -1460,23 +1348,33 @@ proof -
              apply (rule corres_split[OF getCurThread_corres], clarsimp)
                apply (rule corres_when[OF refl rescheduleRequired_corres])
               apply (wpsimp wp: gct_wp)+
-            apply (wp hoare_drop_imp)
-            apply (rule threadcontrol_corres_helper1[unfolded pred_conj_def])
-           apply simp
-           apply (wp hoare_drop_imp)
-           apply (wp threadcontrol_corres_helper2 | wpc | simp)+
+            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="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_nor)
+            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])
@@ -1485,22 +1383,21 @@ proof -
             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)+
+                       | 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
-                | clarsimp simp: inQ_def inQ_tc_corres_helper)+
+                   | 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 (clarsimp simp: emptyable_def)
+       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 (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))"
@@ -1567,40 +1464,25 @@ proof -
                  apply wp
                 apply wp
                apply (wpsimp wp: hoare_vcg_const_imp_lift_R hoare_vcg_const_imp_lift
-                                 hoare_vcg_all_lift_R hoare_vcg_all_lift as_user_invs cap_delete_deletes
-                                 thread_set_ipc_tcb_cap_valid thread_set_tcb_ipc_buffer_cap_cleared_invs
-                                 thread_set_cte_wp_at_trivial thread_set_valid_cap cap_delete_valid_cap
-                                 reschedule_preserves_valid_sched thread_set_not_state_valid_sched
+                                 hoare_vcg_all_lift_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]
-                           simp: ran_tcb_cap_cases)
+                                 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_drop_imps)
-              apply ((wpsimp wp: hoare_vcg_const_imp_lift hoare_vcg_imp_lift' hoare_vcg_all_lift
-                                       threadSet_cte_wp_at' threadSet_invs_trivialT2 cteDelete_invs'
-                                 simp: tcb_cte_cases_def), (fastforce+)[6])
-                  apply wpsimp
-                  apply (wpsimp wp: hoare_vcg_const_imp_lift hoare_drop_imps hoare_vcg_all_lift
-                                    threadSet_invs_trivialT2 threadSet_cte_wp_at'
-                              simp: tcb_cte_cases_def, (fastforce+)[6])
-                  apply wpsimp
-                  apply (wpsimp wp: hoare_vcg_const_imp_lift hoare_drop_imps hoare_vcg_all_lift
-                                    rescheduleRequired_invs' threadSet_cte_wp_at'
-                              simp: tcb_cte_cases_def)
-                 apply (wpsimp wp: hoare_vcg_const_imp_lift hoare_drop_imps hoare_vcg_all_lift
-                                   rescheduleRequired_invs' threadSet_invs_trivialT2 threadSet_cte_wp_at'
-                             simp: tcb_cte_cases_def, (fastforce+)[6])
-                 apply wpsimp
-                 apply (wpsimp wp: hoare_vcg_const_imp_lift hoare_drop_imps hoare_vcg_all_lift
-                                   rescheduleRequired_invs' threadSet_invs_trivialT2 threadSet_cte_wp_at'
-                             simp: tcb_cte_cases_def, (fastforce+)[6])
-                 apply wpsimp
-                 apply (wpsimp wp: hoare_vcg_const_imp_lift hoare_drop_imps hoare_vcg_all_lift
-                                   rescheduleRequired_invs' threadSet_cap_to' threadSet_invs_trivialT2
-                                   threadSet_cte_wp_at' hoare_drop_imps
-                               simp: tcb_cte_cases_def)
-                apply (clarsimp)
+               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_lift_R hoare_vcg_all_lift
                                    hoare_vcg_const_imp_lift_R hoare_vcg_const_imp_lift
                                    threadSet_valid_objs' thread_set_not_state_valid_sched
@@ -1613,9 +1495,9 @@ proof -
                         | strengthen tcb_cap_always_valid_strg
                                    tcb_at_invs
                                    use_no_cap_to_obj_asid_strg
-                        | (erule exE, clarsimp simp: word_bits_def))+)
+                        | (erule exE, clarsimp simp: word_bits_def) | wp (once) hoare_drop_imps)+)
                 apply (strengthen valid_tcb_ipc_buffer_update)
-                apply (strengthen invs_valid_objs')+
+                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
@@ -1647,7 +1529,7 @@ proof -
                    | 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
+                                      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 *)
@@ -1659,7 +1541,7 @@ proof -
                     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 arch_cap_fun_lift_def
+                       isCap_simps domIff valid_tcb'_def tcb_cte_cases_def
                 split: option.split_asm
                 dest!: isValidVTableRootD)
 qed
@@ -1739,7 +1621,7 @@ lemma setSchedulerAction_invs'[wp]:
   apply (simp add: setSchedulerAction_def)
   apply wp
   apply (clarsimp simp add: invs'_def valid_state'_def valid_irq_node'_def
-                valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs cur_tcb'_def
+                valid_queues_def bitmapQ_defs cur_tcb'_def
                 ct_not_inQ_def)
   apply (simp add: ct_idle_or_in_cur_domain'_def)
   done
@@ -1869,8 +1751,8 @@ lemma invokeTCB_corres:
            apply (rule TcbAcc_R.rescheduleRequired_corres)
           apply (rule corres_trivial, simp)
          apply (wpsimp wp: hoare_drop_imp)+
-   apply (clarsimp simp: valid_sched_weak_strg einvs_valid_etcbs)
-  apply (clarsimp simp: Tcb_R.invs_valid_queues' Invariants_H.invs_queues)
+   apply (fastforce dest: valid_sched_valid_queues simp: valid_sched_weak_strg einvs_valid_etcbs)
+  apply fastforce
   done
 
 lemma tcbBoundNotification_caps_safe[simp]:
@@ -1885,6 +1767,10 @@ lemma valid_bound_ntfn_lift:
   apply (wp typ_at_lifts[OF P])+
   done
 
+crunches 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
@@ -1897,7 +1783,7 @@ lemma bindNotification_invs':
   apply (simp add: bindNotification_def invs'_def valid_state'_def)
   apply (rule hoare_seq_ext[OF _ get_ntfn_sp'])
   apply (rule hoare_pre)
-   apply (wp set_ntfn_valid_pspace' sbn_sch_act' sbn_valid_queues valid_irq_node_lift
+   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)+
@@ -2068,7 +1954,7 @@ lemma eq_ucast_word8[simp]:
   done
 
 lemma checkPrio_corres:
-  "corres (ser \<oplus> dc) (tcb_at auth) (tcb_at' auth)
+  "corres (ser \<oplus> dc) (tcb_at auth and pspace_aligned and pspace_distinct) \<top>
      (check_prio p auth) (checkPrio p auth)"
   apply (simp add: check_prio_def checkPrio_def)
   apply (rule corres_guard_imp)
@@ -2091,7 +1977,7 @@ lemma decodeSetPriority_corres:
   "\<lbrakk> cap_relation cap cap'; is_thread_cap cap;
      list_all2 (\<lambda>(c, sl) (c', sl'). cap_relation c c' \<and> sl' = cte_map sl) extras extras' \<rbrakk> \<Longrightarrow>
    corres (ser \<oplus> tcbinv_relation)
-       (cur_tcb and valid_etcbs and (\<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')"
@@ -2103,14 +1989,13 @@ lemma decodeSetPriority_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 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;
      list_all2 (\<lambda>(c, sl) (c', sl'). cap_relation c c' \<and> sl' = cte_map sl) extras extras' \<rbrakk> \<Longrightarrow>
    corres (ser \<oplus> tcbinv_relation)
-       (cur_tcb and valid_etcbs and (\<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_mcpriority args cap slot extras)
        (decodeSetMCPriority args cap' extras')"
@@ -2122,8 +2007,7 @@ lemma decodeSetMCPriority_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 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>"
@@ -2218,7 +2102,8 @@ lemma decodeSetSchedParams_corres:
   "\<lbrakk> cap_relation cap cap'; is_thread_cap cap;
      list_all2 (\<lambda>(c, sl) (c', sl'). cap_relation c c' \<and> sl' = cte_map sl) extras extras' \<rbrakk> \<Longrightarrow>
    corres (ser \<oplus> tcbinv_relation)
-       (cur_tcb and valid_etcbs and (\<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_sched_params args cap slot extras)
        (decodeSetSchedParams args cap' extras')"
@@ -2632,8 +2517,8 @@ notes if_cong[cong] shows
 
 lemma decodeUnbindNotification_corres:
   "corres (ser \<oplus> tcbinv_relation)
-      (tcb_at t)
-      (tcb_at' t)
+      (tcb_at t and pspace_aligned and pspace_distinct)
+      \<top>
      (decode_unbind_notification (cap.ThreadCap t))
      (decodeUnbindNotification (capability.ThreadCap t))"
   apply (simp add: decode_unbind_notification_def decodeUnbindNotification_def)
@@ -2683,7 +2568,8 @@ lemma decodeTCBInvocation_corres:
              corres_guard_imp[OF decodeBindNotification_corres]
              corres_guard_imp[OF decodeUnbindNotification_corres]
              corres_guard_imp[OF decodeSetTLSBase_corres],
-         simp_all add: valid_cap_simps valid_cap_simps' invs_def valid_sched_def)
+         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
diff --git a/proof/refine/ARM/Untyped_R.thy b/proof/refine/ARM/Untyped_R.thy
index a0e2af4f1b..11fb780c00 100644
--- a/proof/refine/ARM/Untyped_R.thy
+++ b/proof/refine/ARM/Untyped_R.thy
@@ -1358,16 +1358,6 @@ crunches insertNewCap
 
 crunch exst[wp]: set_cdt "\<lambda>s. P (exst s)"
 
-(*FIXME: Move to StateRelation*)
-lemma state_relation_schact[elim!]:
-  "(s,s') \<in> state_relation \<Longrightarrow> sched_act_relation (scheduler_action s) (ksSchedulerAction s')"
-  apply (simp add: state_relation_def)
-  done
-
-lemma state_relation_queues[elim!]: "(s,s') \<in> state_relation \<Longrightarrow> ready_queues_relation (ready_queues s) (ksReadyQueues s')"
-  apply (simp add: state_relation_def)
-  done
-
 lemma set_original_symb_exec_l:
   "corres_underlying {(s, s'). f (kheap s) (exst s) s'} nf 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)
@@ -1398,6 +1388,10 @@ lemma updateNewFreeIndex_noop_psp_corres:
         | simp add: updateTrackedFreeIndex_def getSlotCap_def)+
   done
 
+crunches 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]
 shows
@@ -3607,8 +3601,8 @@ lemma updateFreeIndex_clear_invs':
        apply (simp add:updateCap_def)
        apply (wp setCTE_irq_handlers' getCTE_wp)
       apply (simp add:updateCap_def)
-      apply (wp irqs_masked_lift valid_queues_lift' cur_tcb_lift ct_idle_or_in_cur_domain'_lift
-                hoare_vcg_disj_lift untyped_ranges_zero_lift getCTE_wp
+      apply (wp irqs_masked_lift cur_tcb_lift ct_idle_or_in_cur_domain'_lift
+                hoare_vcg_disj_lift untyped_ranges_zero_lift getCTE_wp valid_bitmaps_lift
                | wp (once) hoare_use_eq[where f="gsUntypedZeroRanges"]
                | simp add: getSlotCap_def
                | simp add: cte_wp_at_ctes_of)+
@@ -4173,14 +4167,12 @@ context begin interpretation Arch . (*FIXME: arch_split*)
 lemma resetUntypedCap_corres:
   "untypinv_relation ui ui'
     \<Longrightarrow> corres (dc \<oplus> dc)
-    (invs 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)
@@ -5012,7 +5004,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 valid_sched_etcbs)
+      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
@@ -5173,9 +5165,6 @@ crunch irq_states' [wp]: insertNewCap valid_irq_states'
 crunch pde_mappings' [wp]: insertNewCap valid_pde_mappings'
   (wp: getCTE_wp')
 
-crunch vq'[wp]: insertNewCap valid_queues'
-  (wp: crunch_wps)
-
 crunch irqs_masked' [wp]: insertNewCap irqs_masked'
   (wp: crunch_wps rule: irqs_masked_lift)
 
@@ -5247,6 +5236,12 @@ lemma insertNewCap_urz[wp]:
     apply (auto simp add: cteCaps_of_def untypedZeroRange_def isCap_simps)
   done
 
+crunches insertNewCap
+  for tcbSchedNexts_of[wp]: "\<lambda>s. P (tcbSchedNexts_of s)"
+  and tcbSchedPrevs_of[wp]: "\<lambda>s. P (tcbSchedPrevs_of s)"
+  and valid_sched_pointers[wp]: valid_sched_pointers
+  (wp: crunch_wps)
+
 lemma insertNewCap_invs':
   "\<lbrace>invs' and ct_active'
           and valid_cap' cap
@@ -5263,8 +5258,8 @@ lemma insertNewCap_invs':
   apply (simp add: invs'_def valid_state'_def)
   apply (rule hoare_pre)
    apply (wp insertNewCap_valid_pspace' sch_act_wf_lift
-             valid_queues_lift cur_tcb_lift tcb_in_cur_domain'_lift
-             insertNewCap_valid_global_refs'
+             cur_tcb_lift tcb_in_cur_domain'_lift valid_bitmaps_lift
+             insertNewCap_valid_global_refs' sym_heap_sched_pointers_lift
              valid_arch_state_lift'
              valid_irq_node_lift insertNewCap_valid_irq_handlers)
   apply (clarsimp simp: cte_wp_at_ctes_of)
diff --git a/proof/refine/ARM/VSpace_R.thy b/proof/refine/ARM/VSpace_R.thy
index a89cef829b..40e9cecc87 100644
--- a/proof/refine/ARM/VSpace_R.thy
+++ b/proof/refine/ARM/VSpace_R.thy
@@ -493,7 +493,7 @@ lemma armv_contextSwitch_corres:
   done
 
 lemma handleVMFault_corres:
-  "corres (fr \<oplus> dc) (tcb_at thread) (tcb_at' thread)
+  "corres (fr \<oplus> dc) (tcb_at thread and pspace_aligned and pspace_distinct) \<top>
           (handle_vm_fault thread fault) (handleVMFault thread fault)"
   apply (simp add: ARM_H.handleVMFault_def)
   apply corres_cases
@@ -2021,8 +2021,8 @@ lemma message_info_from_data_eqv:
 
 lemma setMessageInfo_corres:
  "mi' = message_info_map mi \<Longrightarrow>
-  corres dc (tcb_at t) (tcb_at' t)
-         (set_message_info t mi) (setMessageInfo t mi')"
+  corres dc (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+    (set_message_info t mi) (setMessageInfo t mi')"
   apply (simp add: setMessageInfo_def set_message_info_def)
   apply (subgoal_tac "wordFromMessageInfo (message_info_map mi) =
                       message_info_to_data mi")
@@ -2735,14 +2735,6 @@ crunch norqL1[wp]: storePDE "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
 crunch norqL2[wp]: storePDE "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
   (simp: updateObject_default_def)
 
-lemma storePDE_valid_queues [wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> storePDE p pde \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  by (wp valid_queues_lift | simp add: pred_tcb_at'_def)+
-
-lemma storePDE_valid_queues' [wp]:
-  "\<lbrace>valid_queues'\<rbrace> storePDE p pde \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  by (wp valid_queues_lift')
-
 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)
@@ -2885,7 +2877,17 @@ crunches 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)
+  (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
@@ -2897,7 +2899,7 @@ lemma storePDE_invs[wp]:
    apply (wp sch_act_wf_lift valid_global_refs_lift'
              irqs_masked_lift
              valid_arch_state_lift' valid_irq_node_lift
-             cur_tcb_lift valid_irq_handlers_lift''
+             cur_tcb_lift valid_irq_handlers_lift'' valid_bitmaps_lift sym_heap_sched_pointers_lift
              untyped_ranges_zero_lift
            | simp add: cteCaps_of_def o_def)+
   apply clarsimp
@@ -2926,14 +2928,6 @@ crunch norqL1[wp]: storePTE "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
 crunch norqL2[wp]: storePTE "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
   (simp: updateObject_default_def)
 
-lemma storePTE_valid_queues [wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> storePTE p pde \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  by (wp valid_queues_lift | simp add: pred_tcb_at'_def)+
-
-lemma storePTE_valid_queues' [wp]:
-  "\<lbrace>valid_queues'\<rbrace> storePTE p pde \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  by (wp valid_queues_lift')
-
 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)
@@ -3070,7 +3064,7 @@ lemma storePTE_invs [wp]:
    apply (wp sch_act_wf_lift valid_global_refs_lift' irqs_masked_lift
              valid_arch_state_lift' valid_irq_node_lift
              cur_tcb_lift valid_irq_handlers_lift''
-             untyped_ranges_zero_lift
+             untyped_ranges_zero_lift valid_bitmaps_lift
            | simp add: cteCaps_of_def o_def)+
   apply clarsimp
   done
@@ -3116,14 +3110,6 @@ 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_valid_queues [wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  by (wp valid_queues_lift | simp add: pred_tcb_at'_def)+
-
-lemma setASIDPool_valid_queues' [wp]:
-  "\<lbrace>valid_queues'\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  by (wp valid_queues_lift')
-
 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
@@ -3236,6 +3222,10 @@ 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_state'_def valid_pspace'_def)
@@ -3244,7 +3234,7 @@ lemma setASIDPool_invs [wp]:
              valid_arch_state_lift' valid_irq_node_lift
              cur_tcb_lift valid_irq_handlers_lift''
              untyped_ranges_zero_lift
-             updateObject_default_inv
+             updateObject_default_inv valid_bitmaps_lift
            | simp add: cteCaps_of_def
            | rule setObject_ksPSpace_only)+
   apply (clarsimp simp add: setObject_def o_def)
diff --git a/proof/refine/ARM/orphanage/Orphanage.thy b/proof/refine/ARM/orphanage/Orphanage.thy
index 5ca2f8ef52..c8c0643e00 100644
--- a/proof/refine/ARM/orphanage/Orphanage.thy
+++ b/proof/refine/ARM/orphanage/Orphanage.thy
@@ -59,8 +59,7 @@ where
 definition
    all_queued_tcb_ptrs :: "kernel_state \<Rightarrow> machine_word set"
 where
-   "all_queued_tcb_ptrs s \<equiv>
-       { tcb_ptr. \<exists> priority. tcb_ptr : set ((ksReadyQueues s) priority) }"
+   "all_queued_tcb_ptrs s \<equiv> { tcb_ptr. obj_at' tcbQueued tcb_ptr s }"
 
 lemma st_tcb_at_neg':
   "(st_tcb_at' (\<lambda> ts. \<not> P ts) t s) = (tcb_at' t s \<and> \<not> st_tcb_at' P t s)"
@@ -107,8 +106,8 @@ lemma no_orphans_lift:
      "\<And> tcb_ptr. \<lbrace> \<lambda>s. tcb_ptr = ksCurThread s \<rbrace> f \<lbrace> \<lambda>_ s. tcb_ptr = ksCurThread s \<rbrace>"
    assumes st_tcb_at'_is_lifted:
      "\<And>P p. \<lbrace> \<lambda>s. st_tcb_at' P p s\<rbrace> f \<lbrace> \<lambda>_ s. st_tcb_at' P p s \<rbrace>"
-   assumes ksReadyQueues_is_lifted:
-     "\<And>P. \<lbrace> \<lambda>s. P (ksReadyQueues s)\<rbrace> f \<lbrace> \<lambda>_ s. P (ksReadyQueues s) \<rbrace>"
+   assumes tcbQueued_is_lifted:
+     "\<And>P tcb_ptr. f \<lbrace> \<lambda>s. obj_at' (\<lambda>tcb. P (tcbQueued tcb)) tcb_ptr s \<rbrace>"
    assumes ksSchedulerAction_is_lifted:
      "\<And>P. \<lbrace> \<lambda>s. P (ksSchedulerAction s)\<rbrace> f \<lbrace> \<lambda>_ s. P (ksSchedulerAction s) \<rbrace>"
    shows
@@ -119,7 +118,7 @@ lemma no_orphans_lift:
   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
     apply (rule ksCurThread_is_lifted)
    apply (wp hoare_vcg_disj_lift)
-    apply (rule ksReadyQueues_is_lifted)
+    apply (wpsimp wp: tcbQueued_is_lifted)
    apply (wp hoare_vcg_disj_lift)
     apply (rule typ_at'_is_lifted)
    apply (wp hoare_vcg_disj_lift)
@@ -139,13 +138,12 @@ lemma st_tcb_at'_all_active_tcb_ptrs_lift:
   by (clarsimp simp: all_active_tcb_ptrs_def)
      (rule st_tcb_at'_is_active_tcb_ptr_lift [OF assms])
 
-lemma ksQ_all_queued_tcb_ptrs_lift:
-  assumes "\<And>P p. \<lbrace>\<lambda>s. P (ksReadyQueues s p)\<rbrace> f \<lbrace>\<lambda>rv s. P (ksReadyQueues s p)\<rbrace>"
+lemma tcbQueued_all_queued_tcb_ptrs_lift:
+  assumes "\<And>Q P tcb_ptr. f \<lbrace>\<lambda>s. Q (obj_at' (\<lambda>tcb. P (tcbQueued tcb)) tcb_ptr s)\<rbrace>"
   shows "\<lbrace>\<lambda>s. P (t \<in> all_queued_tcb_ptrs s)\<rbrace> f \<lbrace>\<lambda>_ s. P (t \<in> all_queued_tcb_ptrs s)\<rbrace>"
   apply (clarsimp simp: all_queued_tcb_ptrs_def)
   apply (rule_tac P=P in P_bool_lift)
    apply (wp hoare_vcg_ex_lift assms)
-  apply (clarsimp)
   apply (wp hoare_vcg_all_lift assms)
   done
 
@@ -180,6 +178,11 @@ lemma almost_no_orphans_disj:
   apply (auto intro: pred_tcb_at')
   done
 
+lemma all_queued_tcb_ptrs_ksReadyQueues_update[simp]:
+  "tcb_ptr \<in> all_queued_tcb_ptrs (ksReadyQueues_update f s) = (tcb_ptr \<in> all_queued_tcb_ptrs s)"
+  unfolding all_queued_tcb_ptrs_def
+  by (clarsimp simp: obj_at'_def projectKOs)
+
 lemma no_orphans_update_simps[simp]:
   "no_orphans (gsCNodes_update f s) = no_orphans s"
   "no_orphans (gsUserPages_update g s) = no_orphans s"
@@ -252,6 +255,12 @@ crunch no_orphans [wp]: removeFromBitmap "no_orphans"
 crunch almost_no_orphans [wp]: addToBitmap "almost_no_orphans x"
 crunch almost_no_orphans [wp]: removeFromBitmap "almost_no_orphans x"
 
+lemma setCTE_tcbQueued[wp]:
+  "setCTE ptr v \<lbrace>\<lambda>s. Q (obj_at' (\<lambda>tcb. P (tcbQueued tcb)) t s)\<rbrace>"
+  apply (simp add: setCTE_def)
+  apply (rule setObject_cte_obj_at_tcb', simp_all)
+  done
+
 lemma setCTE_no_orphans [wp]:
   "\<lbrace> \<lambda>s. no_orphans s \<rbrace>
    setCTE p cte
@@ -265,7 +274,7 @@ lemma setCTE_almost_no_orphans [wp]:
    setCTE p cte
    \<lbrace> \<lambda>rv s. almost_no_orphans tcb_ptr s \<rbrace>"
   unfolding almost_no_orphans_disj all_queued_tcb_ptrs_def
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift setCTE_typ_at' setCTE_pred_tcb_at')
+  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift setCTE_typ_at' setCTE_pred_tcb_at')
   done
 
 crunch no_orphans [wp]: activateIdleThread "no_orphans"
@@ -275,128 +284,131 @@ lemma asUser_no_orphans [wp]:
    asUser thread f
    \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
   unfolding no_orphans_disj all_queued_tcb_ptrs_def
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
+  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift)
+  done
+
+lemma threadSet_all_queued_tcb_ptrs:
+  "\<forall>tcb. tcbQueued (F tcb) = tcbQueued tcb \<Longrightarrow> threadSet F tptr \<lbrace>\<lambda>s. P (t \<in> all_queued_tcb_ptrs s)\<rbrace>"
+  unfolding almost_no_orphans_disj all_queued_tcb_ptrs_def
+  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_st_tcb_at2 threadSet_wp)
+  apply (erule rsubst[where P=P])
+  apply (clarsimp simp: obj_at'_def projectKOs ps_clear_upd objBits_simps)
   done
 
+crunches removeFromBitmap, addToBitmap, setQueue
+  for all_queued_tcb_ptrs[wp]: "\<lambda>s. P (t \<in> all_queued_tcb_ptrs s)"
+  (wp: tcbQueued_all_queued_tcb_ptrs_lift)
+
+crunches tcbQueuePrepend, tcbQueueAppend
+  for all_queued_tcb_ptrs[wp]: "\<lambda>s. P (t \<in> all_queued_tcb_ptrs s)"
+  (wp: threadSet_all_queued_tcb_ptrs ignore: threadSet)
+
+lemma tcbQueued_update_True_all_queued_tcb_ptrs[wp]:
+  "\<lbrace>\<lambda>s. tcb_ptr \<noteq> tcb_ptr' \<longrightarrow> tcb_ptr' \<in> all_queued_tcb_ptrs s\<rbrace>
+   threadSet (tcbQueued_update (\<lambda>_. True)) tcb_ptr
+   \<lbrace>\<lambda>_ s. tcb_ptr' \<in> all_queued_tcb_ptrs s\<rbrace>"
+  apply (wpsimp wp: threadSet_wp)
+  apply (fastforce simp: all_queued_tcb_ptrs_def obj_at'_def projectKOs ps_clear_upd objBits_simps)
+  done
+
+lemma tcbSchedEnqueue_all_queued_tcb_ptrs[wp]:
+  "\<lbrace>\<lambda>s. tcb_ptr \<noteq> tcb_ptr' \<longrightarrow> tcb_ptr \<in> all_queued_tcb_ptrs s\<rbrace>
+   tcbSchedEnqueue tcb_ptr'
+   \<lbrace>\<lambda>_ s. tcb_ptr \<in> all_queued_tcb_ptrs s\<rbrace>"
+  unfolding tcbSchedEnqueue_def tcbQueuePrepend_def
+  apply (wpsimp wp: hoare_vcg_imp_lift' threadGet_wp
+         | wpsimp wp: threadSet_all_queued_tcb_ptrs)+
+  apply (clarsimp simp: all_queued_tcb_ptrs_def obj_at'_def projectKOs)
+  done
+
+lemmas tcbSchedEnqueue_all_queued_tcb_ptrs'[wp] =
+  tcbSchedEnqueue_all_queued_tcb_ptrs[simplified all_queued_tcb_ptrs_def, simplified]
+
+lemma tcbSchedAppend_all_queued_tcb_ptrs[wp]:
+  "\<lbrace>\<lambda>s. tcb_ptr \<noteq> tcb_ptr' \<longrightarrow> tcb_ptr \<in> all_queued_tcb_ptrs s\<rbrace>
+   tcbSchedAppend tcb_ptr'
+   \<lbrace>\<lambda>_ s. tcb_ptr \<in> all_queued_tcb_ptrs s\<rbrace>"
+  unfolding tcbSchedAppend_def tcbQueueAppend_def
+  apply (wpsimp wp: hoare_vcg_imp_lift' threadGet_wp
+         | wpsimp wp: threadSet_all_queued_tcb_ptrs)+
+  apply (clarsimp simp: all_queued_tcb_ptrs_def obj_at'_def projectKOs)
+  done
+
+lemmas tcbSchedAppend_all_queued_tcb_ptrs'[wp] =
+  tcbSchedAppend_all_queued_tcb_ptrs[simplified all_queued_tcb_ptrs_def, simplified]
+
 lemma threadSet_no_orphans:
-  "\<forall>tcb. \<not> is_active_thread_state (tcbState tcb) \<longrightarrow> \<not> is_active_thread_state (tcbState (F tcb)) \<Longrightarrow>
-   \<lbrace> \<lambda>s. no_orphans s \<rbrace>
-   threadSet F tptr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+  "\<lbrakk>\<forall>tcb. \<not> is_active_thread_state (tcbState tcb) \<longrightarrow> \<not> is_active_thread_state (tcbState (F tcb));
+    \<forall>tcb. tcbQueued (F tcb) = tcbQueued tcb\<rbrakk>
+   \<Longrightarrow> threadSet F tptr \<lbrace>no_orphans\<rbrace>"
   unfolding no_orphans_disj all_queued_tcb_ptrs_def
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_st_tcb_at2 | clarsimp)+
-  done
+  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_st_tcb_at2)
 
-lemma threadSet_almost_no_orphans:
-  "\<forall>tcb. \<not> is_active_thread_state (tcbState tcb) \<longrightarrow> \<not> is_active_thread_state (tcbState (F tcb)) \<Longrightarrow>
-   \<lbrace> \<lambda>s. almost_no_orphans ptr s \<rbrace>
-   threadSet F tptr
-   \<lbrace> \<lambda>rv s. almost_no_orphans ptr s \<rbrace>"
-  unfolding almost_no_orphans_disj all_queued_tcb_ptrs_def
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_st_tcb_at2 | clarsimp)+
+lemma tcbQueued_update_True_no_orphans:
+  "\<lbrace>almost_no_orphans tptr and tcb_at' tptr\<rbrace>
+   threadSet (tcbQueued_update (\<lambda>_. True)) tptr
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
+  unfolding no_orphans_disj
+  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_st_tcb_at2)
+  apply (fastforce simp: almost_no_orphans_def all_active_tcb_ptrs_def
+                         tcb_at_typ_at' st_tcb_at_neg' is_active_tcb_ptr_def)
   done
 
-lemma setQueue_no_orphans_enq:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> set (ksReadyQueues s (d, prio)) \<subseteq> set qs \<rbrace>
-   setQueue d prio qs
-   \<lbrace> \<lambda>_ s. no_orphans s \<rbrace>"
-  unfolding setQueue_def
-  apply wp
-  apply (clarsimp simp: no_orphans_def all_queued_tcb_ptrs_def
-                  split: if_split_asm)
+lemma tcbQueued_update_True_almost_no_orphans:
+  "threadSet (tcbQueued_update (\<lambda>_. True)) tptr' \<lbrace>almost_no_orphans tptr\<rbrace>"
+  unfolding almost_no_orphans_disj
+  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift' hoare_vcg_disj_lift threadSet_st_tcb_at2)
   apply fastforce
   done
 
-lemma setQueue_almost_no_orphans_enq:
-  "\<lbrace> \<lambda>s. almost_no_orphans tcb_ptr s \<and> set (ksReadyQueues s (d, prio)) \<subseteq> set qs \<and> tcb_ptr \<in> set qs \<rbrace>
-   setQueue d prio qs
-   \<lbrace> \<lambda>_ s. no_orphans s \<rbrace>"
+lemma threadSet_almost_no_orphans:
+  "\<lbrakk>\<forall>tcb. \<not> is_active_thread_state (tcbState tcb) \<longrightarrow> \<not> is_active_thread_state (tcbState (F tcb));
+    \<forall>tcb. tcbQueued (F tcb) = tcbQueued tcb\<rbrakk>
+   \<Longrightarrow> threadSet F tptr \<lbrace>almost_no_orphans ptr\<rbrace>"
+  unfolding almost_no_orphans_disj all_queued_tcb_ptrs_def
+  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_st_tcb_at2)
+
+lemma setQueue_no_orphans[wp]:
+  "setQueue d prio qs \<lbrace>no_orphans\<rbrace>"
   unfolding setQueue_def
   apply wp
-  apply (clarsimp simp: no_orphans_def almost_no_orphans_def all_queued_tcb_ptrs_def
-                  split: if_split_asm)
-  apply fastforce
+  apply (clarsimp simp: no_orphans_def)
   done
 
-lemma setQueue_almost_no_orphans_enq_lift:
-  "\<lbrace> \<lambda>s. almost_no_orphans tcb_ptr s \<and> set (ksReadyQueues s (d, prio)) \<subseteq> set qs \<rbrace>
-   setQueue d prio qs
-   \<lbrace> \<lambda>_ s. almost_no_orphans tcb_ptr s \<rbrace>"
+lemma setQueue_almost_no_orphans[wp]:
+  "setQueue d prio qs \<lbrace>almost_no_orphans tptr\<rbrace>"
   unfolding setQueue_def
   apply wp
-  apply (clarsimp simp: almost_no_orphans_def all_queued_tcb_ptrs_def
-                  split: if_split_asm)
-  apply fastforce
+  apply (clarsimp simp: almost_no_orphans_def)
   done
 
 lemma tcbSchedEnqueue_no_orphans[wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<rbrace>
-   tcbSchedEnqueue tcb_ptr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
-  unfolding tcbSchedEnqueue_def
-  apply (wp setQueue_no_orphans_enq threadSet_no_orphans | clarsimp simp: unless_def)+
-   apply (wp getObject_tcb_wp | clarsimp simp: threadGet_def)+
-  apply (drule obj_at_ko_at')
-  apply auto
+  "tcbSchedEnqueue tcb_ptr \<lbrace>no_orphans\<rbrace>"
+  unfolding tcbSchedEnqueue_def tcbQueuePrepend_def
+  apply (wpsimp wp: tcbQueued_update_True_no_orphans threadSet_almost_no_orphans threadGet_wp)
+  apply (fastforce simp: no_orphans_strg_almost)
   done
 
 lemma tcbSchedAppend_no_orphans[wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<rbrace>
-   tcbSchedAppend tcb_ptr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
-  unfolding tcbSchedAppend_def
-  apply (wp setQueue_no_orphans_enq threadSet_no_orphans | clarsimp simp: unless_def)+
-   apply (wp getObject_tcb_wp | clarsimp simp: threadGet_def)+
-  apply (drule obj_at_ko_at')
-  apply auto
-  done
-
-lemma ko_at_obj_at':
-  "ko_at' ko p s \<and> P ko \<Longrightarrow> obj_at' P p s"
-  unfolding  obj_at'_def
-  apply clarsimp
-  done
-
-lemma queued_in_queue:
-  "\<lbrakk>valid_queues' s; ko_at' tcb tcb_ptr s; tcbQueued tcb\<rbrakk> \<Longrightarrow>
-   \<exists> p. tcb_ptr \<in> set (ksReadyQueues s p)"
-  unfolding valid_queues'_def
-   apply (drule_tac x="tcbDomain tcb" in spec)
-   apply (drule_tac x="tcbPriority tcb" in spec)
-   apply (drule_tac x="tcb_ptr" in spec)
-   apply (drule mp)
-    apply (rule ko_at_obj_at')
-    apply (auto simp: inQ_def)
+  "tcbSchedAppend tcb_ptr \<lbrace>no_orphans\<rbrace>"
+  unfolding tcbSchedAppend_def tcbQueueAppend_def
+  apply (wpsimp wp: tcbQueued_update_True_no_orphans threadSet_almost_no_orphans threadGet_wp)
+  apply (fastforce simp: no_orphans_strg_almost)
   done
 
 lemma tcbSchedEnqueue_almost_no_orphans:
-  "\<lbrace> \<lambda>s. almost_no_orphans tcb_ptr s \<and> valid_queues' s \<rbrace>
+  "\<lbrace>almost_no_orphans tcb_ptr\<rbrace>
    tcbSchedEnqueue tcb_ptr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
-  unfolding tcbSchedEnqueue_def
-  apply simp
-  apply (wp setQueue_almost_no_orphans_enq[where tcb_ptr=tcb_ptr] threadSet_no_orphans
-            | clarsimp)+
-   apply (wp getObject_tcb_wp | clarsimp simp: threadGet_def)+
-  apply normalise_obj_at'
-  apply (rule_tac x=ko in exI)
-  apply (clarsimp simp: subset_insertI)
-  apply (unfold no_orphans_def almost_no_orphans_def)
-  apply clarsimp
-  apply (drule(2) queued_in_queue)
-  apply (fastforce simp: all_queued_tcb_ptrs_def)
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
+  unfolding tcbSchedEnqueue_def tcbQueuePrepend_def
+  apply (wpsimp wp: tcbQueued_update_True_no_orphans threadSet_almost_no_orphans threadGet_wp)
+  apply (fastforce simp: no_orphans_def almost_no_orphans_def all_queued_tcb_ptrs_def obj_at'_def)
   done
 
 lemma tcbSchedEnqueue_almost_no_orphans_lift:
-  "\<lbrace> \<lambda>s. almost_no_orphans ptr s \<rbrace>
-   tcbSchedEnqueue tcb_ptr
-   \<lbrace> \<lambda>rv s. almost_no_orphans ptr s \<rbrace>"
-  unfolding tcbSchedEnqueue_def
-  apply (wp setQueue_almost_no_orphans_enq_lift threadSet_almost_no_orphans | clarsimp simp: unless_def)+
-   apply (wp getObject_tcb_wp | clarsimp simp: threadGet_def)+
-  apply (drule obj_at_ko_at')
-  apply auto
-  done
+  "tcbSchedEnqueue tcb_ptr \<lbrace>almost_no_orphans ptr\<rbrace>"
+  unfolding tcbSchedEnqueue_def tcbQueuePrepend_def
+  by (wpsimp wp: tcbQueued_update_True_almost_no_orphans threadSet_almost_no_orphans)
 
 lemma ssa_no_orphans:
   "\<lbrace> \<lambda>s. no_orphans s \<and>
@@ -428,124 +440,70 @@ lemma ssa_almost_no_orphans_lift [wp]:
   apply auto
   done
 
-lemma tcbSchedEnqueue_inQueue [wp]:
-  "\<lbrace> \<lambda>s. valid_queues' s \<rbrace>
-   tcbSchedEnqueue tcb_ptr
-   \<lbrace> \<lambda>rv s. tcb_ptr \<in> all_queued_tcb_ptrs s \<rbrace>"
-  unfolding tcbSchedEnqueue_def all_queued_tcb_ptrs_def
-  apply (wp | clarsimp simp: unless_def)+
-   apply (rule_tac Q="\<lambda>rv. \<top>" in hoare_post_imp)
-    apply fastforce
-   apply (wp getObject_tcb_wp | clarsimp simp: threadGet_def)+
-  apply (fastforce simp: obj_at'_def valid_queues'_def inQ_def)
-  done
-
-lemma tcbSchedAppend_inQueue [wp]:
-  "\<lbrace> \<lambda>s. valid_queues' s \<rbrace>
-   tcbSchedAppend tcb_ptr
-   \<lbrace> \<lambda>rv s. tcb_ptr \<in> all_queued_tcb_ptrs s \<rbrace>"
-  unfolding tcbSchedAppend_def all_queued_tcb_ptrs_def
-  apply (wp | clarsimp simp: unless_def)+
-   apply (rule_tac Q="\<lambda>rv. \<top>" in hoare_post_imp)
-    apply fastforce
-   apply (wp getObject_tcb_wp | clarsimp simp: threadGet_def)+
-  apply (fastforce simp: obj_at'_def valid_queues'_def inQ_def)
-  done
-
 lemma rescheduleRequired_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<rbrace>
-   rescheduleRequired
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+  "rescheduleRequired \<lbrace>no_orphans\<rbrace>"
   unfolding rescheduleRequired_def
-  apply (wp tcbSchedEnqueue_no_orphans hoare_vcg_all_lift ssa_no_orphans | wpc | clarsimp)+
-   apply (wps tcbSchedEnqueue_nosch, wp hoare_weak_lift_imp)
-   apply (rename_tac word t p)
-   apply (rule_tac P="word = t" in hoare_gen_asm)
-   apply (wp hoare_disjI1 | clarsimp)+
-  done
+  by (wpsimp wp: ssa_no_orphans hoare_vcg_all_lift hoare_vcg_imp_lift' hoare_vcg_disj_lift | wpc)+
 
 lemma rescheduleRequired_almost_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. almost_no_orphans tcb_ptr s \<and> valid_queues' s \<rbrace>
-   rescheduleRequired
-   \<lbrace> \<lambda>rv s. almost_no_orphans tcb_ptr s \<rbrace>"
+  "rescheduleRequired \<lbrace>almost_no_orphans tcb_ptr\<rbrace>"
   unfolding rescheduleRequired_def
-  apply (wp tcbSchedEnqueue_almost_no_orphans_lift hoare_vcg_all_lift | wpc | clarsimp)+
-   apply (wps tcbSchedEnqueue_nosch, wp hoare_weak_lift_imp)
-   apply (rename_tac word t p)
-   apply (rule_tac P="word = t" in hoare_gen_asm)
-   apply (wp hoare_disjI1 | clarsimp)+
-  done
+  by (wpsimp wp: ssa_almost_no_orphans_lift hoare_vcg_all_lift tcbSchedEnqueue_almost_no_orphans_lift
+                 hoare_vcg_imp_lift' hoare_vcg_disj_lift)
 
 lemma setThreadState_current_no_orphans:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> ksCurThread s = tcb_ptr \<and> valid_queues' s \<rbrace>
+  "\<lbrace>\<lambda>s. no_orphans s \<and> ksCurThread s = tcb_ptr\<rbrace>
    setThreadState state tcb_ptr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding setThreadState_def
-  apply (wp | clarsimp)+
-  apply (rule_tac Q="\<lambda>rv s. valid_queues' s \<and> no_orphans s" in hoare_post_imp)
-   apply clarsimp
-  apply (wp threadSet_valid_queues')
-   apply (unfold no_orphans_disj all_queued_tcb_ptrs_def)
-   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_pred_tcb_at_state)
-   apply (auto simp: inQ_def)
+  apply wpsimp
+  unfolding no_orphans_disj
+   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_pred_tcb_at_state
+             threadSet_all_queued_tcb_ptrs
+          | fastforce)+
   done
 
 lemma setThreadState_isRestart_no_orphans:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> st_tcb_at' isRestart tcb_ptr s \<and> valid_queues' s\<rbrace>
+  "\<lbrace>no_orphans and st_tcb_at' isRestart tcb_ptr\<rbrace>
    setThreadState state tcb_ptr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_ . no_orphans\<rbrace>"
   unfolding setThreadState_def
-  apply (wp | clarsimp)+
-  apply (rule_tac Q="\<lambda>rv s. valid_queues' s \<and> no_orphans s" in hoare_post_imp)
-   apply clarsimp
-  apply (wp threadSet_valid_queues')
-   apply (unfold no_orphans_disj all_queued_tcb_ptrs_def is_active_thread_state_def)
-   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_pred_tcb_at_state)
-   apply (auto simp: st_tcb_at_double_neg' st_tcb_at_neg' inQ_def)
+  apply wpsimp
+   unfolding no_orphans_disj
+   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_pred_tcb_at_state
+             threadSet_all_queued_tcb_ptrs
+          | fastforce)+
+  apply (auto simp: is_active_thread_state_def st_tcb_at_double_neg' st_tcb_at_neg')
   done
 
 lemma setThreadState_almost_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s\<rbrace>
-   setThreadState state tcb_ptr
-   \<lbrace> \<lambda>rv s. almost_no_orphans tcb_ptr s \<rbrace>"
+  "\<lbrace>no_orphans\<rbrace> setThreadState state tcb_ptr \<lbrace>\<lambda>_. almost_no_orphans tcb_ptr\<rbrace>"
   unfolding setThreadState_def
-  apply (wp | clarsimp)+
-  apply (rule_tac Q="\<lambda>rv s. valid_queues' s \<and> almost_no_orphans tcb_ptr s" in hoare_post_imp)
-   apply clarsimp
-  apply (wp threadSet_valid_queues')
-   apply (unfold no_orphans_disj almost_no_orphans_disj all_queued_tcb_ptrs_def)
-   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_pred_tcb_at_state)
-   apply (auto simp: inQ_def)
+  apply wpsimp
+   apply (unfold no_orphans_disj almost_no_orphans_disj)
+   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_pred_tcb_at_state
+             threadSet_all_queued_tcb_ptrs
+          | fastforce)+
   done
 
 lemma setThreadState_not_active_no_orphans:
-  "\<not> is_active_thread_state state \<Longrightarrow>
-   \<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<rbrace>
-   setThreadState state tcb_ptr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+  "\<not> is_active_thread_state state \<Longrightarrow> setThreadState state tcb_ptr \<lbrace>no_orphans\<rbrace>"
   unfolding setThreadState_def
-  apply (wp | clarsimp)+
-  apply (rule_tac Q="\<lambda>rv s. valid_queues' s \<and> no_orphans s" in hoare_post_imp)
-   apply clarsimp
-  apply (wp threadSet_valid_queues')
-   apply (unfold no_orphans_disj all_queued_tcb_ptrs_def is_active_thread_state_def)
-   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_pred_tcb_at_state)
-   apply (auto simp: isRunning_def isRestart_def inQ_def)
+  apply wpsimp
+   apply (unfold no_orphans_disj)
+   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_pred_tcb_at_state
+             threadSet_all_queued_tcb_ptrs
+          | fastforce)+
   done
 
 lemma setThreadState_not_active_almost_no_orphans:
-  "\<not> is_active_thread_state state \<Longrightarrow>
-   \<lbrace> \<lambda>s. almost_no_orphans thread s \<and> valid_queues' s \<rbrace>
-   setThreadState state tcb_ptr
-   \<lbrace> \<lambda>rv s. almost_no_orphans thread s \<rbrace>"
+  "\<not> is_active_thread_state state \<Longrightarrow> setThreadState state tcb_ptr \<lbrace>almost_no_orphans thread\<rbrace>"
   unfolding setThreadState_def
-  apply (wp | clarsimp)+
-  apply (rule_tac Q="\<lambda>rv s. valid_queues' s \<and> almost_no_orphans thread s" in hoare_post_imp)
-   apply clarsimp
-  apply (wp threadSet_valid_queues')
-   apply (unfold almost_no_orphans_disj all_queued_tcb_ptrs_def is_active_thread_state_def)
-   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_pred_tcb_at_state)
-   apply (auto simp: isRunning_def isRestart_def inQ_def)
+  apply wpsimp
+   apply (unfold almost_no_orphans_disj)
+   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_pred_tcb_at_state
+             threadSet_all_queued_tcb_ptrs
+          | fastforce)+
   done
 
 lemma activateThread_no_orphans [wp]:
@@ -557,60 +515,75 @@ lemma activateThread_no_orphans [wp]:
   apply (auto simp: ct_in_state'_def pred_tcb_at'_def obj_at'_def isRestart_def)
   done
 
-lemma setQueue_no_orphans_deq:
-  "\<lbrace> \<lambda>s. \<exists> tcb_ptr. no_orphans s \<and> \<not> is_active_tcb_ptr tcb_ptr s \<and>
-        queue = [x\<leftarrow>((ksReadyQueues s) (d, priority)). x \<noteq> tcb_ptr] \<rbrace>
-   setQueue d priority queue
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
-  unfolding setQueue_def
-  apply (wp | clarsimp)+
-  apply (fastforce simp: no_orphans_def all_queued_tcb_ptrs_def
-                        all_active_tcb_ptrs_def is_active_tcb_ptr_def)
+crunches removeFromBitmap, tcbQueueRemove, setQueue
+  for almost_no_orphans[wp]: "almost_no_orphans thread"
+  and no_orphans[wp]: no_orphans
+  and all_queued_tcb_ptrs[wp]: "\<lambda>s. tcb_ptr \<in> all_queued_tcb_ptrs s"
+  (wp: crunch_wps)
+
+lemma tcbQueued_update_False_all_queued_tcb_ptrs:
+  "\<lbrace>\<lambda>s. tcb_ptr \<noteq> tcb_ptr' \<and> tcb_ptr' \<in> all_queued_tcb_ptrs s\<rbrace>
+   threadSet (tcbQueued_update (\<lambda>_. False)) tcb_ptr
+   \<lbrace>\<lambda>_ s. tcb_ptr' \<in> all_queued_tcb_ptrs s\<rbrace>"
+  apply (wpsimp wp: threadSet_wp)
+  apply (clarsimp simp: all_queued_tcb_ptrs_def obj_at'_def projectKOs ps_clear_upd)
   done
 
-lemma setQueue_almost_no_orphans_deq [wp]:
-  "\<lbrace> \<lambda>s. almost_no_orphans tcb_ptr s \<and>
-        queue = [x\<leftarrow>((ksReadyQueues s) (d, priority)). x \<noteq> tcb_ptr] \<rbrace>
-   setQueue d priority queue
-   \<lbrace> \<lambda>rv s. almost_no_orphans tcb_ptr s \<rbrace>"
-  unfolding setQueue_def
-  apply (wp | clarsimp)+
-  apply (fastforce simp: almost_no_orphans_def all_queued_tcb_ptrs_def
-                        all_active_tcb_ptrs_def is_active_tcb_ptr_def)
+lemma tcbSchedDequeue_all_queued_tcb_ptrs_other:
+  "\<lbrace>\<lambda>s. tcb_ptr \<noteq> tcb_ptr' \<and> tcb_ptr' \<in> all_queued_tcb_ptrs s\<rbrace>
+   tcbSchedDequeue tcb_ptr
+   \<lbrace>\<lambda>_ s. tcb_ptr' \<in> all_queued_tcb_ptrs s\<rbrace>"
+  unfolding tcbSchedDequeue_def
+  by (wpsimp wp: tcbQueued_update_False_all_queued_tcb_ptrs threadGet_wp)
+
+lemma tcbQueued_update_False_almost_no_orphans:
+  "\<lbrace>no_orphans\<rbrace>
+   threadSet (tcbQueued_update (\<lambda>_. False)) tptr
+   \<lbrace>\<lambda>_. almost_no_orphans tptr\<rbrace>"
+  apply (wpsimp wp: threadSet_wp)
+  apply (clarsimp simp: no_orphans_def almost_no_orphans_def)
+  apply (rename_tac tcb_ptr)
+  apply (case_tac "tcb_ptr = tptr")
+   apply fastforce
+  apply (fastforce simp: all_queued_tcb_ptrs_def obj_at'_def projectKOs all_active_tcb_ptrs_def
+                         is_active_tcb_ptr_def st_tcb_at'_def ps_clear_upd)
   done
 
 lemma tcbSchedDequeue_almost_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<rbrace>
-   tcbSchedDequeue thread
-   \<lbrace> \<lambda>rv s. almost_no_orphans thread s \<rbrace>"
+  "\<lbrace>no_orphans\<rbrace> tcbSchedDequeue thread \<lbrace>\<lambda>_. almost_no_orphans thread\<rbrace>"
   unfolding tcbSchedDequeue_def
-  apply (wp threadSet_almost_no_orphans | simp cong: if_cong)+
-  apply (simp add:no_orphans_strg_almost cong: if_cong)
+  apply (wpsimp wp: tcbQueued_update_False_almost_no_orphans threadGet_wp)
+  apply (simp add: no_orphans_strg_almost)
   done
 
-lemma tcbSchedDequeue_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> \<not> is_active_tcb_ptr tcb_ptr s \<rbrace>
-   tcbSchedDequeue tcb_ptr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
-  unfolding tcbSchedDequeue_def
-  apply (wp setQueue_no_orphans_deq threadSet_no_orphans | clarsimp)+
-   apply (wp getObject_tcb_wp | clarsimp simp: threadGet_def)+
-  apply (drule obj_at_ko_at')
-  apply auto
+lemma tcbSchedDequeue_no_orphans[wp]:
+  "\<lbrace>\<lambda>s. no_orphans s \<and> \<not> is_active_tcb_ptr tcbPtr s \<and> tcb_at' tcbPtr s\<rbrace>
+   tcbSchedDequeue tcbPtr
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
+  supply disj_not1[simp del]
+  unfolding no_orphans_disj almost_no_orphans_disj
+  apply (rule hoare_allI)
+  apply (rename_tac tcb_ptr)
+  apply (case_tac "tcb_ptr = tcbPtr")
+   apply (rule_tac Q="\<lambda>_ s. st_tcb_at' (\<lambda>state. \<not> is_active_thread_state state) tcbPtr s"
+                in hoare_post_imp)
+    apply fastforce
+   apply wpsimp
+   apply (clarsimp simp: st_tcb_at'_def obj_at'_def projectKOs is_active_tcb_ptr_def disj_not1)
+  apply (wpsimp wp: tcbQueued_update_False_all_queued_tcb_ptrs hoare_vcg_disj_lift
+              simp: tcbSchedDequeue_def)
   done
 
 lemma switchToIdleThread_no_orphans' [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and>
-          (is_active_tcb_ptr (ksCurThread s) s
-             \<longrightarrow> ksCurThread s \<in> all_queued_tcb_ptrs s) \<rbrace>
+  "\<lbrace>\<lambda>s. no_orphans s
+        \<and> (is_active_tcb_ptr (ksCurThread s) s \<longrightarrow> ksCurThread s \<in> all_queued_tcb_ptrs s)\<rbrace>
    switchToIdleThread
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
-  unfolding switchToIdleThread_def setCurThread_def ARM_H.switchToIdleThread_def
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
+  supply disj_not1[simp del]
+  apply (clarsimp simp: switchToIdleThread_def setCurThread_def ARM_H.switchToIdleThread_def)
   apply (simp add: no_orphans_disj all_queued_tcb_ptrs_def)
-  apply (wp hoare_vcg_all_lift hoare_vcg_imp_lift hoare_vcg_disj_lift
-       | clarsimp)+
-  apply (auto simp: no_orphans_disj all_queued_tcb_ptrs_def is_active_tcb_ptr_def
-                    st_tcb_at_neg' tcb_at_typ_at')
+  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift hoare_drop_imps)
+  apply (force simp: is_active_tcb_ptr_def st_tcb_at_neg' typ_at_tcb')
   done
 
 crunch no_orphans [wp]: "Arch.switchToThread" "no_orphans"
@@ -622,13 +595,9 @@ crunch ksCurThread [wp]: "Arch.switchToThread" "\<lambda> s. P (ksCurThread s)"
 crunch ksIdleThread [wp]: "Arch.switchToThread" "\<lambda> s. P (ksIdleThread s)"
   (ignore: ARM.clearExMonitor)
 
-lemma ArchThreadDecls_H_switchToThread_all_queued_tcb_ptrs [wp]:
-  "\<lbrace> \<lambda>s. P (all_queued_tcb_ptrs s) \<rbrace>
-   Arch.switchToThread tcb_ptr
-   \<lbrace> \<lambda>rv s. P (all_queued_tcb_ptrs s) \<rbrace>"
-  unfolding ARM_H.switchToThread_def all_queued_tcb_ptrs_def
-  apply (wp | clarsimp)+
-  done
+crunches Arch.switchToThread
+  for all_queued_tcb_ptrs[wp]: "\<lambda>s. P (t \<in> all_queued_tcb_ptrs s)"
+  (wp: tcbQueued_all_queued_tcb_ptrs_lift)
 
 crunch ksSchedulerAction [wp]: "Arch.switchToThread" "\<lambda>s. P (ksSchedulerAction s)"
   (ignore: ARM.clearExMonitor)
@@ -646,22 +615,6 @@ lemma setCurThread_no_orphans [wp]:
   apply auto
   done
 
-lemma tcbSchedDequeue_all_queued_tcb_ptrs:
-  "\<lbrace>\<lambda>s. x \<in> all_queued_tcb_ptrs s \<and> x \<noteq> t \<rbrace>
-   tcbSchedDequeue t \<lbrace>\<lambda>_ s. x \<in> all_queued_tcb_ptrs s\<rbrace>"
-  apply (rule_tac Q="(\<lambda>s. x \<in> all_queued_tcb_ptrs s) and K (x \<noteq> t)"
-           in hoare_pre_imp, clarsimp)
-  apply (rule hoare_gen_asm)
-  apply (clarsimp simp: tcbSchedDequeue_def all_queued_tcb_ptrs_def)
-  apply (rule hoare_pre)
-   apply (wp, clarsimp)
-       apply (wp hoare_vcg_ex_lift)+
-     apply (rename_tac d p)
-     apply (rule_tac Q="\<lambda>_ s. x \<in> set (ksReadyQueues s (d, p))"
-                     in hoare_post_imp, clarsimp)
-     apply (wp hoare_vcg_all_lift | simp)+
-  done
-
 lemma tcbSchedDequeue_all_active_tcb_ptrs[wp]:
   "\<lbrace>\<lambda>s. P (t' \<in> all_active_tcb_ptrs s)\<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>_ s. P (t' \<in> all_active_tcb_ptrs s)\<rbrace>"
   by (clarsimp simp: all_active_tcb_ptrs_def is_active_tcb_ptr_def) wp
@@ -684,8 +637,14 @@ lemma setCurThread_almost_no_orphans:
 lemmas ArchThreadDecls_H_switchToThread_all_active_tcb_ptrs[wp] =
   st_tcb_at'_all_active_tcb_ptrs_lift [OF Arch_switchToThread_pred_tcb']
 
+lemma arch_switch_thread_tcbQueued[wp]:
+  "Arch.switchToThread t \<lbrace>\<lambda>s. Q (obj_at' (\<lambda>tcb. P (tcbQueued tcb)) tcb_ptr s)\<rbrace>"
+  apply (simp add: ARM_H.switchToThread_def)
+  apply (wp)
+  done
+
 lemmas ArchThreadDecls_H_switchToThread_all_queued_tcb_ptrs_lift[wp] =
-  ksQ_all_queued_tcb_ptrs_lift [OF arch_switch_thread_ksQ]
+  tcbQueued_all_queued_tcb_ptrs_lift [OF arch_switch_thread_tcbQueued]
 
 lemma ThreadDecls_H_switchToThread_no_orphans:
   "\<lbrace> \<lambda>s. no_orphans s \<and>
@@ -695,16 +654,9 @@ lemma ThreadDecls_H_switchToThread_no_orphans:
    ThreadDecls_H.switchToThread tcb_ptr
    \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
   unfolding Thread_H.switchToThread_def
-  apply (wp setCurThread_almost_no_orphans
-            tcbSchedDequeue_almost_no_orphans)
-    apply (wps tcbSchedDequeue_ct')
-    apply (wp tcbSchedDequeue_all_queued_tcb_ptrs hoare_convert_imp)+
-    apply (wps)
-    apply (wp)+
-   apply (wps)
-   apply (wp)
-  apply (clarsimp)
-  done
+  by (wpsimp wp: setCurThread_almost_no_orphans hoare_vcg_imp_lift'
+                 tcbSchedDequeue_all_queued_tcb_ptrs_other
+      | wps)+
 
 lemma findM_failure':
   "\<lbrakk> \<And>x S. \<lbrace> \<lambda>s. P S s \<rbrace> f x \<lbrace> \<lambda>rv s. \<not> rv \<longrightarrow> P (insert x S) s \<rbrace> \<rbrakk> \<Longrightarrow>
@@ -722,22 +674,6 @@ lemma findM_failure':
 
 lemmas findM_failure = findM_failure'[where S="{}", simplified]
 
-lemma tcbSchedEnqueue_inQueue_eq:
-  "\<lbrace> valid_queues' and K (tcb_ptr = tcb_ptr') \<rbrace>
-   tcbSchedEnqueue tcb_ptr
-   \<lbrace> \<lambda>rv s. tcb_ptr' \<in> all_queued_tcb_ptrs s \<rbrace>"
-  apply (rule hoare_gen_asm, simp)
-  apply wp
-  done
-
-lemma tcbSchedAppend_inQueue_eq:
-  "\<lbrace> valid_queues' and K (tcb_ptr = tcb_ptr') \<rbrace>
-   tcbSchedAppend tcb_ptr
-   \<lbrace> \<lambda>rv s. tcb_ptr' \<in> all_queued_tcb_ptrs s \<rbrace>"
-  apply (rule hoare_gen_asm, simp)
-  apply wp
-  done
-
 lemma findM_on_success:
   "\<lbrakk> \<And>x. \<lbrace> P x \<rbrace> f x \<lbrace> \<lambda>rv s. rv \<rbrace>; \<And>x y. \<lbrace> P x \<rbrace> f y \<lbrace> \<lambda>rv. P x \<rbrace> \<rbrakk> \<Longrightarrow>
    \<lbrace> \<lambda>s. \<exists>x \<in> set xs. P x s \<rbrace> findM f xs \<lbrace> \<lambda>rv s. \<exists> y. rv = Some y \<rbrace>"
@@ -750,66 +686,32 @@ lemma findM_on_success:
 crunch st_tcb' [wp]: switchToThread "\<lambda>s. P' (st_tcb_at' P t s)"
   (ignore: ARM.clearExMonitor)
 
-lemma setQueue_deq_not_empty:
-  "\<lbrace> \<lambda>s. (\<exists>tcb. tcb \<in> set (ksReadyQueues s p) \<and> st_tcb_at' P tcb s) \<and>
-         (\<exists>tcb_ptr. \<not> st_tcb_at' P tcb_ptr s \<and>
-                    queue = [x\<leftarrow>((ksReadyQueues s) (d, priority)). x \<noteq> tcb_ptr]) \<rbrace>
-   setQueue d priority queue
-   \<lbrace> \<lambda>rv s. \<exists>tcb. tcb \<in> set (ksReadyQueues s p) \<and> st_tcb_at' P tcb s \<rbrace>"
-  unfolding setQueue_def
-  apply wp
-  apply auto
-  done
-
-lemma tcbSchedDequeue_not_empty:
-  "\<lbrace> \<lambda>s. (\<exists>tcb. tcb \<in> set (ksReadyQueues s p) \<and> st_tcb_at' P tcb s) \<and> \<not> st_tcb_at' P thread s \<rbrace>
-   tcbSchedDequeue thread
-   \<lbrace> \<lambda>rv s. \<exists>tcb. tcb \<in> set (ksReadyQueues s p) \<and> st_tcb_at' P tcb s \<rbrace>"
-  unfolding tcbSchedDequeue_def
-  apply wp
-         apply (wp hoare_vcg_ex_lift threadSet_pred_tcb_no_state)
-         apply clarsimp
-        apply (wp setQueue_deq_not_empty)
-       apply clarsimp
-       apply (rule hoare_pre_post, assumption)
-       apply (clarsimp simp: bitmap_fun_defs)
-       apply wp
-       apply clarsimp
-      apply clarsimp
-      apply (wp setQueue_deq_not_empty)+
-   apply (rule_tac Q="\<lambda>rv s. \<not> st_tcb_at' P thread s" in hoare_post_imp)
-    apply fastforce
-   apply (wp weak_if_wp | clarsimp)+
-  done
-
 lemmas switchToThread_all_active_tcb_ptrs[wp] =
   st_tcb_at'_all_active_tcb_ptrs_lift [OF switchToThread_st_tcb']
 
 (* ksSchedulerAction s = ChooseNewThread *)
 lemma chooseThread_no_orphans [wp]:
-  notes hoare_TrueI[simp]
-  shows
-  "\<lbrace>\<lambda>s. no_orphans s \<and> all_invs_but_ct_idle_or_in_cur_domain' s \<and>
-          (is_active_tcb_ptr (ksCurThread s) s
-             \<longrightarrow> ksCurThread s \<in> all_queued_tcb_ptrs s)\<rbrace>
+  "\<lbrace>\<lambda>s. no_orphans s \<and> all_invs_but_ct_idle_or_in_cur_domain' s
+        \<and> (is_active_tcb_ptr (ksCurThread s) s \<longrightarrow> ksCurThread s \<in> all_queued_tcb_ptrs s)\<rbrace>
    chooseThread
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   (is "\<lbrace>?PRE\<rbrace> _ \<lbrace>_\<rbrace>")
   unfolding chooseThread_def Let_def
   supply if_split[split del]
   apply (simp only: return_bind, simp)
-  apply (rule hoare_seq_ext[where B="\<lambda>rv s. ?PRE s \<and> rv = ksCurDomain s"])
-   apply (rule_tac B="\<lambda>rv s. ?PRE s \<and> curdom = ksCurDomain s \<and>
-    rv = ksReadyQueuesL1Bitmap s curdom" in hoare_seq_ext)
+  apply (intro hoare_seq_ext[OF _ stateAssert_sp])
+  apply (rule hoare_seq_ext[where B="\<lambda>rv s. ?PRE s \<and> ksReadyQueues_asrt s \<and> ready_qs_runnable s
+                                            \<and> rv = ksCurDomain s"])
+   apply (rule_tac B="\<lambda>rv s. ?PRE s \<and> ksReadyQueues_asrt s \<and> ready_qs_runnable s
+                             \<and> curdom = ksCurDomain s \<and> rv = ksReadyQueuesL1Bitmap s curdom"
+                in hoare_seq_ext)
     apply (rename_tac l1)
     apply (case_tac "l1 = 0")
      (* switch to idle thread *)
      apply (simp, wp, simp)
     (* we have a thread to switch to *)
-    apply (clarsimp simp: bitmap_fun_defs)
     apply (wp assert_inv ThreadDecls_H_switchToThread_no_orphans)
-    apply (clarsimp simp: all_invs_but_ct_idle_or_in_cur_domain'_def valid_state'_def
-                          valid_queues_def st_tcb_at'_def)
+    apply (clarsimp simp: all_invs_but_ct_idle_or_in_cur_domain'_def st_tcb_at'_def)
     apply (fastforce dest!: lookupBitmapPriority_obj_at' elim: obj_at'_weaken
                      simp: all_active_tcb_ptrs_def)
    apply (wpsimp simp: bitmap_fun_defs)
@@ -817,33 +719,6 @@ lemma chooseThread_no_orphans [wp]:
     apply (wpsimp simp: curDomain_def simp: invs_no_cicd_ksCurDomain_maxDomain')+
   done
 
-lemma tcbSchedAppend_in_ksQ:
-  "\<lbrace>valid_queues' and tcb_at' t\<rbrace> tcbSchedAppend t
-   \<lbrace>\<lambda>r s. \<exists>domain priority. t \<in> set (ksReadyQueues s (domain, priority))\<rbrace>"
-  apply (rule_tac Q="\<lambda>s. \<exists>d p. valid_queues' s \<and>
-                             obj_at' (\<lambda>tcb. tcbPriority tcb = p) t s \<and>
-                             obj_at' (\<lambda>tcb. tcbDomain tcb = d) t s"
-           in hoare_pre_imp)
-   apply (clarsimp simp: tcb_at'_has_tcbPriority tcb_at'_has_tcbDomain)
-  apply (rule hoare_vcg_ex_lift)+
-  apply (simp add: tcbSchedAppend_def unless_def)
-  apply wpsimp
-     apply (rule_tac Q="\<lambda>rv s. tdom = d \<and> rv = p \<and> obj_at' (\<lambda>tcb. tcbPriority tcb = p) t s
-                            \<and> obj_at' (\<lambda>tcb. tcbDomain tcb = d) t s"
-             in hoare_post_imp, clarsimp)
-     apply (wp, (wp threadGet_const)+)
-   apply (rule_tac Q="\<lambda>rv s.
-             obj_at' (\<lambda>tcb. tcbPriority tcb = p) t s \<and>
-             obj_at' (\<lambda>tcb. tcbDomain tcb = d) t s \<and>
-             obj_at' (\<lambda>tcb. tcbQueued tcb = rv) t s \<and>
-             (rv \<longrightarrow> t \<in> set (ksReadyQueues s (d, p)))" in hoare_post_imp)
-   apply (clarsimp simp: o_def elim!: obj_at'_weakenE)
-   apply (wp threadGet_obj_at' hoare_vcg_imp_lift threadGet_const)
-  apply clarsimp
-  apply normalise_obj_at'
-  apply (drule(1) valid_queues'_ko_atD, simp+)
-  done
-
 lemma hoare_neg_imps:
   "\<lbrace>P\<rbrace> f \<lbrace>\<lambda> rv s. \<not> R rv s\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>r s. R r s \<longrightarrow> Q r s\<rbrace>"
   by (auto simp: valid_def)
@@ -867,7 +742,7 @@ lemma ThreadDecls_H_switchToThread_ct [wp]:
 crunch no_orphans [wp]: nextDomain no_orphans
 (wp: no_orphans_lift simp: Let_def)
 
-crunch ksQ [wp]: nextDomain "\<lambda>s. P (ksReadyQueues s p)"
+crunch tcbQueued[wp]: nextDomain "\<lambda>s. Q (obj_at' (\<lambda>tcb. P (tcbQueued tcb)) tcb_ptr s)"
 (simp: Let_def)
 
 crunch st_tcb_at' [wp]: nextDomain "\<lambda>s. P (st_tcb_at' P' p s)"
@@ -879,14 +754,6 @@ crunch ct' [wp]: nextDomain "\<lambda>s. P (ksCurThread s)"
 crunch sch_act_not [wp]: nextDomain "sch_act_not t"
 (simp: Let_def)
 
-lemma tcbSchedEnqueue_in_ksQ':
-  "\<lbrace>valid_queues' and tcb_at' t and K (t = t')\<rbrace>
-     tcbSchedEnqueue t'
-   \<lbrace>\<lambda>r s. \<exists>domain priority. t \<in> set (ksReadyQueues s (domain, priority))\<rbrace>"
-  apply (rule hoare_gen_asm)
-  apply (wp tcbSchedEnqueue_in_ksQ | clarsimp)+
-  done
-
 lemma all_invs_but_ct_idle_or_in_cur_domain'_strg:
   "invs' s \<longrightarrow> all_invs_but_ct_idle_or_in_cur_domain' s"
   by (clarsimp simp: invs'_to_invs_no_cicd'_def)
@@ -899,69 +766,6 @@ lemma obj_at'_static_fix:
   "\<lbrakk> obj_at' (\<lambda>(ko::'a::pspace_storable). True) p s ; P \<rbrakk> \<Longrightarrow> obj_at' (\<lambda>(ko::'a::pspace_storable). P) p s"
   by (erule obj_at'_weakenE, simp)
 
-lemma tcbSchedEnqueue_in_ksQ_aqtp[wp]:
-  "\<lbrace>valid_queues' and tcb_at' t\<rbrace> tcbSchedEnqueue t
-   \<lbrace>\<lambda>r s. t \<in> all_queued_tcb_ptrs s\<rbrace>"
-  apply (clarsimp simp: all_queued_tcb_ptrs_def)
-  apply (rule tcbSchedEnqueue_in_ksQ)
-  done
-
-crunch ksReadyQueues[wp]: threadGet "\<lambda>s. P (ksReadyQueues s)"
-
-lemma tcbSchedEnqueue_in_ksQ_already_queued:
-  "\<lbrace>\<lambda>s. valid_queues' s \<and> tcb_at' t s \<and>
-    (\<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority))) \<rbrace>
-   tcbSchedEnqueue t
-   \<lbrace>\<lambda>r s. \<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority))\<rbrace>"
-  apply (case_tac "t'=t", wpsimp wp: tcbSchedEnqueue_in_ksQ)
-  apply (wpsimp simp:  tcbSchedEnqueue_def unless_def)
-     apply (rule_tac Q="\<lambda>_ s. \<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority))"
-              in hoare_post_imp)
-      apply metis
-     apply wpsimp+
-  done
-
-lemma tcbSchedAppend_in_ksQ_already_queued:
-  "\<lbrace>\<lambda>s. valid_queues' s \<and> tcb_at' t s \<and>
-    (\<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority))) \<rbrace>
-   tcbSchedAppend t
-   \<lbrace>\<lambda>r s. \<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority))\<rbrace>"
-  apply (case_tac "t'=t", wpsimp wp: tcbSchedAppend_in_ksQ)
-  apply (wpsimp simp:  tcbSchedAppend_def unless_def)
-     apply (rule_tac Q="\<lambda>_ s. \<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority))"
-              in hoare_post_imp)
-      apply metis
-     apply wpsimp+
-  done
-
-lemma tcbSchedEnqueue_in_ksQ'':
-  "\<lbrace>\<lambda>s. valid_queues' s \<and> tcb_at' t s \<and>
-    (t' \<noteq> t \<longrightarrow> (\<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority)))) \<rbrace>
-   tcbSchedEnqueue t
-   \<lbrace>\<lambda>r s. \<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority))\<rbrace>"
-  apply (case_tac "t'=t", wpsimp wp: tcbSchedEnqueue_in_ksQ)
-  apply clarsimp
-  apply (wpsimp simp:  tcbSchedEnqueue_def unless_def)
-     apply (rule_tac Q="\<lambda>_ s. \<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority))"
-              in hoare_post_imp)
-      apply metis
-     apply wpsimp+
-  done
-
-lemma tcbSchedAppend_in_ksQ'':
-  "\<lbrace>\<lambda>s. valid_queues' s \<and> tcb_at' t s \<and>
-    (t' \<noteq> t \<longrightarrow> (\<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority)))) \<rbrace>
-   tcbSchedAppend t
-   \<lbrace>\<lambda>r s. \<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority))\<rbrace>"
-  apply (case_tac "t'=t", wpsimp wp: tcbSchedAppend_in_ksQ)
-  apply clarsimp
-  apply (wpsimp simp:  tcbSchedAppend_def unless_def)
-     apply (rule_tac Q="\<lambda>_ s. \<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority))"
-              in hoare_post_imp)
-      apply metis
-     apply wpsimp+
-  done
-
 crunches setSchedulerAction
   for pred_tcb_at': "\<lambda>s. P (pred_tcb_at' proj Q t s)"
   and ct': "\<lambda>s. P (ksCurThread s)"
@@ -980,12 +784,6 @@ lemma ct_active_st_tcb_at':
   apply (case_tac st, auto)
   done
 
-lemma tcbSchedEnqueue_in_ksQ_already_queued_aqtp:
-  "\<lbrace>\<lambda>s. valid_queues' s \<and> tcb_at' t s \<and>
-    t' \<in> all_queued_tcb_ptrs s \<rbrace> tcbSchedEnqueue t
-   \<lbrace>\<lambda>r s. t' \<in> all_queued_tcb_ptrs s \<rbrace>"
-  by (clarsimp simp: all_queued_tcb_ptrs_def tcbSchedEnqueue_in_ksQ_already_queued)
-
 (* FIXME move *)
 lemma invs_switchToThread_runnable':
   "\<lbrakk> invs' s ; ksSchedulerAction s = SwitchToThread t \<rbrakk> \<Longrightarrow> st_tcb_at' runnable' t s"
@@ -1006,17 +804,16 @@ lemma in_all_active_tcb_ptrsD:
   done
 
 lemma scheduleChooseNewThread_no_orphans:
-  "\<lbrace> invs' and no_orphans
-     and (\<lambda>s. ksSchedulerAction s = ChooseNewThread
-              \<and> (st_tcb_at' runnable' (ksCurThread s) s
-                 \<longrightarrow> (\<exists>d p. ksCurThread s \<in> set (ksReadyQueues s (d, p))))) \<rbrace>
+  "\<lbrace>invs' and no_orphans
+    and (\<lambda>s. ksSchedulerAction s = ChooseNewThread
+             \<and> (st_tcb_at' runnable' (ksCurThread s) s \<longrightarrow> ksCurThread s \<in> all_queued_tcb_ptrs s))\<rbrace>
    scheduleChooseNewThread
-   \<lbrace>\<lambda>_. no_orphans \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding scheduleChooseNewThread_def
      apply (wp add: ssa_no_orphans hoare_vcg_all_lift)
          apply (wp hoare_disjI1 chooseThread_nosch)+
     apply (wp nextDomain_invs_no_cicd' hoare_vcg_imp_lift
-               hoare_lift_Pf2 [OF ksQ_all_queued_tcb_ptrs_lift[OF nextDomain_ksQ]
+               hoare_lift_Pf2 [OF tcbQueued_all_queued_tcb_ptrs_lift[OF nextDomain_tcbQueued]
                                   nextDomain_ct']
                hoare_lift_Pf2 [OF st_tcb_at'_is_active_tcb_ptr_lift[OF nextDomain_st_tcb_at']
                                   nextDomain_ct']
@@ -1025,24 +822,25 @@ lemma scheduleChooseNewThread_no_orphans:
                        is_active_tcb_ptr_runnable')+
   done
 
+lemma setSchedulerAction_tcbQueued[wp]:
+  "setSchedulerAction sa \<lbrace>\<lambda>s. Q (obj_at' (\<lambda>tcb. P (tcbQueued tcb)) tcb_ptr s)\<rbrace>"
+  by wpsimp
+
 lemma schedule_no_orphans[wp]:
   notes ssa_wp[wp del]
   shows
-  "\<lbrace> \<lambda>s. no_orphans s \<and> invs' s \<rbrace>
-   schedule
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+  "\<lbrace>no_orphans and invs'\<rbrace> schedule \<lbrace>\<lambda>_. no_orphans\<rbrace>"
 proof -
 
   have do_switch_to:
     "\<And>candidate.
      \<lbrace>\<lambda>s. no_orphans s \<and> ksSchedulerAction s = SwitchToThread candidate
           \<and> st_tcb_at' runnable' candidate s
-          \<and> (st_tcb_at' runnable' (ksCurThread s) s
-             \<longrightarrow> (\<exists>d p. ksCurThread s \<in> set (ksReadyQueues s (d, p)))) \<rbrace>
-      do ThreadDecls_H.switchToThread candidate;
-         setSchedulerAction ResumeCurrentThread
-      od
-    \<lbrace>\<lambda>rv. no_orphans\<rbrace>"
+          \<and> (st_tcb_at' runnable' (ksCurThread s) s \<longrightarrow> ksCurThread s \<in> all_queued_tcb_ptrs s) \<rbrace>
+     do ThreadDecls_H.switchToThread candidate;
+        setSchedulerAction ResumeCurrentThread
+     od
+     \<lbrace>\<lambda>_. no_orphans\<rbrace>"
     apply (wpsimp wp: scheduleChooseNewThread_no_orphans ssa_no_orphans
                       hoare_vcg_all_lift ThreadDecls_H_switchToThread_no_orphans)+
      apply (rule_tac Q="\<lambda>_ s. (t = candidate \<longrightarrow> ksCurThread s = candidate) \<and>
@@ -1054,56 +852,43 @@ proof -
 
   have abort_switch_to_enq:
     "\<And>candidate.
-     \<lbrace>\<lambda>s. no_orphans s \<and> invs' s \<and> valid_queues' s
+     \<lbrace>\<lambda>s. no_orphans s \<and> invs' s
           \<and> ksSchedulerAction s = SwitchToThread candidate
-          \<and> (st_tcb_at' runnable' (ksCurThread s) s
-               \<longrightarrow> (\<exists>d p. ksCurThread s \<in> set (ksReadyQueues s (d, p)))) \<rbrace>
-       do tcbSchedEnqueue candidate;
-          setSchedulerAction ChooseNewThread;
-          scheduleChooseNewThread
-       od
-     \<lbrace>\<lambda>rv. no_orphans\<rbrace>"
-     apply (rule hoare_pre)
-     apply (wp scheduleChooseNewThread_no_orphans ssa_no_orphans setSchedulerAction_direct)
+          \<and> (st_tcb_at' runnable' (ksCurThread s) s \<longrightarrow> ksCurThread s \<in> all_queued_tcb_ptrs s) \<rbrace>
+     do tcbSchedEnqueue candidate;
+        setSchedulerAction ChooseNewThread;
+        scheduleChooseNewThread
+     od
+     \<lbrace>\<lambda>_. no_orphans\<rbrace>"
+    apply (wpsimp wp: scheduleChooseNewThread_no_orphans ssa_no_orphans setSchedulerAction_direct)
       apply (wpsimp wp: hoare_vcg_imp_lift' hoare_vcg_ex_lift
-                    simp: is_active_tcb_ptr_runnable' all_queued_tcb_ptrs_def
-             | rule hoare_lift_Pf2[where f=ksCurThread, OF setSchedulerAction_ksQ])+
-     apply (wp tcbSchedEnqueue_in_ksQ' tcbSchedEnqueue_no_orphans hoare_vcg_all_lift hoare_vcg_imp_lift' hoare_vcg_disj_lift)
-      apply (wp hoare_lift_Pf2[where f=ksCurThread, OF tcbSchedEnqueue_pred_tcb_at']
-                hoare_lift_Pf2[where f=ksCurThread, OF tcbSchedEnqueue_in_ksQ_already_queued]
-                tcbSchedEnqueue_no_orphans
-             | strengthen not_pred_tcb_at'_strengthen
-             | wp (once) hoare_vcg_imp_lift')+
-    apply (clarsimp)
-    apply (frule invs_sch_act_wf', clarsimp simp: pred_tcb_at')
-    apply (simp add: st_tcb_at_neg' tcb_at_invs')
+                  simp: is_active_tcb_ptr_runnable' all_queued_tcb_ptrs_def
+             | rule hoare_lift_Pf2[where f=ksCurThread, OF setSchedulerAction_tcbQueued])+
+     apply (wp hoare_vcg_all_lift hoare_vcg_imp_lift' hoare_vcg_disj_lift
+            | strengthen not_pred_tcb_at'_strengthen
+            | rule hoare_lift_Pf2[where f=ksCurThread])+
+    apply (simp add: st_tcb_at_neg' tcb_at_invs' all_queued_tcb_ptrs_def)
     done
 
   have abort_switch_to_app:
     "\<And>candidate.
-     \<lbrace>\<lambda>s. no_orphans s \<and> invs' s \<and> valid_queues' s
+     \<lbrace>\<lambda>s. no_orphans s \<and> invs' s
           \<and> ksSchedulerAction s = SwitchToThread candidate
           \<and> (st_tcb_at' runnable' (ksCurThread s) s
-             \<longrightarrow> (\<exists>d p. ksCurThread s \<in> set (ksReadyQueues s (d, p))) ) \<rbrace>
-       do tcbSchedAppend candidate;
-          setSchedulerAction ChooseNewThread;
-          scheduleChooseNewThread
-       od
-     \<lbrace>\<lambda>rv. no_orphans\<rbrace>"
-     apply (rule hoare_pre)
-     apply (wp scheduleChooseNewThread_no_orphans ssa_no_orphans setSchedulerAction_direct)
+             \<longrightarrow> ksCurThread s \<in> all_queued_tcb_ptrs s ) \<rbrace>
+     do tcbSchedAppend candidate;
+        setSchedulerAction ChooseNewThread;
+        scheduleChooseNewThread
+     od
+     \<lbrace>\<lambda>_. no_orphans\<rbrace>"
+    apply (wpsimp wp: scheduleChooseNewThread_no_orphans ssa_no_orphans setSchedulerAction_direct)
       apply (wpsimp wp: hoare_vcg_imp_lift' hoare_vcg_ex_lift
-                    simp: is_active_tcb_ptr_runnable' all_queued_tcb_ptrs_def
-             | rule hoare_lift_Pf2[where f=ksCurThread, OF setSchedulerAction_ksQ])+
-     apply (wp tcbSchedAppend_in_ksQ'' tcbSchedAppend_no_orphans hoare_vcg_all_lift hoare_vcg_imp_lift' hoare_vcg_disj_lift)
-      apply (wp hoare_lift_Pf2[where f=ksCurThread, OF tcbSchedAppend_pred_tcb_at']
-                hoare_lift_Pf2[where f=ksCurThread, OF tcbSchedAppend_in_ksQ_already_queued]
-                tcbSchedAppend_no_orphans
-             | strengthen not_pred_tcb_at'_strengthen
-             | wp (once) hoare_vcg_imp_lift')+
-    apply (clarsimp)
-    apply (frule invs_sch_act_wf', clarsimp simp: pred_tcb_at')
-    apply (simp add: st_tcb_at_neg' tcb_at_invs')
+                  simp: is_active_tcb_ptr_runnable' all_queued_tcb_ptrs_def
+             | rule hoare_lift_Pf2[where f=ksCurThread, OF setSchedulerAction_tcbQueued])+
+     apply (wp hoare_vcg_all_lift hoare_vcg_imp_lift' hoare_vcg_disj_lift
+            | strengthen not_pred_tcb_at'_strengthen
+            | rule hoare_lift_Pf2[where f=ksCurThread])+
+    apply (simp add: st_tcb_at_neg' tcb_at_invs' all_queued_tcb_ptrs_def)
     done
 
   show ?thesis
@@ -1111,47 +896,39 @@ proof -
   supply if_weak_cong[cong]
   apply (wp, wpc)
        \<comment> \<open>action = ResumeCurrentThread\<close>
-      apply (wp)[1]
-     \<comment> \<open>action = ChooseNewThread\<close>
-     apply (clarsimp simp: when_def scheduleChooseNewThread_def)
-     apply (wp ssa_no_orphans hoare_vcg_all_lift)
-         apply (wp hoare_disjI1 chooseThread_nosch)
+       apply (wp)[1]
+      \<comment> \<open>action = ChooseNewThread\<close>
+      apply (clarsimp simp: when_def scheduleChooseNewThread_def)
+      apply (wp ssa_no_orphans hoare_vcg_all_lift)
+          apply (wp hoare_disjI1 chooseThread_nosch)
          apply (wp nextDomain_invs_no_cicd' hoare_vcg_imp_lift
-                   hoare_lift_Pf2 [OF ksQ_all_queued_tcb_ptrs_lift
-                                      [OF nextDomain_ksQ]
+                   hoare_lift_Pf2 [OF tcbQueued_all_queued_tcb_ptrs_lift
+                                      [OF nextDomain_tcbQueued]
                                       nextDomain_ct']
                    hoare_lift_Pf2 [OF st_tcb_at'_is_active_tcb_ptr_lift
                                     [OF nextDomain_st_tcb_at']
                                     nextDomain_ct']
                    hoare_vcg_all_lift getDomainTime_wp)[2]
-       apply ((wp tcbSchedEnqueue_no_orphans tcbSchedEnqueue_in_ksQ'
-                  hoare_drop_imp
-             | clarsimp simp: all_queued_tcb_ptrs_def
-             | strengthen all_invs_but_ct_idle_or_in_cur_domain'_strg
-             | wps tcbSchedEnqueue_ct')+)[1]
-       apply ((wp tcbSchedEnqueue_no_orphans tcbSchedEnqueue_in_ksQ'
+        apply wpsimp
+       apply ((wp tcbSchedEnqueue_no_orphans tcbSchedEnqueue_all_queued_tcb_ptrs'
                   hoare_drop_imp
-             | clarsimp simp: all_queued_tcb_ptrs_def
-             | strengthen all_invs_but_ct_idle_or_in_cur_domain'_strg
-             | wps tcbSchedEnqueue_ct')+)[1]
-     apply wp[1]
+               | clarsimp simp: all_queued_tcb_ptrs_def
+               | strengthen all_invs_but_ct_idle_or_in_cur_domain'_strg
+               | rule hoare_lift_Pf2[where f=ksCurThread])+)[1]
+      apply wpsimp
     \<comment> \<open>action = SwitchToThread candidate\<close>
-     apply (clarsimp)
+    apply clarsimp
     apply (rename_tac candidate)
    apply (wpsimp wp: do_switch_to abort_switch_to_enq abort_switch_to_app)
           (* isHighestPrio *)
           apply (wp hoare_drop_imps)
          apply (wp add: tcbSchedEnqueue_no_orphans)+
     apply (clarsimp simp: conj_comms cong: conj_cong imp_cong split del: if_split)
-    apply (wp hoare_lift_Pf2[where f=ksCurThread, OF tcbSchedEnqueue_pred_tcb_at']
-              hoare_lift_Pf2[where f=ksCurThread, OF tcbSchedEnqueue_in_ksQ']
-              hoare_vcg_imp_lift'
+    apply (wp hoare_vcg_imp_lift'
            | strengthen not_pred_tcb_at'_strengthen)+
-
-  apply (clarsimp simp: comp_def)
-  apply (frule invs_queues)
-  apply (clarsimp simp: invs_valid_queues' tcb_at_invs' st_tcb_at_neg' is_active_tcb_ptr_runnable')
-  apply (fastforce simp: all_invs_but_ct_idle_or_in_cur_domain'_strg invs_switchToThread_runnable')
+      apply (wps | wpsimp wp: tcbSchedEnqueue_all_queued_tcb_ptrs')+
+  apply (fastforce simp: is_active_tcb_ptr_runnable' all_invs_but_ct_idle_or_in_cur_domain'_strg
+                         invs_switchToThread_runnable')
   done
 qed
 
@@ -1172,37 +949,33 @@ crunches completeSignal
   (simp: crunch_simps wp: crunch_wps)
 
 lemma possibleSwitchTo_almost_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. almost_no_orphans target s \<and> valid_queues' s \<and> st_tcb_at' runnable' target s
-         \<and> weak_sch_act_wf (ksSchedulerAction s) s \<rbrace>
+  "\<lbrace>\<lambda>s. almost_no_orphans target s \<and> st_tcb_at' runnable' target s
+        \<and> weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
    possibleSwitchTo target
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding possibleSwitchTo_def
-  by (wp rescheduleRequired_valid_queues'_weak tcbSchedEnqueue_almost_no_orphans
+  by (wp tcbSchedEnqueue_almost_no_orphans
          ssa_almost_no_orphans hoare_weak_lift_imp
      | wpc | clarsimp
      | wp (once) hoare_drop_imp)+
 
 lemma possibleSwitchTo_almost_no_orphans':
-  "\<lbrace> \<lambda>s. almost_no_orphans target s \<and> valid_queues' s \<and> st_tcb_at' runnable' target s
-         \<and> sch_act_wf (ksSchedulerAction s) s \<rbrace>
+  "\<lbrace>\<lambda>s. almost_no_orphans target s \<and> st_tcb_at' runnable' target s
+        \<and> sch_act_wf (ksSchedulerAction s) s \<rbrace>
    possibleSwitchTo target
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   by wp (strengthen sch_act_wf_weak, assumption)
 
+crunches tcbQueueAppend, tcbQueuePrepend
+  for almost_no_orphans[wp]: "almost_no_orphans tcbPtr"
+
 lemma tcbSchedAppend_almost_no_orphans:
-  "\<lbrace> \<lambda>s. almost_no_orphans thread s \<and> valid_queues' s \<rbrace>
+  "\<lbrace>almost_no_orphans thread\<rbrace>
    tcbSchedAppend thread
-   \<lbrace> \<lambda>_ s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding tcbSchedAppend_def
-  apply (wp setQueue_almost_no_orphans_enq[where tcb_ptr=thread] threadSet_no_orphans
-            | clarsimp simp: unless_def | simp only: subset_insertI)+
-  apply (unfold threadGet_def)
-  apply (wp getObject_tcb_wp | clarsimp)+
-  apply (drule obj_at_ko_at', clarsimp)
-  apply (rule_tac x=ko in exI)
-  apply (clarsimp simp: almost_no_orphans_def no_orphans_def)
-  apply (drule queued_in_queue | simp)+
-  apply (auto simp: all_queued_tcb_ptrs_def)
+  apply (wpsimp wp: tcbQueued_update_True_no_orphans threadGet_wp)
+  apply (fastforce simp: almost_no_orphans_def no_orphans_def all_queued_tcb_ptrs_def obj_at'_def)
   done
 
 lemma no_orphans_is_almost[simp]:
@@ -1211,7 +984,6 @@ lemma no_orphans_is_almost[simp]:
 
 crunches decDomainTime
   for no_orphans [wp]: no_orphans
-  and valid_queues' [wp]: valid_queues'
   (wp: no_orphans_lift)
 
 lemma timerTick_no_orphans [wp]:
@@ -1221,28 +993,19 @@ lemma timerTick_no_orphans [wp]:
   unfolding timerTick_def getDomainTime_def
   supply if_split[split del]
   apply (subst threadState_case_if)
-  apply (wpsimp wp: threadSet_no_orphans threadSet_valid_queues'
-                    threadSet_valid_queues' tcbSchedAppend_almost_no_orphans
+  apply (wpsimp wp: threadSet_no_orphans tcbSchedAppend_almost_no_orphans
                     threadSet_almost_no_orphans threadSet_no_orphans tcbSchedAppend_sch_act_wf
                     hoare_drop_imp
                 simp: if_apply_def2
          | strengthen sch_act_wf_weak)+
-      apply (rule_tac Q="\<lambda>rv s. no_orphans s \<and> valid_queues' s \<and> tcb_at' thread s
-                                \<and> sch_act_wf  (ksSchedulerAction s) s" in hoare_post_imp)
-       apply (clarsimp simp: inQ_def)
-      apply (wp hoare_drop_imps | clarsimp)+
-  apply (auto split: if_split)
-  done
 
+  done
 
 lemma handleDoubleFault_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<rbrace>
-   handleDoubleFault tptr ex1 ex2
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+  "\<lbrace>no_orphans\<rbrace> handleDoubleFault tptr ex1 ex2 \<lbrace>\<lambda>_. no_orphans \<rbrace>"
   unfolding handleDoubleFault_def
-  apply (wp setThreadState_not_active_no_orphans
-         | clarsimp simp: is_active_thread_state_def isRestart_def isRunning_def)+
-  done
+  by (wpsimp wp: setThreadState_not_active_no_orphans
+           simp: is_active_thread_state_def isRestart_def isRunning_def)+
 
 crunches cteInsert, getThreadCallerSlot, getThreadReplySlot
   for st_tcb' [wp]: "st_tcb_at' (\<lambda>st. P st) t"
@@ -1251,9 +1014,7 @@ crunches cteInsert, getThreadCallerSlot, getThreadReplySlot
   (wp: crunch_wps)
 
 lemma setupCallerCap_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<rbrace>
-   setupCallerCap sender receiver gr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+  "setupCallerCap sender receiver gr \<lbrace>no_orphans\<rbrace>"
   unfolding setupCallerCap_def
   apply (wp setThreadState_not_active_no_orphans hoare_drop_imps
          | clarsimp simp: is_active_thread_state_def isRestart_def isRunning_def)+
@@ -1268,78 +1029,51 @@ lemma setupCallerCap_almost_no_orphans [wp]:
          | clarsimp simp: is_active_thread_state_def isRestart_def isRunning_def)+
   done
 
+crunches cteInsert, setExtraBadge, setMessageInfo, transferCaps, copyMRs,
+         doNormalTransfer, doFaultTransfer, copyGlobalMappings,
+         invalidateHWASIDEntry, invalidateASID, invalidateASIDEntry
+  for tcbQueued[wp]: "obj_at' (\<lambda>tcb. P (tcbQueued tcb)) tcb_ptr"
+  (wp: crunch_wps simp: crunch_simps)
+
 crunches 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 setObject_queues_unchanged_tcb
-       updateObject_default_inv)
+  (wp: no_orphans_lift updateObject_default_inv)
 
 lemma sendIPC_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s \<rbrace>
+  "\<lbrace>\<lambda>s. no_orphans s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s\<rbrace>
    sendIPC blocking call badge canGrant canGrantReply thread epptr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding sendIPC_def
   apply (wp hoare_drop_imps setThreadState_not_active_no_orphans sts_st_tcb'
             possibleSwitchTo_almost_no_orphans'
          | wpc
          | clarsimp simp: is_active_thread_state_def isRestart_def isRunning_def)+
-
-  apply (rule_tac Q="\<lambda>rv. no_orphans and valid_queues' and valid_objs' and ko_at' rv epptr
+  apply (rule_tac Q="\<lambda>rv. no_orphans and valid_objs' and ko_at' rv epptr
                           and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)" in hoare_post_imp)
    apply (fastforce simp: valid_objs'_def valid_obj'_def valid_ep'_def obj_at'_def projectKOs)
   apply (wp get_ep_sp' | clarsimp)+
   done
 
 lemma sendFaultIPC_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s \<rbrace>
+  "\<lbrace>\<lambda>s. no_orphans s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s\<rbrace>
    sendFaultIPC tptr fault
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding sendFaultIPC_def
   apply (rule hoare_pre)
-   apply (wp threadSet_valid_queues' threadSet_no_orphans threadSet_valid_objs'
+   apply (wp threadSet_no_orphans threadSet_valid_objs'
              threadSet_sch_act | wpc | clarsimp)+
-    apply (rule_tac Q'="\<lambda>handlerCap s. no_orphans s \<and> valid_queues' s
-                                         \<and> valid_objs' s
-                                         \<and> sch_act_wf (ksSchedulerAction s) s"
-             in hoare_post_imp_R)
-     apply (wp | clarsimp simp: inQ_def valid_tcb'_def tcb_cte_cases_def)+
-  done
-
-lemma sendIPC_valid_queues' [wp]:
-  "\<lbrace> \<lambda>s. valid_queues' s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s \<rbrace>
-   sendIPC blocking call badge canGrant canGrantReply thread epptr
-   \<lbrace> \<lambda>rv s. valid_queues' s \<rbrace>"
-  unfolding sendIPC_def
-  apply (wpsimp wp: hoare_drop_imps)
-        apply (wpsimp | wp (once) sts_st_tcb' hoare_drop_imps)+
-  apply (rule_tac Q="\<lambda>rv. valid_queues' and valid_objs' and ko_at' rv epptr
-                          and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)" in hoare_post_imp)
-   apply (clarsimp)
-  apply (wp get_ep_sp' | clarsimp)+
-  done
-
-lemma sendFaultIPC_valid_queues' [wp]:
-  "\<lbrace> \<lambda>s. valid_queues' s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s \<rbrace>
-   sendFaultIPC tptr fault
-   \<lbrace> \<lambda>rv s. valid_queues' s \<rbrace>"
-  unfolding sendFaultIPC_def
-  apply (rule hoare_pre)
-   apply (wp threadSet_valid_queues' threadSet_valid_objs' threadSet_sch_act
-          | wpc | clarsimp)+
-    apply (rule_tac Q'="\<lambda>handlerCap s. valid_queues' s \<and> valid_objs' s
-                                         \<and> sch_act_wf (ksSchedulerAction s) s"
-             in hoare_post_imp_R)
+    apply (rule_tac Q'="\<lambda>_ s. no_orphans s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s"
+                 in hoare_post_imp_R)
      apply (wp | clarsimp simp: inQ_def valid_tcb'_def tcb_cte_cases_def)+
   done
 
-lemma handleFault_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s \<rbrace>
+lemma handleFault_no_orphans[wp]:
+  "\<lbrace>\<lambda>s. no_orphans s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s\<rbrace>
    handleFault tptr ex1
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding handleFault_def
-  apply (rule hoare_pre)
-   apply (wp | clarsimp)+
-  done
+  by wpsimp
 
 lemma replyFromKernel_no_orphans [wp]:
   "\<lbrace> \<lambda>s. no_orphans s \<rbrace>
@@ -1357,32 +1091,24 @@ crunch ksReadyQueues  [wp]: createNewCaps "\<lambda> s. P (ksReadyQueues s)"
 
 crunch inv [wp]: alignError "P"
 
-lemma createObjects_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> pspace_aligned' s \<and> pspace_no_overlap' ptr sz s \<and> pspace_distinct' s
-      \<and> n \<noteq> 0 \<and> range_cover ptr sz (objBitsKO val + gbits) n
-      \<and> \<not> case_option False (is_active_thread_state \<circ> tcbState) (projectKO_opt val) \<rbrace>
+lemma createObjects_no_orphans[wp]:
+  "\<lbrace>\<lambda>s. no_orphans s \<and> pspace_aligned' s \<and> pspace_no_overlap' ptr sz s \<and> pspace_distinct' s
+        \<and> n \<noteq> 0 \<and> range_cover ptr sz (objBitsKO val + gbits) n
+        \<and> \<not> case_option False (is_active_thread_state \<circ> tcbState) (projectKO_opt val)
+        \<and> \<not> case_option False tcbQueued (projectKO_opt val)\<rbrace>
    createObjects ptr n val gbits
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_ s. no_orphans s\<rbrace>"
   apply (clarsimp simp: no_orphans_def all_active_tcb_ptrs_def
                         is_active_tcb_ptr_def all_queued_tcb_ptrs_def)
   apply (simp only: imp_conv_disj pred_tcb_at'_def createObjects_def)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift createObjects_orig_obj_at2')
+  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift createObjects_orig_obj_at2'[where sz=sz])
   apply clarsimp
-  apply (erule(1) impE)
-  apply clarsimp
-  apply (drule_tac x = x in spec)
-  apply (erule impE)
-   apply (clarsimp simp:obj_at'_def projectKOs split: option.splits)
-  apply simp
   done
 
-lemma copyGlobalMappings_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<rbrace>
-   copyGlobalMappings newPD
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+lemma copyGlobalMappings_no_orphans[wp]:
+  "copyGlobalMappings newPD \<lbrace>no_orphans\<rbrace>"
   unfolding no_orphans_disj all_queued_tcb_ptrs_def
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-  done
+  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift)
 
 crunch no_orphans [wp]: insertNewCap "no_orphans"
 (wp: hoare_drop_imps)
@@ -1527,45 +1253,47 @@ lemma mapM_x_match:
   "\<lbrace>I and V xs\<rbrace> mapM_x m xs \<lbrace>\<lambda>rv. Q\<rbrace> \<Longrightarrow> \<lbrace>I and V xs\<rbrace> mapM_x m xs \<lbrace>\<lambda>rv. Q\<rbrace>"
   by assumption
 
-lemma cancelAllIPC_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<rbrace>
+lemma cancelAllIPC_no_orphans[wp]:
+  "\<lbrace>\<lambda>s. no_orphans s \<and> valid_objs' s \<and> pspace_aligned' s \<and> pspace_distinct' s\<rbrace>
     cancelAllIPC epptr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding cancelAllIPC_def
   apply (wp sts_valid_objs' set_ep_valid_objs' sts_st_tcb'
             hoare_vcg_const_Ball_lift tcbSchedEnqueue_almost_no_orphans
              | wpc
              | rule mapM_x_match,
                rename_tac list,
-               rule_tac V="\<lambda>_. valid_queues' and valid_objs'"
+               rule_tac V="\<lambda>_. valid_objs' and pspace_aligned' and pspace_distinct'"
                     and I="no_orphans and (\<lambda>s. \<forall>t\<in>set list. tcb_at' t s)"
                      in mapM_x_inv_wp2
              | clarsimp simp: valid_tcb_state'_def)+
-  apply (rule_tac Q="\<lambda>rv. no_orphans and valid_objs' and valid_queues' and ko_at' rv epptr"
-                 in hoare_post_imp)
+  apply (rule_tac Q="\<lambda>rv. no_orphans and valid_objs' and pspace_aligned' and pspace_distinct'
+                          and ko_at' rv epptr"
+               in hoare_post_imp)
    apply (fastforce simp: valid_obj'_def valid_ep'_def obj_at'_def projectKOs)
   apply (wp get_ep_sp' | clarsimp)+
   done
 
-lemma cancelAllSignals_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<rbrace>
+lemma cancelAllSignals_no_orphans[wp]:
+  "\<lbrace>\<lambda>s. no_orphans s \<and> valid_objs' s \<and> pspace_aligned' s \<and> pspace_distinct' s\<rbrace>
     cancelAllSignals ntfn
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding cancelAllSignals_def
   apply (wp sts_valid_objs' set_ntfn_valid_objs' sts_st_tcb'
             hoare_vcg_const_Ball_lift tcbSchedEnqueue_almost_no_orphans
              | wpc
              | clarsimp simp: valid_tcb_state'_def)+
     apply (rename_tac list)
-    apply (rule_tac V="\<lambda>_. valid_queues' and valid_objs'"
+    apply (rule_tac V="\<lambda>_. valid_objs' and pspace_aligned' and pspace_distinct'"
                 and I="no_orphans and (\<lambda>s. \<forall>t\<in>set list. tcb_at' t s)"
                 in mapM_x_inv_wp2)
     apply simp
    apply (wp sts_valid_objs' set_ntfn_valid_objs' sts_st_tcb'
             hoare_vcg_const_Ball_lift tcbSchedEnqueue_almost_no_orphans|
           clarsimp simp: valid_tcb_state'_def)+
-  apply (rule_tac Q="\<lambda>rv. no_orphans and valid_objs' and valid_queues' and ko_at' rv ntfn"
-                 in hoare_post_imp)
+  apply (rule_tac Q="\<lambda>rv. no_orphans and valid_objs' and pspace_aligned' and pspace_distinct'
+                          and ko_at' rv ntfn"
+               in hoare_post_imp)
    apply (fastforce simp: valid_obj'_def valid_ntfn'_def obj_at'_def projectKOs)
   apply (wp get_ntfn_sp' | clarsimp)+
   done
@@ -1590,78 +1318,63 @@ lemma unbindMaybeNotification_no_orphans[wp]:
   unfolding unbindMaybeNotification_def
   by (wp getNotification_wp | simp | wpc)+
 
-lemma finaliseCapTrue_standin_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<rbrace>
-    finaliseCapTrue_standin cap final
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+lemma finaliseCapTrue_standin_no_orphans[wp]:
+  "\<lbrace>no_orphans and valid_objs' and pspace_aligned' and pspace_distinct'\<rbrace>
+   finaliseCapTrue_standin cap final
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding finaliseCapTrue_standin_def
-  apply (rule hoare_pre)
-   apply (wp | clarsimp simp: Let_def | wpc)+
-  done
+  by (wpsimp | clarsimp simp: Let_def | wpc)+
 
-lemma cteDeleteOne_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<rbrace>
+lemma cteDeleteOne_no_orphans[wp]:
+  "\<lbrace>no_orphans and valid_objs' and pspace_aligned' and pspace_distinct'\<rbrace>
    cteDeleteOne slot
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding cteDeleteOne_def
-  apply (wp assert_inv isFinalCapability_inv weak_if_wp | clarsimp simp: unless_def)+
-  done
+  by (wp assert_inv isFinalCapability_inv weak_if_wp | clarsimp simp: unless_def)+
 
 crunch valid_objs' [wp]: getThreadReplySlot "valid_objs'"
 
-lemma cancelSignal_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<rbrace>
-   cancelSignal t ntfn
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+lemma cancelSignal_no_orphans[wp]:
+  "cancelSignal t ntfn \<lbrace>no_orphans\<rbrace>"
   unfolding cancelSignal_def Let_def
-  apply (rule hoare_pre)
-   apply (wp hoare_drop_imps setThreadState_not_active_no_orphans | wpc
-          | clarsimp simp: is_active_thread_state_def isRestart_def isRunning_def)+
-  done
+  by (wpsimp wp: hoare_drop_imps setThreadState_not_active_no_orphans
+           simp: is_active_thread_state_def isRestart_def isRunning_def)
 
 lemma cancelIPC_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<rbrace>
+  "\<lbrace>no_orphans and valid_objs' and pspace_aligned' and pspace_distinct'\<rbrace>
    cancelIPC t
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding cancelIPC_def Let_def
   apply (rule hoare_pre)
    apply (wp setThreadState_not_active_no_orphans hoare_drop_imps weak_if_wp
-             threadSet_valid_queues' threadSet_valid_objs' threadSet_no_orphans | wpc
+             threadSet_valid_objs' threadSet_no_orphans | wpc
           | clarsimp simp: is_active_thread_state_def isRestart_def isRunning_def
                            inQ_def valid_tcb'_def tcb_cte_cases_def)+
   done
 
-
 lemma asUser_almost_no_orphans:
   "\<lbrace>almost_no_orphans t\<rbrace> asUser a f \<lbrace>\<lambda>_. almost_no_orphans t\<rbrace>"
   unfolding almost_no_orphans_disj all_queued_tcb_ptrs_def
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-  done
-
-crunch almost_no_orphans[wp]: asUser "almost_no_orphans t"
-  (simp: almost_no_orphans_disj all_queued_tcb_ptrs_def wp: hoare_vcg_all_lift hoare_vcg_disj_lift crunch_wps)
+  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift)
 
-lemma sendSignal_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s\<rbrace>
+lemma sendSignal_no_orphans[wp]:
+  "\<lbrace>\<lambda>s. no_orphans s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s
+        \<and> pspace_aligned' s \<and> pspace_distinct' s\<rbrace>
    sendSignal ntfnptr badge
-   \<lbrace> \<lambda>_ s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding sendSignal_def
-  apply (rule hoare_pre)
-   apply (wp sts_st_tcb' gts_wp' getNotification_wp asUser_almost_no_orphans
-                          cancelIPC_weak_sch_act_wf
-          | wpc | clarsimp simp: sch_act_wf_weak)+
+  apply (wp sts_st_tcb' gts_wp' getNotification_wp asUser_almost_no_orphans
+            cancelIPC_weak_sch_act_wf
+         | wpc | clarsimp simp: sch_act_wf_weak)+
   done
 
-lemma handleInterrupt_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> invs' s \<rbrace>
+lemma handleInterrupt_no_orphans[wp]:
+  "\<lbrace>no_orphans and invs' and pspace_aligned' and pspace_distinct'\<rbrace>
    handleInterrupt irq
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding handleInterrupt_def
-  apply (rule hoare_pre)
-   apply (wp hoare_drop_imps hoare_vcg_all_lift getIRQState_inv
-          | wpc | clarsimp simp: invs'_def valid_state'_def maskIrqSignal_def
-                                 handleReservedIRQ_def)+
-  done
+  by (wp hoare_drop_imps hoare_vcg_all_lift getIRQState_inv
+      | wpc | clarsimp simp: invs'_def valid_state'_def maskIrqSignal_def handleReservedIRQ_def)+
 
 lemma updateRestartPC_no_orphans[wp]:
   "\<lbrace> \<lambda>s. no_orphans s \<and> invs' s \<rbrace>
@@ -1669,20 +1382,6 @@ lemma updateRestartPC_no_orphans[wp]:
    \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
   by (wpsimp simp: updateRestartPC_def asUser_no_orphans)
 
-lemma updateRestartPC_valid_queues'[wp]:
-  "\<lbrace> \<lambda>s. valid_queues' s \<rbrace>
-   updateRestartPC t
-   \<lbrace> \<lambda>rv s. valid_queues' s \<rbrace>"
-  unfolding updateRestartPC_def
-  apply (rule asUser_valid_queues')
-  done
-
-lemma updateRestartPC_no_orphans_invs'_valid_queues'[wp]:
-  "\<lbrace>\<lambda>s. no_orphans s \<and> invs' s \<and> valid_queues' s \<rbrace>
-   updateRestartPC t
-   \<lbrace>\<lambda>rv s. no_orphans s \<and> valid_queues' s \<rbrace>"
-  by (wpsimp simp: updateRestartPC_def asUser_no_orphans)
-
 lemma suspend_no_orphans [wp]:
   "\<lbrace> \<lambda>s. no_orphans s \<and> invs' s \<and> sch_act_simple s \<and> tcb_at' t s \<rbrace>
    suspend t
@@ -1696,49 +1395,34 @@ lemma suspend_no_orphans [wp]:
   apply auto
   done
 
-lemma storeHWASID_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<rbrace>
-   storeHWASID asid hw_asid
-   \<lbrace> \<lambda>reply s. no_orphans s \<rbrace>"
+lemma storeHWASID_no_orphans[wp]:
+  "storeHWASID asid hw_asid \<lbrace>no_orphans\<rbrace>"
   unfolding no_orphans_disj all_queued_tcb_ptrs_def
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-  done
+  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift)
 
-lemma invalidateHWASIDEntry_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<rbrace>
-   invalidateHWASIDEntry hwASID
-   \<lbrace> \<lambda>reply s. no_orphans s \<rbrace>"
+lemma invalidateHWASIDEntry_no_orphans[wp]:
+  "invalidateHWASIDEntry hwASID \<lbrace>no_orphans\<rbrace>"
   unfolding no_orphans_disj all_queued_tcb_ptrs_def
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-  done
+  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift)
 
-lemma invalidateASID_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<rbrace>
-   invalidateASID asid
-   \<lbrace> \<lambda>reply s. no_orphans s \<rbrace>"
+lemma invalidateASID_no_orphans[wp]:
+  "invalidateASID asid \<lbrace>no_orphans\<rbrace>"
   unfolding no_orphans_disj all_queued_tcb_ptrs_def
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-  done
+  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift)
 
-lemma findFreeHWASID_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<rbrace>
-   findFreeHWASID
-   \<lbrace> \<lambda>reply s. no_orphans s \<rbrace>"
+lemma findFreeHWASID_no_orphans[wp]:
+  "findFreeHWASID \<lbrace>no_orphans\<rbrace>"
   unfolding no_orphans_disj all_queued_tcb_ptrs_def
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-  done
+  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift)
 
 crunch ksCurThread [wp]: invalidateASIDEntry "\<lambda> s. P (ksCurThread s)"
 
 crunch ksReadyQueues[wp]: invalidateASIDEntry "\<lambda>s. P (ksReadyQueues s)"
 
-lemma invalidateASIDEntry_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<rbrace>
-   invalidateASIDEntry asid
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+lemma invalidateASIDEntry_no_orphans[wp]:
+  "invalidateASIDEntry asid \<lbrace>no_orphans\<rbrace>"
   unfolding no_orphans_disj all_queued_tcb_ptrs_def
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-  done
+  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift)
 
 crunch no_orphans [wp]: flushSpace "no_orphans"
 
@@ -1754,21 +1438,15 @@ lemma deleteASIDPool_no_orphans [wp]:
      apply (wp mapM_wp_inv getObject_inv loadObject_default_inv | clarsimp)+
   done
 
-lemma storePTE_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<rbrace>
-   storePTE ptr val
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+lemma storePTE_no_orphans[wp]:
+  "storePTE ptr val \<lbrace>no_orphans\<rbrace>"
   unfolding no_orphans_disj all_queued_tcb_ptrs_def
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-  done
+  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift)
 
 lemma storePDE_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<rbrace>
-   storePDE ptr val
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+  "storePDE ptr val \<lbrace>no_orphans\<rbrace>"
   unfolding no_orphans_disj all_queued_tcb_ptrs_def
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-  done
+  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift)
 
 crunches unmapPage
   for no_orphans [wp]: "no_orphans"
@@ -1785,13 +1463,10 @@ lemma flushTable_no_orphans [wp]:
 crunches unmapPageTable, prepareThreadDelete
   for no_orphans [wp]: "no_orphans"
 
-lemma setASIDPool_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<rbrace>
-   setObject p (ap :: asidpool)
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+lemma setASIDPool_no_orphans[wp]:
+  "setObject p (ap :: asidpool) \<lbrace>no_orphans\<rbrace>"
   unfolding no_orphans_disj all_queued_tcb_ptrs_def
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-  done
+  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift)
 
 lemma deleteASID_no_orphans [wp]:
   "\<lbrace> \<lambda>s. no_orphans s \<rbrace>
@@ -1879,9 +1554,7 @@ lemma cteRevoke_no_orphans [wp]:
   done
 
 lemma cancelBadgedSends_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<rbrace>
-   cancelBadgedSends epptr badge
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+  "cancelBadgedSends epptr badge \<lbrace>no_orphans\<rbrace>"
   unfolding cancelBadgedSends_def
   apply (wpsimp wp: filterM_preserved tcbSchedEnqueue_almost_no_orphans gts_wp' sts_st_tcb'
          | wp (once) hoare_drop_imps)+
@@ -1891,38 +1564,25 @@ crunch no_orphans [wp]: invalidateTLBByASID "no_orphans"
 
 crunch no_orphans [wp]: handleFaultReply "no_orphans"
 
-crunch valid_queues' [wp]: handleFaultReply "valid_queues'"
-
 lemma doReplyTransfer_no_orphans[wp]:
   "\<lbrace>no_orphans and invs' and tcb_at' sender and tcb_at' receiver\<rbrace>
    doReplyTransfer sender receiver slot grant
    \<lbrace>\<lambda>rv. no_orphans\<rbrace>"
   unfolding doReplyTransfer_def
   apply (wp sts_st_tcb' setThreadState_not_active_no_orphans threadSet_no_orphans
-            threadSet_valid_queues' threadSet_weak_sch_act_wf
+            threadSet_weak_sch_act_wf
          | wpc | clarsimp simp: is_active_thread_state_def isRunning_def isRestart_def
          | wp (once) hoare_drop_imps
-         | strengthen sch_act_wf_weak invs_valid_queues')+
+         | strengthen sch_act_wf_weak)+
               apply (rule_tac Q="\<lambda>rv. invs' and no_orphans" in hoare_post_imp)
                apply (fastforce simp: inQ_def)
               apply (wp hoare_drop_imps | clarsimp)+
   apply (clarsimp simp:invs'_def valid_state'_def valid_pspace'_def)
   done
 
-lemma cancelSignal_valid_queues' [wp]:
-  "\<lbrace> \<lambda>s. valid_queues' s \<and> valid_objs' s \<rbrace>
-   cancelSignal t ntfn
-   \<lbrace> \<lambda>rv s. valid_queues' s \<rbrace>"
-  unfolding cancelSignal_def Let_def
-  apply (rule hoare_pre)
-   apply (wp hoare_drop_imps | wpc | clarsimp)+
-  done
-
 crunch no_orphans [wp]: setupReplyMaster "no_orphans"
   (wp: crunch_wps simp: crunch_simps)
 
-crunch valid_queues' [wp]: setupReplyMaster "valid_queues'"
-
 lemma restart_no_orphans [wp]:
   "\<lbrace> \<lambda>s. no_orphans s \<and> invs' s \<and> sch_act_simple s \<and> tcb_at' t s \<rbrace>
    restart t
@@ -1931,7 +1591,6 @@ lemma restart_no_orphans [wp]:
   apply (wp tcbSchedEnqueue_almost_no_orphans sts_st_tcb' cancelIPC_weak_sch_act_wf
          | clarsimp simp: o_def if_apply_def2
          | strengthen no_orphans_strg_almost
-         | strengthen invs_valid_queues'
          | wp (once) hoare_drop_imps)+
   apply auto
   done
@@ -1953,8 +1612,7 @@ lemma writereg_no_orphans:
   apply simp
   apply (rule hoare_pre)
   by (wp hoare_vcg_if_lift hoare_vcg_conj_lift restart_invs' hoare_weak_lift_imp
-       | strengthen invs_valid_queues'  | clarsimp  simp: invs'_def valid_state'_def dest!: global'_no_ex_cap )+
-
+       | strengthen | clarsimp simp: invs'_def valid_state'_def dest!: global'_no_ex_cap)+
 
 lemma copyreg_no_orphans:
   "\<lbrace> \<lambda>s. no_orphans s \<and> invs' s \<and> sch_act_simple s \<and> tcb_at' src s
@@ -1969,7 +1627,7 @@ lemma copyreg_no_orphans:
              | wpc | clarsimp split del: if_splits)+
        apply (wp hoare_weak_lift_imp hoare_vcg_conj_lift hoare_drop_imp mapM_x_wp' restart_invs'
               restart_no_orphans asUser_no_orphans suspend_nonz_cap_to_tcb
-              | strengthen invs_valid_queues' | wpc | simp add: if_apply_def2)+
+              | wpc | simp add: if_apply_def2)+
   apply (fastforce simp: invs'_def valid_state'_def dest!: global'_no_ex_cap)
   done
 
@@ -1991,22 +1649,19 @@ lemma almost_no_orphans_no_orphans':
   "\<lbrakk> almost_no_orphans t s; ksCurThread s = t\<rbrakk> \<Longrightarrow> no_orphans s"
   by (auto simp: almost_no_orphans_def no_orphans_def all_active_tcb_ptrs_def)
 
-lemma setPriority_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> invs' s \<and> tcb_at' tptr s \<rbrace>
+lemma setPriority_no_orphans[wp]:
+  "\<lbrace>no_orphans and invs' and tcb_at' tptr\<rbrace>
    setPriority tptr prio
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding setPriority_def
   apply wpsimp
-    apply (rule_tac Q="\<lambda>rv s. almost_no_orphans tptr s \<and> valid_queues' s \<and> weak_sch_act_wf (ksSchedulerAction s) s" in hoare_post_imp)
+    apply (rule_tac Q="\<lambda>_ s. almost_no_orphans tptr s \<and> weak_sch_act_wf (ksSchedulerAction s) s" in hoare_post_imp)
      apply clarsimp
      apply (clarsimp simp: is_active_tcb_ptr_runnable' pred_tcb_at'_def obj_at'_def
                            almost_no_orphans_no_orphans elim!: almost_no_orphans_no_orphans')
-    apply (wp threadSet_almost_no_orphans threadSet_valid_queues' | clarsimp simp: inQ_def)+
+    apply (wp threadSet_almost_no_orphans | clarsimp simp: inQ_def)+
     apply (wpsimp wp: threadSet_weak_sch_act_wf)
    apply (wp tcbSchedDequeue_almost_no_orphans| clarsimp)+
-   apply (rule_tac Q="\<lambda>rv. obj_at' (Not \<circ> tcbQueued) tptr and invs' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)" in hoare_post_imp)
-    apply (clarsimp simp: obj_at'_def inQ_def)
-   apply (wp tcbSchedDequeue_not_queued | clarsimp)+
   done
 
 lemma setMCPriority_no_orphans[wp]:
@@ -2058,7 +1713,6 @@ lemma tc_no_orphans:
                checkCap_inv[where P=no_orphans] checkCap_inv[where P="tcb_at' a"]
                threadSet_cte_wp_at' hoare_vcg_all_lift_R hoare_vcg_all_lift threadSet_no_orphans
                hoare_vcg_const_imp_lift_R hoare_weak_lift_imp hoare_drop_imp threadSet_ipcbuffer_invs
-          | strengthen invs_valid_queues'
           | (simp add: locateSlotTCB_def locateSlotBasic_def objBits_def
                      objBitsKO_def tcbIPCBufferSlot_def tcb_cte_cases_def,
            wp hoare_return_sp)
@@ -2089,13 +1743,12 @@ lemma invokeTCB_no_orphans [wp]:
   done
 
 lemma invokeCNode_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> invs' s \<and> valid_cnode_inv' cinv s \<and> sch_act_simple s \<rbrace>
+  "\<lbrace>no_orphans and invs' and valid_cnode_inv' cinv and sch_act_simple\<rbrace>
    invokeCNode cinv
-   \<lbrace> \<lambda>rv. no_orphans \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding invokeCNode_def
   apply (rule hoare_pre)
    apply (wp hoare_drop_imps unless_wp | wpc | clarsimp split del: if_split)+
-  apply (simp add: invs_valid_queues')
   done
 
 lemma invokeIRQControl_no_orphans [wp]:
@@ -2238,17 +1891,15 @@ lemma arch_performInvocation_no_orphans [wp]:
   done
 
 lemma setDomain_no_orphans [wp]:
-  "\<lbrace>no_orphans and valid_queues and valid_queues' and cur_tcb'\<rbrace>
-     setDomain tptr newdom
+  "\<lbrace>no_orphans and cur_tcb' and tcb_at' tptr\<rbrace>
+   setDomain tptr newdom
    \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   apply (simp add: setDomain_def when_def)
   apply (wp tcbSchedEnqueue_almost_no_orphans hoare_vcg_imp_lift threadSet_almost_no_orphans
-            threadSet_valid_queues'_no_state threadSet_st_tcb_at2 hoare_vcg_disj_lift
+            threadSet_st_tcb_at2 hoare_vcg_disj_lift
             threadSet_no_orphans
-       | clarsimp simp: st_tcb_at_neg2 not_obj_at')+
-   apply (auto simp: tcb_at_typ_at' st_tcb_at_neg' is_active_tcb_ptr_runnable'
-                     cur_tcb'_def obj_at'_def
-               dest: pred_tcb_at')
+         | clarsimp simp: st_tcb_at_neg2 not_obj_at')+
+  apply (fastforce simp: tcb_at_typ_at'  is_active_tcb_ptr_runnable')
   done
 
 crunch no_orphans[wp]: InterruptDecls_H.invokeIRQHandler no_orphans
@@ -2277,8 +1928,6 @@ lemma K_bind_hoareE [wp]:
   "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> K_bind f x \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
   by simp
 
-crunch valid_queues' [wp]: replyFromKernel "valid_queues'"
-
 lemma handleInvocation_no_orphans [wp]:
   "\<lbrace> \<lambda>s. no_orphans s \<and> invs' s \<and> vs_valid_duplicates' (ksPSpace s) \<and>
          ct_active' s \<and> ksSchedulerAction s = ResumeCurrentThread \<rbrace>
@@ -2296,20 +1945,12 @@ lemma handleInvocation_no_orphans [wp]:
                   ct_in_state'_set setThreadState_st_tcb
                   hoare_vcg_all_lift
                 | simp add: split_def split del: if_split)+
-         apply (wps setThreadState_ct')
-         apply (wp sts_ksQ
-                   setThreadState_current_no_orphans sts_invs_minor'
-                   ct_in_state'_set setThreadState_st_tcb
-                 | simp add: split_def split del: if_split)+
   apply (clarsimp simp: if_apply_def2)
-  apply (frule(1) ct_not_ksQ)
   by (auto simp: ct_in_state'_def pred_tcb_at'_def obj_at'_def invs'_def
                     cur_tcb'_def valid_state'_def valid_idle'_def)
 
 lemma receiveSignal_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<rbrace>
-   receiveSignal thread cap isBlocking
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+  "receiveSignal thread cap isBlocking \<lbrace>no_orphans\<rbrace>"
   unfolding receiveSignal_def
   apply (wp hoare_drop_imps setThreadState_not_active_no_orphans | wpc
          | clarsimp simp: is_active_thread_state_def isRunning_def isRestart_def
@@ -2327,7 +1968,7 @@ lemma receiveIPC_no_orphans [wp]:
              hoare_vcg_all_lift sts_st_tcb'
           | wpc
           | clarsimp simp: is_active_thread_state_def isRunning_def isRestart_def
-                           doNBRecvFailedTransfer_def invs_valid_queues'
+                           doNBRecvFailedTransfer_def
           | strengthen sch_act_wf_weak)+
   done
 
@@ -2418,7 +2059,8 @@ theorem callKernel_no_orphans [wp]:
    callKernel e
    \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
   unfolding callKernel_def
-  by (wpsimp wp: weak_if_wp schedule_invs' hoare_drop_imps)
+  by (wpsimp wp: weak_if_wp schedule_invs' hoare_drop_imps
+      | strengthen invs_pspace_aligned' invs_pspace_distinct')+
 
 end
 
diff --git a/proof/refine/ARM_HYP/ADT_H.thy b/proof/refine/ARM_HYP/ADT_H.thy
index f4ef312901..5deb5ff44c 100644
--- a/proof/refine/ARM_HYP/ADT_H.thy
+++ b/proof/refine/ARM_HYP/ADT_H.thy
@@ -482,7 +482,7 @@ proof -
     apply (intro conjI impI allI)
            apply (erule pspace_dom_relatedE[OF _ pspace_relation])
            apply clarsimp
-           apply (case_tac ko, simp_all add: other_obj_relation_def)
+           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)
@@ -495,7 +495,7 @@ proof -
            apply (clarsimp split: if_split_asm)+
 
           apply (erule pspace_dom_relatedE[OF _ pspace_relation])
-          apply (case_tac ko, simp_all add: other_obj_relation_def)
+          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)
@@ -508,7 +508,7 @@ proof -
           apply (clarsimp split: if_split_asm)+
 
          apply (erule pspace_dom_relatedE[OF _ pspace_relation])
-         apply (case_tac ko, simp_all add: other_obj_relation_def)
+         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)
@@ -517,7 +517,7 @@ proof -
          apply (clarsimp split: if_split_asm)+
 
         apply (erule pspace_dom_relatedE[OF _ pspace_relation])
-        apply (case_tac ko, simp_all add: other_obj_relation_def)
+        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)
@@ -543,7 +543,7 @@ proof -
          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: other_obj_relation_def)
+       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)
@@ -569,7 +569,7 @@ proof -
         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: other_obj_relation_def)
+      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)
@@ -596,7 +596,7 @@ proof -
                                 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: other_obj_relation_def
+     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)
@@ -660,7 +660,7 @@ proof -
     (* mapping architecture-specific objects *)
     apply clarsimp
     apply (erule pspace_dom_relatedE[OF _ pspace_relation])
-    apply (case_tac ko, simp_all add: other_obj_relation_def)
+    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)
@@ -804,7 +804,7 @@ shows
    apply (case_tac "ksPSpace s' x", clarsimp)
     apply (erule_tac x=x in allE, clarsimp)
    apply clarsimp
-   apply (case_tac a, simp_all add: other_obj_relation_def)
+   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)
@@ -848,7 +848,7 @@ lemma TCB_implies_KOTCB:
   apply (clarsimp simp add: pspace_relation_def pspace_dom_def
                             dom_def UNION_eq Collect_eq)
   apply (erule_tac x=a in allE)+
-  apply (clarsimp simp add: other_obj_relation_def
+  apply (clarsimp simp add: tcb_relation_cut_def
                   split: Structures_H.kernel_object.splits)
   apply (drule iffD1)
    apply (fastforce simp add: dom_def image_def)
@@ -1638,7 +1638,7 @@ definition
       domain_index_internal = ksDomScheduleIdx s,
       cur_domain_internal = ksCurDomain s,
       domain_time_internal = ksDomainTime s,
-      ready_queues_internal = curry (ksReadyQueues 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:
@@ -1646,12 +1646,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 absEkheap_correct
-                           absCDTList_correct[THEN fun_cong] state_relation_def invs_def valid_state_def
-                           ready_queues_relation_def invs'_def valid_state'_def
-                           valid_pspace_def valid_sched_def valid_pspace'_def curry_def fun_eq_iff)
-      apply (fastforce simp: absEkheap_correct)
+           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
 
 
diff --git a/proof/refine/ARM_HYP/ArchAcc_R.thy b/proof/refine/ARM_HYP/ArchAcc_R.thy
index 81edd38ee9..66b7ea8871 100644
--- a/proof/refine/ARM_HYP/ArchAcc_R.thy
+++ b/proof/refine/ARM_HYP/ArchAcc_R.thy
@@ -934,12 +934,16 @@ lemma setObject_PD_corres [corres]:
    apply (drule(1) ekheap_kheap_dom)
    apply clarsimp
    apply (drule_tac x=p in bspec, erule domI)
-   apply (simp add: other_obj_relation_def
+   apply (simp add: tcb_relation_cut_def
            split: Structures_A.kernel_object.splits)
-  apply (rule conjI)
+  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
+  apply (extract_conjunct \<open>match conclusion in "ready_queues_relation_2 _ _ _ _ _" \<Rightarrow> -\<close>)
+   apply (prop_tac "typ_at' (koTypeOf (injectKO pde')) p b")
+    apply (simp add: typ_at'_def ko_wp_at'_def)
+   subgoal by (fastforce dest: tcbs_of'_non_tcb_update)
   apply (simp add: map_to_ctes_upd_other)
   apply (simp add: fun_upd_def)
   apply (simp add: caps_of_state_after_update obj_at_def swp_cte_at_caps_of)
@@ -1010,12 +1014,15 @@ lemma setObject_PT_corres [corres]:
    apply (drule(1) ekheap_kheap_dom)
    apply clarsimp
    apply (drule_tac x=p in bspec, erule domI)
-   apply (simp add: other_obj_relation_def
-               split: Structures_A.kernel_object.splits)
-  apply (rule conjI)
+   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
+  apply (extract_conjunct \<open>match conclusion in "ready_queues_relation_2 _ _ _ _ _" \<Rightarrow> -\<close>)
+   apply (prop_tac "typ_at' (koTypeOf (injectKO pte')) p b")
+    apply (simp add: typ_at'_def ko_wp_at'_def)
+   subgoal by (fastforce dest: tcbs_of'_non_tcb_update)
   apply (simp add: map_to_ctes_upd_other)
   apply (simp add: fun_upd_def)
   apply (simp add: caps_of_state_after_update obj_at_def swp_cte_at_caps_of)
@@ -1683,5 +1690,166 @@ lemma dmo_clearMemory_invs'[wp]:
   apply fastforce
   done
 
+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>TCB\<close>
+      apply (clarsimp simp: tcbBlockSizeBits_def elim!: is_aligned_weaken)
+
+     \<comment>\<open>PageTable\<close>
+     apply (clarsimp simp: archObjSize_def pteBits_def)
+     apply (rule is_aligned_add)
+      apply (erule is_aligned_weaken)
+      apply (simp add: vspace_bits_defs)
+     apply (rule is_aligned_shift)
+
+    \<comment>\<open>PageDirectory\<close>
+    apply (clarsimp simp: archObjSize_def vspace_bits_defs)
+    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 (rule pbfs_atleast_pageBits)
+   apply (fastforce intro: is_aligned_shift is_aligned_mult_triv2)
+
+  \<comment>\<open>other_obj_relation\<close>
+  apply (simp add: other_obj_relation_def)
+  by (clarsimp simp: 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)
+
+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 bit_simps 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_def2)
+       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=tcbBlockSizeBits in exI)
+      apply (simp add: tcbBlockSizeBits_def)
+     apply (rule_tac x=pteBits in exI)
+     apply (simp add: bit_simps is_aligned_shift mask_def vspace_bits_defs)
+     apply word_bitwise
+    apply (rule_tac x=pdeBits in exI)
+    apply (simp add: bit_simps is_aligned_shift mask_def vspace_bits_defs)
+    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
+                         pbfs_atleast_pageBits[simplified bit_simps] archObjSize_def pteBits_def
+                         pdeBits_def)
+    apply (simp add: vspace_bits_defs)
+   apply (simp add: vspace_bits_defs)
+  apply (cases ko; simp add: other_obj_relation_def objBits_defs
+                      split: kernel_object.splits)
+  apply (rename_tac ako', case_tac ako';
+         clarsimp simp: archObjSize_def vspace_bits_defs vcpu_bits_def
+                 split: arch_kernel_object.splits)
+  done
+
+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 (rule ps_clearI, assumption)
+   apply (case_tac ko'; simp add: objBits_simps objBits_defs obj_at_simps)
+   apply (simp split: arch_kernel_object.splits
+                 add: obj_at_simps pteBits_def pdeBits_def vspace_bits_defs vcpu_bits_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_def2 objBits_simps)
+       apply (rule_tac n=cte_level_bits in is_aligned_add_step_le'; assumption?)
+         apply (rule is_aligned_add; (rule is_aligned_shift)?)
+         apply (erule is_aligned_weaken, simp add: cte_level_bits_def)
+        apply (rule is_aligned_add; (rule is_aligned_shift)?)
+        apply (erule is_aligned_weaken, simp add: cte_level_bits_def)
+       apply (simp add: cte_level_bits_def cteSizeBits_def)
+      apply (clarsimp simp: pte_relation_def objBits_simps archObjSize_def)
+      apply (rule_tac n=pteBits in is_aligned_add_step_le';
+             simp add: vspace_bits_defs vcpu_bits_def)
+     apply (clarsimp simp: pde_relation_def objBits_simps archObjSize_def)
+     apply (rule_tac n=pdeBits in is_aligned_add_step_le'; simp add: vspace_bits_defs vcpu_bits_def)
+    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 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)
+  done
+
 end
 end
diff --git a/proof/refine/ARM_HYP/Arch_R.thy b/proof/refine/ARM_HYP/Arch_R.thy
index 8a1d041ee0..aa18bcee18 100644
--- a/proof/refine/ARM_HYP/Arch_R.thy
+++ b/proof/refine/ARM_HYP/Arch_R.thy
@@ -338,7 +338,7 @@ lemma performASIDControlInvocation_corres:
      apply (simp add:pageBits_def)
     apply clarsimp
     apply (drule(1) cte_cap_in_untyped_range)
-         apply (fastforce simp:cte_wp_at_ctes_of)
+         apply (fastforce simp: cte_wp_at_ctes_of)
         apply assumption+
      apply fastforce
     apply simp
@@ -1286,8 +1286,9 @@ lemma invokeVCPUWriteReg_corres:
   done
 
 lemma archThreadSet_VCPU_Some_corres[corres]:
-  "corres dc (tcb_at t) (tcb_at' t)
-    (arch_thread_set (tcb_vcpu_update (\<lambda>_. Some v)) t) (archThreadSet (atcbVCPUPtr_update (\<lambda>_. Some v)) t)"
+  "corres dc (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+    (arch_thread_set (tcb_vcpu_update (\<lambda>_. Some v)) t)
+    (archThreadSet (atcbVCPUPtr_update (\<lambda>_. Some v)) t)"
   apply (rule archThreadSet_corres)
   apply (simp add: arch_tcb_relation_def)
   done
@@ -1325,7 +1326,7 @@ lemma associateVCPUTCB_corres:
        apply (clarsimp simp: vcpu_relation_def)
       apply (rule conjI)
        apply (frule (1) sym_refs_vcpu_tcb, fastforce)
-       apply (clarsimp simp: obj_at_def)+
+       apply (fastforce simp: obj_at_def)+
      apply (wpsimp)+
      apply (rule_tac Q="\<lambda>_. invs' and tcb_at' t" in hoare_strengthen_post)
       apply wpsimp
@@ -1524,7 +1525,7 @@ lemma tcbSchedEnqueue_vs_entry_align[wp]:
  "\<lbrace>\<lambda>s. ko_wp_at' (\<lambda>ko. P (vs_entry_align ko)) p s\<rbrace>
    tcbSchedEnqueue pa
   \<lbrace>\<lambda>rv. ko_wp_at' (\<lambda>ko. P (vs_entry_align ko)) p\<rbrace>"
-  apply (clarsimp simp: tcbSchedEnqueue_def setQueue_def)
+  apply (clarsimp simp: tcbSchedEnqueue_def tcbQueuePrepend_def setQueue_def)
   by (wp unless_wp | simp)+
 
 crunch vs_entry_align[wp]:
@@ -2252,7 +2253,7 @@ lemma assoc_invs':
                     cteCaps_of_ctes_of_lift irqs_masked_lift ct_idle_or_in_cur_domain'_lift
                     valid_irq_states_lift' hoare_vcg_all_lift hoare_vcg_disj_lift
                     valid_pde_mappings_lift' setObject_typ_at' cur_tcb_lift
-                    setVCPU_valid_arch'
+                    setVCPU_valid_arch' valid_bitmaps_lift sym_heap_sched_pointers_lift
               simp: objBits_simps archObjSize_def vcpu_bits_def pageBits_def
                     state_refs_of'_vcpu_empty state_hyp_refs_of'_vcpu_absorb valid_arch_tcb'_def
         | wp (once) hoare_vcg_imp_lift)+
diff --git a/proof/refine/ARM_HYP/Bits_R.thy b/proof/refine/ARM_HYP/Bits_R.thy
index 942850eb3a..67b738cbce 100644
--- a/proof/refine/ARM_HYP/Bits_R.thy
+++ b/proof/refine/ARM_HYP/Bits_R.thy
@@ -76,6 +76,10 @@ lemma projectKO_tcb:
   "(projectKO_opt ko = Some t) = (ko = KOTCB t)"
   by (cases ko) (auto simp: projectKO_opts_defs)
 
+lemma tcb_of'_TCB[simp]:
+  "tcb_of' (KOTCB tcb) = Some tcb"
+  by (simp add: projectKO_tcb)
+
 lemma projectKO_cte:
   "(projectKO_opt ko = Some t) = (ko = KOCTE t)"
   by (cases ko) (auto simp: projectKO_opts_defs)
diff --git a/proof/refine/ARM_HYP/CNodeInv_R.thy b/proof/refine/ARM_HYP/CNodeInv_R.thy
index efa6b06484..6d3fce26d2 100644
--- a/proof/refine/ARM_HYP/CNodeInv_R.thy
+++ b/proof/refine/ARM_HYP/CNodeInv_R.thy
@@ -5062,8 +5062,6 @@ crunch irq_states'[wp]: cteSwap "valid_irq_states'"
 
 crunch pde_mappings'[wp]: cteSwap "valid_pde_mappings'"
 
-crunch vq'[wp]: cteSwap "valid_queues'"
-
 crunch ksqsL1[wp]: cteSwap "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
 
 crunch ksqsL2[wp]: cteSwap "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
@@ -5078,6 +5076,12 @@ crunch ct_not_inQ[wp]: cteSwap "ct_not_inQ"
 
 crunch ksDomScheduleIdx [wp]: cteSwap "\<lambda>s. P (ksDomScheduleIdx s)"
 
+crunches cteSwap
+  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: valid_bitmaps_lift)
+
 lemma cteSwap_invs'[wp]:
   "\<lbrace>invs' and valid_cap' c and valid_cap' c' and
     ex_cte_cap_to' c1 and ex_cte_cap_to' c2 and
@@ -5538,6 +5542,10 @@ lemma updateCap_untyped_ranges_zero_simple:
 crunch tcb_in_cur_domain'[wp]: updateCap "tcb_in_cur_domain' t"
   (wp: crunch_wps simp: crunch_simps rule: tcb_in_cur_domain'_lift)
 
+crunches updateCap
+  for valid_bitmaps[wp]: valid_bitmaps
+  (rule: valid_bitmaps_lift)
+
 lemma make_zombie_invs':
   "\<lbrace>\<lambda>s. invs' s \<and> s \<turnstile>' cap \<and>
     cte_wp_at' (\<lambda>cte. isFinal (cteCap cte) sl (cteCaps_of s)) sl s \<and>
@@ -5555,7 +5563,8 @@ lemma make_zombie_invs':
                              \<and> bound_tcb_at' ((=) None) p s
                              \<and> obj_at' (Not \<circ> tcbQueued) p s
                              \<and> ko_wp_at' (Not \<circ> hyp_live') p s
-                             \<and> (\<forall>pr. p \<notin> set (ksReadyQueues s pr)))) sl s\<rbrace>
+                             \<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_state'_def valid_pspace'_def valid_mdb'_def
@@ -5593,7 +5602,9 @@ lemma make_zombie_invs':
    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> ko_wp_at' (Not \<circ> hyp_live') p' s")
+                               \<and> ko_wp_at' (Not \<circ> hyp_live') 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 live'_def hyp_live'_def)
    subgoal by (auto dest!: isCapDs)[1]
   apply (clarsimp simp: cte_wp_at_ctes_of disj_ac
@@ -8590,6 +8601,15 @@ lemma cteMove_urz [wp]:
   apply auto
   done
 
+crunches updateMDB
+  for valid_bitmaps[wp]: valid_bitmaps
+  (rule: valid_bitmaps_lift)
+
+(* FIXME: arch_split *)
+lemma haskell_assert_inv:
+  "haskell_assert Q L \<lbrace>P\<rbrace>"
+  by wpsimp
+
 lemma cteMove_invs' [wp]:
   "\<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>
@@ -8667,6 +8687,10 @@ crunch ksDomSchedule[wp]: updateCap "\<lambda>s. P (ksDomSchedule s)"
 crunch ksDomScheduleIdx[wp]: updateCap "\<lambda>s. P (ksDomScheduleIdx s)"
 crunch ksDomainTime[wp]: updateCap "\<lambda>s. P (ksDomainTime s)"
 
+crunches updateCap
+  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 corres_null_cap_update:
   "cap_relation cap cap' \<Longrightarrow>
    corres dc (invs and cte_wp_at ((=) cap) slot)
diff --git a/proof/refine/ARM_HYP/CSpace1_R.thy b/proof/refine/ARM_HYP/CSpace1_R.thy
index d6e54b253a..9f1e49f37e 100644
--- a/proof/refine/ARM_HYP/CSpace1_R.thy
+++ b/proof/refine/ARM_HYP/CSpace1_R.thy
@@ -236,7 +236,7 @@ lemma pspace_relation_cte_wp_at:
    apply (clarsimp elim!: cte_wp_at_weakenE')
   apply clarsimp
   apply (drule(1) pspace_relation_absD)
-  apply (clarsimp simp: other_obj_relation_def)
+  apply (clarsimp simp: tcb_relation_cut_def)
   apply (simp split: kernel_object.split_asm)
   apply (drule(2) aligned_distinct_obj_atI'[where 'a=tcb])
    apply simp
@@ -1636,10 +1636,10 @@ lemma cte_map_pulls_tcb_to_abstract:
      \<Longrightarrow> \<exists>tcb'. kheap s x = Some (TCB tcb') \<and> tcb_relation tcb' tcb
                   \<and> (z = (x, tcb_cnode_index (unat ((y - x) >> cte_level_bits))))"
   apply (rule pspace_dom_relatedE, assumption+)
-  apply (erule(1) obj_relation_cutsE, simp_all split: if_split_asm)
-  apply (clarsimp simp: other_obj_relation_def
-                 split: Structures_A.kernel_object.split_asm
-                        ARM_A.arch_kernel_obj.split_asm)
+  apply (erule(1) obj_relation_cutsE;
+         clarsimp simp: other_obj_relation_def
+                  split: Structures_A.kernel_object.split_asm
+                         ARM_A.arch_kernel_obj.split_asm if_split_asm)
   apply (drule tcb_cases_related2)
   apply clarsimp
   apply (frule(1) cte_wp_at_tcbI [OF _ _ TrueI, where t="(a, b)" for a b, simplified])
@@ -1655,8 +1655,7 @@ lemma pspace_relation_update_tcbs:
               del: dom_fun_upd)
   apply (erule conjE)
   apply (rule ballI, drule(1) bspec)
-  apply (rule conjI, simp add: other_obj_relation_def)
-  apply (clarsimp split: Structures_A.kernel_object.split_asm)
+  apply (clarsimp simp: tcb_relation_cut_def split: Structures_A.kernel_object.split_asm)
   apply (drule bspec, fastforce)
   apply clarsimp
   apply (erule(1) obj_relation_cutsE, simp_all split: if_split_asm)
@@ -1878,6 +1877,27 @@ lemma descendants_of_eq':
   apply simp
   done
 
+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
+
+lemma setObject_cte_tcbSchedNexts_of_use_valid_ksPSpace:
+  assumes step: "(x, s\<lparr>ksPSpace := ps\<rparr>) \<in> fst (setObject p (cte :: cte) s)"
+  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_inQ_of_use_valid_ksPSpace:
+  assumes step: "(x, s\<lparr>ksPSpace := ps\<rparr>) \<in> fst (setObject p (cte :: cte) s)"
+  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>
@@ -1891,7 +1911,12 @@ lemma updateCap_stuff:
          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'')" using assms
+         (pspace_distinct' s' \<longrightarrow> pspace_distinct' s'') \<and>
+         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)
@@ -1900,8 +1925,11 @@ lemma updateCap_stuff:
   apply (frule setCTE_pspace_only)
   apply (clarsimp simp: setCTE_def)
   apply (intro conjI impI)
-   apply (erule(1) use_valid [OF _ setObject_aligned])
-  apply (erule(1) use_valid [OF _ setObject_distinct])
+      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 *)
@@ -1918,16 +1946,16 @@ lemma pspace_relation_cte_wp_atI':
    apply (simp split: if_split_asm)
   apply (erule(1) pspace_dom_relatedE)
   apply (erule(1) obj_relation_cutsE, simp_all split: if_split_asm)
+   apply (subgoal_tac "n = x - y", clarsimp)
+    apply (drule tcb_cases_related2, clarsimp)
+    apply (intro exI, rule conjI)
+     apply (erule(1) cte_wp_at_tcbI[where t="(a, b)" for a b, simplified])
+     apply fastforce
+    apply simp
+   apply clarsimp
   apply (simp add: other_obj_relation_def
             split: Structures_A.kernel_object.split_asm
                    ARM_A.arch_kernel_obj.split_asm)
-  apply (subgoal_tac "n = x - y", clarsimp)
-   apply (drule tcb_cases_related2, clarsimp)
-   apply (intro exI, rule conjI)
-    apply (erule(1) cte_wp_at_tcbI[where t="(a, b)" for a b, simplified])
-    apply fastforce
-   apply simp
-  apply clarsimp
   done
 
 lemma pspace_relation_cte_wp_atI:
@@ -2452,7 +2480,7 @@ lemma updateCap_corres:
   apply (clarsimp simp: in_set_cap_cte_at_swp pspace_relations_def)
   apply (drule updateCap_stuff)
   apply simp
-  apply (rule conjI)
+  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 (rule conjI)
    prefer 2
@@ -2540,9 +2568,9 @@ lemma updateMDB_pspace_relation:
     apply (clarsimp simp: tcb_ctes_clear cte_level_bits_def objBits_defs)
    apply clarsimp
    apply (rule pspace_dom_relatedE, assumption+)
-   apply (rule obj_relation_cutsE, assumption+, simp_all split: if_split_asm)[1]
-   apply (clarsimp split: Structures_A.kernel_object.split_asm
-                          ARM_A.arch_kernel_obj.split_asm
+   apply (rule obj_relation_cutsE, assumption+;
+          clarsimp split: Structures_A.kernel_object.split_asm
+                          ARM_A.arch_kernel_obj.split_asm if_split_asm
                     simp: other_obj_relation_def)
    apply (frule(1) tcb_cte_cases_aligned_helpers(1))
    apply (frule(1) tcb_cte_cases_aligned_helpers(2))
@@ -2604,6 +2632,25 @@ lemma updateMDB_ctes_of:
 
 crunch aligned[wp]: updateMDB "pspace_aligned'"
 crunch pdistinct[wp]: updateMDB "pspace_distinct'"
+crunch tcbSchedPrevs_of[wp]: updateMDB "\<lambda>s. P (tcbSchedPrevs_of s)"
+crunch tcbSchedNexts_of[wp]: updateMDB "\<lambda>s. P (tcbSchedNexts_of s)"
+crunch inQ_opt_pred[wp]: updateMDB "\<lambda>s. P (inQ d p |< tcbs_of' s)"
+crunch inQ_opt_pred'[wp]: updateMDB "\<lambda>s. P (\<lambda>d p. inQ d p |< tcbs_of' s)"
+crunch ksReadyQueues[wp]: updateMDB "\<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
+
+crunches 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')"
@@ -2626,7 +2673,11 @@ lemma updateMDB_the_lot:
          ksDomScheduleIdx s'' = ksDomScheduleIdx s' \<and>
          ksDomSchedule s''    = ksDomSchedule s' \<and>
          ksCurDomain s''      = ksCurDomain s' \<and>
-         ksDomainTime s''     = ksDomainTime s'"
+         ksDomainTime s''     = ksDomainTime s' \<and>
+         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)
@@ -2635,9 +2686,8 @@ using assms
    apply (erule use_valid)
     apply wp
    apply simp
-  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:
@@ -3833,6 +3883,9 @@ lemma updateUntypedCap_descendants_of:
   apply (clarsimp simp:mdb_next_rel_def mdb_next_def split:if_splits)
   done
 
+crunches setCTE
+  for tcbQueued[wp]: "\<lambda>s. P (tcbQueued |< tcbs_of' s)"
+
 lemma setCTE_UntypedCap_corres:
   "\<lbrakk>cap_relation cap (cteCap cte); is_untyped_cap cap; idx' = idx\<rbrakk>
    \<Longrightarrow> corres dc (cte_wp_at ((=) cap) src and valid_objs and
@@ -3862,10 +3915,19 @@ lemma setCTE_UntypedCap_corres:
    apply assumption
   apply (clarsimp simp: pspace_relations_def)
   apply (subst conj_assoc[symmetric])
+  apply clarsimp
   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)
@@ -5143,11 +5205,15 @@ lemma updateMDB_the_lot':
          ksDomScheduleIdx s'' = ksDomScheduleIdx s' \<and>
          ksDomSchedule s''    = ksDomSchedule s' \<and>
          ksCurDomain s''      = ksCurDomain s' \<and>
-         ksDomainTime s''     = ksDomainTime s'"
+         ksDomainTime s''     = ksDomainTime s' \<and>
+         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
+   done
 
 lemma cte_map_inj_eq':
   "\<lbrakk>(cte_map p = cte_map p');
@@ -5249,7 +5315,6 @@ lemma cteInsert_corres:
             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 "ksReadyQueues t = p" for p t)+
             apply (thin_tac "ksSchedulerAction t = p" for p t)+
             apply (clarsimp simp: pspace_relations_def)
             apply (rule conjI)
diff --git a/proof/refine/ARM_HYP/CSpace_R.thy b/proof/refine/ARM_HYP/CSpace_R.thy
index e56496a8d4..385412c497 100644
--- a/proof/refine/ARM_HYP/CSpace_R.thy
+++ b/proof/refine/ARM_HYP/CSpace_R.thy
@@ -1099,43 +1099,6 @@ lemma bitmapQ_no_L2_orphans_lift:
   apply (rule hoare_vcg_prop, assumption)
   done
 
-lemma valid_queues_lift_asm:
-  assumes tat1: "\<And>d p tcb. \<lbrace>obj_at' (inQ d p) tcb and Q \<rbrace> f \<lbrace>\<lambda>_. obj_at' (inQ d p) tcb\<rbrace>"
-  and     tat2: "\<And>tcb. \<lbrace>st_tcb_at' runnable' tcb and Q \<rbrace> f \<lbrace>\<lambda>_. st_tcb_at' runnable' tcb\<rbrace>"
-  and     prq: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueues s) \<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueues s)\<rbrace>"
-  and     prqL1: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueuesL1Bitmap s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueuesL1Bitmap s)\<rbrace>"
-  and     prqL2: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueuesL2Bitmap s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueuesL2Bitmap s)\<rbrace>"
-  shows   "\<lbrace>Invariants_H.valid_queues and Q\<rbrace> f \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  proof -
-    have tat:  "\<And>d p tcb. \<lbrace>obj_at' (inQ d p) tcb and st_tcb_at' runnable' tcb and Q\<rbrace> f
-                         \<lbrace>\<lambda>_. obj_at' (inQ d p) tcb and st_tcb_at' runnable' tcb\<rbrace>"
-      apply (rule hoare_chain [OF hoare_vcg_conj_lift [OF tat1 tat2]])
-       apply (fastforce)+
-       done
-    have tat_combined: "\<And>d p tcb. \<lbrace>obj_at' (inQ d p and runnable' \<circ> tcbState) tcb and Q\<rbrace> f
-                         \<lbrace>\<lambda>_. obj_at' (inQ d p and runnable' \<circ> tcbState) tcb\<rbrace>"
-      apply (rule hoare_chain [OF tat])
-       apply (fastforce simp add: obj_at'_and pred_tcb_at'_def o_def)+
-      done
-    show ?thesis unfolding valid_queues_def valid_queues_no_bitmap_def
-      by (wp tat_combined prq prqL1 prqL2 valid_bitmapQ_lift bitmapQ_no_L2_orphans_lift
-             bitmapQ_no_L1_orphans_lift hoare_vcg_all_lift hoare_vcg_conj_lift hoare_Ball_helper)
-         simp_all
-  qed
-
-lemmas valid_queues_lift = valid_queues_lift_asm[where Q="\<lambda>_. True", simplified]
-
-lemma valid_queues_lift':
-  assumes tat: "\<And>d p tcb. \<lbrace>\<lambda>s. \<not> obj_at' (inQ d p) tcb s\<rbrace> f \<lbrace>\<lambda>_ s. \<not> obj_at' (inQ d p) tcb s\<rbrace>"
-  and     prq: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueues s)\<rbrace>"
-  shows   "\<lbrace>valid_queues'\<rbrace> f \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  unfolding valid_queues'_def imp_conv_disj
-  by (wp hoare_vcg_all_lift hoare_vcg_disj_lift tat prq)
-
-lemma setCTE_norq [wp]:
-  "\<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace> setCTE ptr cte \<lbrace>\<lambda>r s. P (ksReadyQueues s) \<rbrace>"
-  by (clarsimp simp: valid_def dest!: setCTE_pspace_only)
-
 lemma setCTE_norqL1 [wp]:
   "\<lbrace>\<lambda>s. P (ksReadyQueuesL1Bitmap s)\<rbrace> setCTE ptr cte \<lbrace>\<lambda>r s. P (ksReadyQueuesL1Bitmap s) \<rbrace>"
   by (clarsimp simp: valid_def dest!: setCTE_pspace_only)
@@ -2795,12 +2758,6 @@ lemma setCTE_inQ[wp]:
    apply (simp_all add: inQ_def)
   done
 
-lemma setCTE_valid_queues'[wp]:
-  "\<lbrace>valid_queues'\<rbrace> setCTE p cte \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (simp only: valid_queues'_def imp_conv_disj)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-  done
-
 crunch inQ[wp]: cteInsert "\<lambda>s. P (obj_at' (inQ d p) t s)"
   (wp: crunch_wps)
 
@@ -3317,6 +3274,13 @@ lemma cteInsert_untyped_ranges_zero[wp]:
   apply blast
   done
 
+crunches cteInsert
+  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
   (\<lambda>s. src \<noteq> dest) and (\<lambda>s. cte_wp_at' (is_derived' (ctes_of s) src cap \<circ> cteCap) src s)
@@ -3325,20 +3289,9 @@ lemma cteInsert_invs:
   cteInsert cap src dest
   \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (simp add: invs'_def valid_state'_def valid_pspace'_def)
-  (* FIXME: wp_cleanup
-  apply (wp cur_tcb_lift tcb_in_cur_domain'_lift sch_act_wf_lift
-            valid_irq_node_lift valid_queues_lift' irqs_masked_lift
-            cteInsert_norq | simp add: st_tcb_at'_def)+
-  apply (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' irqs_masked_lift
-            cteInsert_norq | simp add: pred_tcb_at'_def)+
-  apply (auto simp: invs'_def valid_state'_def valid_pspace'_def
-                    cte_wp_at_ctes_of
-    elim: valid_capAligned is_derived_badge_derived')
-  *)
-  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' irqs_masked_lift cteInsert_norq
-              simp: st_tcb_at'_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
 
@@ -3646,10 +3599,13 @@ lemma corres_caps_decomposition:
              "\<And>P. \<lbrace>\<lambda>s. P (new_ups' s)\<rbrace> g \<lbrace>\<lambda>rv s. P (gsUserPages s)\<rbrace>"
              "\<And>P. \<lbrace>\<lambda>s. P (new_cns s)\<rbrace> f \<lbrace>\<lambda>rv s. P (cns_of_heap (kheap s))\<rbrace>"
              "\<And>P. \<lbrace>\<lambda>s. P (new_cns' s)\<rbrace> g \<lbrace>\<lambda>rv s. P (gsCNodes s)\<rbrace>"
-             "\<And>P. \<lbrace>\<lambda>s. P (new_queues s)\<rbrace> f \<lbrace>\<lambda>rv s. P (ready_queues s)\<rbrace>"
+             "\<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_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>"
@@ -3665,7 +3621,9 @@ lemma corres_caps_decomposition:
              "\<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 (new_queues s) (new_rqs' s')"
+                       \<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>
@@ -3732,7 +3690,7 @@ proof -
     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 u abs_irq_together)+
+     apply (wpsimp 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 pspace_relations_def swp_cte_at))+
     done
@@ -4223,6 +4181,9 @@ crunches setupReplyMaster
   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]:
@@ -4251,7 +4212,8 @@ lemma setupReplyMaster_invs'[wp]:
   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 valid_queues_lift' hoare_vcg_disj_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
@@ -4512,8 +4474,8 @@ lemma arch_update_setCTE_invs:
   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
+             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)
@@ -5883,7 +5845,7 @@ lemma cteInsert_simple_invs:
   apply (rule hoare_pre)
    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' irqs_masked_lift
+             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
@@ -6022,6 +5984,21 @@ lemma arch_update_updateCap_invs:
   apply clarsimp
   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
@@ -6053,6 +6030,8 @@ lemma updateCap_same_master:
         apply 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
@@ -6279,8 +6258,9 @@ lemma updateFreeIndex_forward_invs':
        apply (simp add:updateCap_def)
        apply (wp setCTE_irq_handlers' getCTE_wp)
       apply (simp add:updateCap_def)
-      apply (wp irqs_masked_lift valid_queues_lift' cur_tcb_lift ct_idle_or_in_cur_domain'_lift
+      apply (wp irqs_masked_lift cur_tcb_lift ct_idle_or_in_cur_domain'_lift
                 hoare_vcg_disj_lift untyped_ranges_zero_lift getCTE_wp
+                sym_heap_sched_pointers_lift valid_bitmaps_lift
                | wp (once) hoare_use_eq[where f="gsUntypedZeroRanges"]
                | simp add: getSlotCap_def)+
   apply (clarsimp simp: cte_wp_at_ctes_of fun_upd_def[symmetric])
diff --git a/proof/refine/ARM_HYP/Detype_R.thy b/proof/refine/ARM_HYP/Detype_R.thy
index 3e7c738bc2..ae8efc27c8 100644
--- a/proof/refine/ARM_HYP/Detype_R.thy
+++ b/proof/refine/ARM_HYP/Detype_R.thy
@@ -608,8 +608,9 @@ context delete_locale begin interpretation Arch . (*FIXME: arch_split*)
 lemma valid_objs: "valid_objs' s'"
   and        pa: "pspace_aligned' s'"
   and        pd: "pspace_distinct' s'"
-  and        vq: "valid_queues s'"
-  and       vq': "valid_queues' s'"
+  and       vbm: "valid_bitmaps s'"
+  and sym_sched: "sym_heap_sched_pointers s'"
+  and       vsp: "valid_sched_pointers s'"
   and  sym_refs: "sym_refs (state_refs_of' s')"
   and  sym_hyp_refs: "sym_refs (state_hyp_refs_of' s')"
   and    iflive: "if_live_then_nonz_cap' s'"
@@ -844,7 +845,6 @@ lemma sym_refs_TCB_hyp_live':
   apply (simp add: ko_wp_at'_def)
   apply (clarsimp simp: hyp_refs_of_rev' hyp_live'_def arch_live'_def)
   done
-
 end
 
 context begin interpretation Arch . (*FIXME: arch_split*)
@@ -933,6 +933,73 @@ crunches doMachineOp
   for deletionIsSafe_delete_locale[wp]: "deletionIsSafe_delete_locale base magnitude"
   (simp: deletionIsSafe_delete_locale_def)
 
+lemma detype_tcbSchedNexts_of:
+  "\<lbrakk>pspace_aligned' s'; pspace_distinct' 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) |> tcb_of' |> tcbSchedNext)
+       = tcbSchedNexts_of s'"
+  supply projectKOs[simp]
+  using pspace_alignedD' pspace_distinctD'
+  apply (clarsimp simp: opt_map_def)
+  apply (rule ext)
+  apply (rename_tac s)
+  apply (clarsimp simp: ko_wp_at'_def live'_def split: option.splits)
+  apply (drule_tac x=s in spec)
+  apply force
+  done
+
+lemma detype_tcbSchedPrevs_of:
+  "\<lbrakk>pspace_aligned' s'; pspace_distinct' 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) |> tcb_of' |> tcbSchedPrev)
+       = tcbSchedPrevs_of s'"
+  supply projectKOs[simp]
+  using pspace_alignedD' pspace_distinctD'
+  using pspace_alignedD' pspace_distinctD'
+  apply (clarsimp simp: opt_map_def)
+  apply (rule ext)
+  apply (rename_tac s)
+  apply (clarsimp simp: ko_wp_at'_def live'_def split: option.splits)
+  apply (drule_tac x=s in spec)
+  apply force
+  done
+
+lemma detype_inQ:
+  "\<lbrakk>pspace_aligned' s'; pspace_distinct' s'; \<forall>p. p \<in> S \<longrightarrow> \<not> ko_wp_at' live' p s'\<rbrakk>
+   \<Longrightarrow> \<forall>d p. (inQ d p |< ((\<lambda>x. if x \<in> S then None else ksPSpace s' x) |> tcb_of'))
+             = (inQ d p |< tcbs_of' s')"
+  supply projectKOs[simp]
+  using pspace_alignedD' pspace_distinctD'
+  using pspace_alignedD' pspace_distinctD'
+  apply (clarsimp simp: opt_map_def)
+  apply (rule ext)
+  apply (rename_tac s)
+  apply (clarsimp simp: inQ_def opt_pred_def ko_wp_at'_def live'_def split: option.splits)
+  apply (drule_tac x=s in spec)
+  apply force
+  done
+
+lemma detype_ready_queues_relation:
+  "\<lbrakk>pspace_aligned' s'; pspace_distinct' s';
+    \<forall>p. p \<in> {lower..upper} \<longrightarrow> \<not> ko_wp_at' live' p s';
+    ready_queues_relation s s'; upper = upper'\<rbrakk>
+   \<Longrightarrow> ready_queues_relation_2
+        (ready_queues (detype {lower..upper'} s))
+        (ksReadyQueues s')
+        ((\<lambda>x. if lower \<le> x \<and> x \<le> upper then None
+              else ksPSpace s' x) |>
+         tcb_of' |>
+         tcbSchedNext)
+        ((\<lambda>x. if lower \<le> x \<and> x \<le> upper then None
+              else ksPSpace s' x) |>
+         tcb_of' |>
+         tcbSchedPrev)
+        (\<lambda>d p. inQ d p |< ((\<lambda>x. if lower \<le> x \<and> x \<le> upper then None else ksPSpace s' x) |> tcb_of'))"
+  apply (clarsimp simp: detype_ext_def ready_queues_relation_def Let_def)
+  apply (frule (1) detype_tcbSchedNexts_of[where S="{lower..upper}"]; simp)
+  apply (frule (1) detype_tcbSchedPrevs_of[where S="{lower..upper}"]; simp)
+  apply (frule (1) detype_inQ[where S="{lower..upper}"]; simp)
+  apply (fastforce simp add: detype_def detype_ext_def wrap_ext_det_ext_ext_def)
+  done
+
 lemma deleteObjects_corres:
   "is_aligned base magnitude \<Longrightarrow> magnitude \<ge> 2 \<Longrightarrow>
    corres dc
@@ -953,20 +1020,19 @@ lemma deleteObjects_corres:
   apply (rule corres_stateAssert_implied[where P'=\<top>, simplified])
    prefer 2
    apply clarsimp
-   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 p_assoc_help invs_valid_pspace)[1]
-   apply (simp add:valid_cap_simps)
+   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 (fastforce simp: sch_act_simple_def schact_is_rct_def state_relation_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: valid_cap_simps)
   apply (simp add: bind_assoc[symmetric])
   apply (rule corres_stateAssert_implied2)
      defer
@@ -992,7 +1058,8 @@ lemma deleteObjects_corres:
            untyped_children_in_mdb s \<and> if_unsafe_then_cap s \<and>
            valid_global_refs s" and
          Q'="\<lambda>_ s. s \<turnstile>' capability.UntypedCap d base magnitude idx \<and>
-                        valid_pspace' s" in corres_underlying_split)
+                        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])
        apply (rule corres_split[OF _ cNodeNoPartialOverlap])
@@ -1005,33 +1072,36 @@ lemma deleteObjects_corres:
     apply (simp add: valid_pspace'_def)
     apply (rule state_relation_null_filterE, assumption,
            simp_all add: pspace_aligned'_cut pspace_distinct'_cut)[1]
-           apply (simp add: detype_def, rule state.equality; simp add: detype_ext_def)
-          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 add: null_filter'_def
+                            map_to_ctes_delete[simplified field_simps])
          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 (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 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 (fastforce simp add: detype_def detype_ext_def intro!: ekheap_relation_detype)
+        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 (erule state_relation_ready_queues_relation)
      apply (clarsimp simp: state_relation_def ghost_relation_of_heap
                            detype_def)
      apply (drule_tac t="gsUserPages s'" in sym)
@@ -1044,13 +1114,31 @@ lemma deleteObjects_corres:
                     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':
+  "ko_wp_at' live' p s' \<or> p = idle_thread_ptr \<Longrightarrow> p \<notin> base_bits"
+  apply (case_tac "ko_wp_at' live' 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 invs_valid_idle'[OF invs])
+  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 mask_eq_exp_minus_1)
+  by fastforce
+
+lemma untyped_range_live_idle':
+  "p \<in> base_bits \<Longrightarrow> \<not> (ko_wp_at' live' p s' \<or> p = idle_thread_ptr)"
+  using live_idle_untyped_range' by blast
+
 lemma valid_obj':
-  "\<lbrakk> valid_obj' obj s'; ko_wp_at' ((=) obj) p s' \<rbrakk> \<Longrightarrow> valid_obj' obj state'"
+  "\<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 (rename_tac endpoint)
       apply (case_tac endpoint, simp_all add: valid_ep'_def)[1]
@@ -1077,11 +1165,23 @@ lemma valid_obj':
      apply (erule(2) cte_wp_at_tcbI')
       apply fastforce
      apply simp
-    apply (rename_tac tcb)
-    apply (simp only: conj_assoc[symmetric], rule conjI)
-     apply (case_tac "tcbState tcb";
-            clarsimp simp: valid_tcb_state'_def valid_bound_ntfn'_def
-                     dest!: refs_notRange split: option.splits)
+    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 live'_def)
+     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 live'_def)
     using sym_hyp_refs
     apply (clarsimp simp add: valid_arch_tcb'_def split: option.split_asm)
     apply (drule (1) sym_refs_TCB_hyp_live'[rotated])
@@ -1111,6 +1211,40 @@ lemma valid_obj':
   apply clarsimp
   done
 
+lemma tcbSchedNexts_of_pspace':
+  "\<lbrakk>pspace_aligned' s'; pspace_distinct' s'; pspace_distinct' state'\<rbrakk>
+   \<Longrightarrow> (pspace' |> tcb_of' |> tcbSchedNext) = tcbSchedNexts_of s'"
+  supply projectKOs[simp]
+  apply (rule ext)
+  apply (rename_tac p)
+  apply (case_tac "p \<in> base_bits")
+   apply (frule untyped_range_live_idle')
+   apply (clarsimp simp: opt_map_def)
+   apply (case_tac "ksPSpace s' p"; clarsimp)
+   apply (rename_tac obj)
+   apply (case_tac "tcb_of' obj"; clarsimp)
+   apply (clarsimp simp: ko_wp_at'_def obj_at'_def live'_def)
+   apply (fastforce simp: pspace_alignedD' pspace_distinctD')
+  apply (clarsimp simp: opt_map_def split: option.splits)
+  done
+
+lemma tcbSchedPrevs_of_pspace':
+  "\<lbrakk>pspace_aligned' s'; pspace_distinct' s'; pspace_distinct' state'\<rbrakk>
+   \<Longrightarrow> (pspace' |> tcb_of' |> tcbSchedPrev) = tcbSchedPrevs_of s'"
+  supply projectKOs[simp]
+  apply (rule ext)
+  apply (rename_tac p)
+  apply (case_tac "p \<in> base_bits")
+   apply (frule untyped_range_live_idle')
+   apply (clarsimp simp: opt_map_def)
+   apply (case_tac "ksPSpace s' p"; clarsimp)
+   apply (rename_tac obj)
+   apply (case_tac "tcb_of' obj"; clarsimp)
+   apply (clarsimp simp: ko_wp_at'_def obj_at'_def live'_def)
+   apply (fastforce simp: pspace_alignedD' pspace_distinctD')
+  apply (clarsimp simp: opt_map_def split: option.splits)
+  done
+
 lemma st_tcb:
   "\<And>P p. \<lbrakk> st_tcb_at' P p s'; \<not> P Inactive; \<not> P IdleThreadState \<rbrakk> \<Longrightarrow> st_tcb_at' P p state'"
   by (fastforce simp: pred_tcb_at'_def obj_at'_real_def  projectKOs live'_def hyp_live'_def
@@ -1318,17 +1452,18 @@ proof (simp add: invs'_def valid_state'_def valid_pspace'_def
   show "pspace_aligned' ?s" using pa
     by (simp add: pspace_aligned'_def dom_def)
 
-  show "pspace_distinct' ?s" using pd
+  show pspace_distinct'_state': "pspace_distinct' ?s" using pd
     by (clarsimp simp add: pspace_distinct'_def ps_clear_def
                            dom_if_None Diff_Int_distrib)
 
-  show "valid_objs' ?s" using valid_objs
+  show "valid_objs' ?s" using valid_objs sym_sched
     apply (clarsimp simp: valid_objs'_def ran_def)
     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
+     apply (frule pspace_alignedD'[OF _ pa])
+     apply (frule pspace_distinctD'[OF _ pd])
+     apply (clarsimp simp: ko_wp_at'_def)
+    apply fastforce
     done
 
   from sym_refs show "sym_refs (state_refs_of' ?s)"
@@ -1349,19 +1484,6 @@ proof (simp add: invs'_def valid_state'_def valid_pspace'_def
     apply (simp add: hyp_refs_notRange[simplified] state_hyp_refs_ko_wp_at_eq)
     done
 
-  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 live'_def)
-    apply (clarsimp dest!: ex_nonz_cap_notRange)
-    done
-
-  from vq' show "valid_queues' ?s"
-    by (simp add: valid_queues'_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)
@@ -1612,6 +1734,20 @@ proof (simp add: invs'_def valid_state'_def valid_pspace'_def
     apply simp
     done
 
+  from vbm
+  show "valid_bitmaps state'"
+    by (simp add: valid_bitmaps_def bitmapQ_defs)
+
+  from sym_sched
+  show "sym_heap (pspace' |> tcb_of' |> tcbSchedNext) (pspace' |> tcb_of' |> tcbSchedPrev)"
+    using pa pd pspace_distinct'_state'
+    by (fastforce simp: tcbSchedNexts_of_pspace' tcbSchedPrevs_of_pspace')
+
+  from vsp show "valid_sched_pointers_2 (pspace' |> tcb_of' |> tcbSchedPrev)
+                                        (pspace' |> tcb_of' |> tcbSchedNext)
+                                        (tcbQueued |< (pspace' |> tcb_of'))"
+    by (clarsimp simp: valid_sched_pointers_def opt_pred_def opt_map_def)
+
 qed (clarsimp)
 
 lemma (in delete_locale) delete_ko_wp_at':
@@ -4692,7 +4828,6 @@ lemma createTCBs_tcb_at':
     apply simp
    apply simp
   apply (clarsimp simp: retype_obj_at_disj')
-  apply (clarsimp simp: projectKO_opt_tcb)
   apply (clarsimp simp: new_cap_addrs_def image_def)
   apply (drule_tac x = "unat x" in bspec)
    apply (simp add:objBits_simps' shiftl_t2n)
diff --git a/proof/refine/ARM_HYP/Finalise_R.thy b/proof/refine/ARM_HYP/Finalise_R.thy
index 877efd9b00..5cb7aa4f61 100644
--- a/proof/refine/ARM_HYP/Finalise_R.thy
+++ b/proof/refine/ARM_HYP/Finalise_R.thy
@@ -76,20 +76,10 @@ crunch ksRQL1[wp]: emptySlot "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
 crunch ksRQL2[wp]: emptySlot "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
 crunch obj_at'[wp]: postCapDeletion "obj_at' P p"
 
-lemmas postCapDeletion_valid_queues[wp] =
-    valid_queues_lift [OF postCapDeletion_obj_at'
-                          postCapDeletion_pred_tcb_at'
-                          postCapDeletion_ksRQ]
-
 crunch inQ[wp]: clearUntypedFreeIndex "\<lambda>s. P (obj_at' (inQ d p) t s)"
 crunch tcbDomain[wp]: clearUntypedFreeIndex "obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t"
 crunch tcbPriority[wp]: clearUntypedFreeIndex "obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t"
 
-lemma emptySlot_queues [wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> emptySlot sl opt \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  unfolding emptySlot_def
-  by (wp | wpcw | wp valid_queues_lift | simp)+
-
 crunch nosch[wp]: emptySlot "\<lambda>s. P (ksSchedulerAction s)"
 crunch ksCurDomain[wp]: emptySlot "\<lambda>s. P (ksCurDomain s)"
 
@@ -1166,8 +1156,7 @@ definition
  "removeable' sl \<equiv> \<lambda>s cap.
     (\<exists>p. p \<noteq> sl \<and> cte_wp_at' (\<lambda>cte. capMasterCap (cteCap cte) = capMasterCap cap) p s)
     \<or> ((\<forall>p \<in> cte_refs' cap (irq_node' s). p \<noteq> sl \<longrightarrow> cte_wp_at' (\<lambda>cte. cteCap cte = NullCap) p s)
-         \<and> (\<forall>p \<in> zobj_refs' cap. ko_wp_at' (Not \<circ> live') p s)
-         \<and> (\<forall>t \<in> threadCapRefs cap. \<forall>p. t \<notin> set (ksReadyQueues s p)))"
+         \<and> (\<forall>p \<in> zobj_refs' cap. ko_wp_at' (Not \<circ> live') p s))"
 
 lemma not_Final_removeable:
   "\<not> isFinal cap sl (cteCaps_of s)
@@ -1358,11 +1347,6 @@ crunch irq_states' [wp]: emptySlot valid_irq_states'
 crunch no_0_obj' [wp]: emptySlot no_0_obj'
  (wp: crunch_wps)
 
-crunch valid_queues'[wp]: setInterruptState "valid_queues'"
-  (simp: valid_queues'_def)
-
-crunch valid_queues'[wp]: emptySlot "valid_queues'"
-
 crunch pde_mappings'[wp]: emptySlot "valid_pde_mappings'"
 end
 
@@ -1452,6 +1436,13 @@ lemma emptySlot_untyped_ranges[wp]:
 crunch valid_arch'[wp]: emptySlot valid_arch_state'
   (wp: crunch_wps)
 
+crunches emptySlot
+  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>
@@ -2242,6 +2233,14 @@ lemma ntfn_q_refs_of'_mult:
   "ntfn_q_refs_of' ntfn = (case ntfn of Structures_H.WaitingNtfn q \<Rightarrow> set q | _ \<Rightarrow> {}) \<times> {NTFNSignal}"
   by (cases ntfn, simp_all)
 
+crunches 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]:
   "\<lbrace>invs'\<rbrace> unbindNotification tcb \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (simp add: unbindNotification_def invs'_def valid_state'_def)
@@ -2250,8 +2249,8 @@ lemma unbindNotification_invs[wp]:
   apply clarsimp
   apply (rule hoare_seq_ext[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
+  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 (clarsimp elim!: obj_atE'
@@ -2293,7 +2292,7 @@ lemma unbindMaybeNotification_invs[wp]:
   apply (simp add: unbindMaybeNotification_def invs'_def valid_state'_def)
   apply (rule hoare_seq_ext[OF _ get_ntfn_sp'])
   apply (rule hoare_pre)
-   apply (wp sbn'_valid_pspace'_inv sbn_sch_act' sbn_valid_queues valid_irq_node_lift
+   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)+
@@ -2563,14 +2562,6 @@ lemma archThreadSet_valid_arch_state'[wp]:
   apply (clarsimp simp: pred_conj_def)
   done
 
-lemma archThreadSet_valid_queues'[wp]:
-  "archThreadSet f t \<lbrace>valid_queues'\<rbrace>"
-  unfolding valid_queues'_def
-  apply (rule hoare_lift_Pf[where f=ksReadyQueues]; wp?)
-  apply (wp hoare_vcg_all_lift hoare_vcg_imp_lift)
-  apply auto
-  done
-
 lemma archThreadSet_ct_not_inQ[wp]:
   "archThreadSet f t \<lbrace>ct_not_inQ\<rbrace>"
   unfolding ct_not_inQ_def
@@ -2600,6 +2591,54 @@ lemma archThreadSet_tcb_at'[wp]:
   unfolding archThreadSet_def
   by (wpsimp wp: getObject_tcb_wp simp: obj_at'_def)
 
+lemma setObject_tcb_tcbs_of'[wp]:
+  "\<lbrace>\<lambda>s. P ((tcbs_of' s) (t \<mapsto> tcb))\<rbrace>
+   setObject t tcb
+   \<lbrace>\<lambda>_ s. P (tcbs_of' s)\<rbrace>"
+  unfolding setObject_def
+  apply (wpsimp simp: updateObject_default_def)
+  apply (erule rsubst[where P=P])
+  apply (rule ext)
+  apply (clarsimp simp: opt_map_def split: option.splits)
+  done
+
+lemma archThreadSet_tcbSchedPrevs_of[wp]:
+  "archThreadSet f t \<lbrace>\<lambda>s. P (tcbSchedPrevs_of s)\<rbrace>"
+  supply projectKOs[simp]
+  unfolding archThreadSet_def
+  apply (wp getObject_tcb_wp)
+  apply normalise_obj_at'
+  apply (erule rsubst[where P=P])
+  apply (rule ext)
+  apply (clarsimp simp: opt_map_def obj_at'_def split: option.splits)
+  done
+
+lemma archThreadSet_tcbSchedNexts_of[wp]:
+  "archThreadSet f t \<lbrace>\<lambda>s. P (tcbSchedNexts_of s)\<rbrace>"
+  supply projectKOs[simp]
+  unfolding archThreadSet_def
+  apply (wp getObject_tcb_wp)
+  apply normalise_obj_at'
+  apply (erule rsubst[where P=P])
+  apply (rule ext)
+  apply (clarsimp simp: opt_map_def obj_at'_def split: option.splits)
+  done
+
+lemma archThreadSet_tcbQueued[wp]:
+  "archThreadSet f t \<lbrace>\<lambda>s. P (tcbQueued |< tcbs_of' s)\<rbrace>"
+  supply projectKOs[simp]
+  unfolding archThreadSet_def
+  apply (wp getObject_tcb_wp)
+  apply normalise_obj_at'
+  apply (erule rsubst[where P=P])
+  apply (rule ext)
+  apply (clarsimp simp: opt_pred_def opt_map_def obj_at'_def split: option.splits)
+  done
+
+lemma archThreadSet_valid_sched_pointers[wp]:
+  "archThreadSet f t \<lbrace>valid_sched_pointers\<rbrace>"
+  by (wp_pre, wps, wp, assumption)
+
 lemma dissoc_invs':
   "\<lbrace>invs' and (\<lambda>s. \<forall>p. (\<exists>a. armHSCurVCPU (ksArchState s) = Some (p, a)) \<longrightarrow> p \<noteq> v) and
     ko_at' vcpu v and K (vcpuTCBPtr vcpu = Some t) and
@@ -2618,7 +2657,8 @@ lemma dissoc_invs':
                     cteCaps_of_ctes_of_lift irqs_masked_lift ct_idle_or_in_cur_domain'_lift
                     valid_irq_states_lift' hoare_vcg_all_lift hoare_vcg_disj_lift
                     valid_pde_mappings_lift' setObject_typ_at' cur_tcb_lift
-                    setVCPU_valid_arch' archThreadSet_if_live'
+                    setVCPU_valid_arch' archThreadSet_if_live' valid_bitmaps_lift
+                    sym_heap_sched_pointers_lift
               simp: objBits_simps archObjSize_def vcpu_bits_def pageBits_def
                     state_refs_of'_vcpu_empty state_hyp_refs_of'_vcpu_absorb valid_arch_tcb'_def
         | clarsimp simp: live'_def hyp_live'_def arch_live'_def)+
@@ -2665,7 +2705,7 @@ lemma when_assert_eq:
 lemma dissociateVCPUTCB_invs'[wp]:
   "dissociateVCPUTCB vcpu tcb \<lbrace>invs'\<rbrace>"
   unfolding dissociateVCPUTCB_def setVCPU_archThreadSet_None_eq when_assert_eq
-  apply ( wpsimp wp: dissoc_invs' getVCPU_wp | wpsimp wp: getObject_tcb_wp simp: archThreadGet_def)+
+  apply (wpsimp wp: dissoc_invs' getVCPU_wp | wpsimp wp: getObject_tcb_wp simp: archThreadGet_def)+
   apply (drule tcb_ko_at')
   apply clarsimp
   apply (rule exI, rule conjI, assumption)
@@ -2714,7 +2754,6 @@ lemma asUser_unlive[wp]:
   apply (rename_tac tcb)
   apply (rule_tac x=tcb in exI)
   apply (clarsimp simp: obj_at'_def projectKOs)
-  apply (rule_tac x=tcb in exI, rule conjI; clarsimp simp: o_def)
   apply (clarsimp simp: ko_wp_at'_def live'_def hyp_live'_def)
   done
 
@@ -2807,7 +2846,6 @@ lemma cteDeleteOne_isFinal:
 
 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 setQueue_cteCaps_of[wp] = ctes_of_cteCaps_of_lift [OF setQueue_ctes_of]
 lemmas threadSet_cteCaps_of = ctes_of_cteCaps_of_lift [OF threadSet_ctes_of]
 
 crunch isFinal: setSchedulerAction "\<lambda>s. isFinal cap slot (cteCaps_of s)"
@@ -2904,18 +2942,6 @@ lemma unbindNotification_valid_objs'_helper':
   by (clarsimp simp: valid_bound_tcb'_def valid_ntfn'_def
                   split: option.splits ntfn.splits)
 
-lemma typ_at'_valid_tcb'_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_tcb' tcb s\<rbrace> f \<lbrace>\<lambda>rv s. valid_tcb' tcb s\<rbrace>"
-  including no_pre
-  apply (simp add: valid_tcb'_def valid_arch_tcb'_def)
-  apply (case_tac  "atcbVCPUPtr (tcbArch tcb)";
-         case_tac "tcbState tcb";
-         case_tac "tcbBoundNotification tcb")
-  apply (simp add: valid_tcb_state'_def split_def valid_bound_ntfn'_def
-        | wp hoare_vcg_const_Ball_lift typ_at_lifts[OF P] P)+
-  done
-
 lemmas setNotification_valid_tcb' = typ_at'_valid_tcb'_lift [OF setNotification_typ_at']
 
 lemma unbindNotification_valid_objs'[wp]:
@@ -3068,10 +3094,6 @@ lemma unbindNotification_bound_tcb_at':
   apply (wp setBoundNotification_bound_tcb gbn_wp' | wpc | simp)+
   done
 
-crunches unbindNotification, unbindMaybeNotification
-  for valid_queues[wp]: "Invariants_H.valid_queues"
-  (wp: sbn_valid_queues)
-
 crunches unbindNotification, unbindMaybeNotification
   for weak_sch_act_wf[wp]: "\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s"
 
@@ -3145,6 +3167,54 @@ lemma prepareThreadDelete_hyp_unlive[wp]:
 
 end
 
+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>"
+  supply projectKOs[simp]
+  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 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>"
+  supply projectKOs[simp]
+  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
+               split: option.splits)
+
+crunches updateRestartPC, cancelIPC
+  for valid_sched_pointers[wp]: valid_sched_pointers
+  (simp: crunch_simps wp: crunch_wps)
+
+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')
+
+context begin interpretation Arch . (*FIXME: arch_split*)
+
+lemma archThreadSet_tcbSchedPrevNext[wp]:
+  "archThreadSet f t' \<lbrace>obj_at' (\<lambda>tcb. P (tcbSchedNext tcb) (tcbSchedPrev tcb)) t\<rbrace>"
+  unfolding archThreadSet_def
+  apply (wpsimp wp: setObject_tcb_strongest getObject_tcb_wp)
+  apply normalise_obj_at'
+  apply auto
+  done
+
+crunches prepareThreadDelete
+  for tcbSchedPrevNext[wp]: "obj_at' (\<lambda>tcb. P (tcbSchedNext tcb) (tcbSchedPrev tcb)) t"
+  (wp: threadGet_wp getVCPU_wp archThreadGet_wp crunch_wps simp: crunch_simps)
+
+end
+
 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)))
@@ -3165,21 +3235,22 @@ lemma (in delete_one_conc_pre) finaliseCap_replaceable:
                      \<and> obj_at' (Not \<circ> tcbQueued) p s
                      \<and> bound_tcb_at' ((=) None) p s
                      \<and> ko_wp_at' (Not \<circ> hyp_live') p s
-                     \<and> (\<forall>pr. p \<notin> set (ksReadyQueues s pr))))\<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 (wp prepares_delete_helper'' [OF cancelAllIPC_unlive]
              prepares_delete_helper'' [OF cancelAllSignals_unlive]
-             suspend_isFinal prepareThreadDelete_unqueued prepareThreadDelete_nonq
+             suspend_isFinal prepareThreadDelete_unqueued
              prepareThreadDelete_inactive prepareThreadDelete_isFinal
-             suspend_makes_inactive suspend_nonq
+             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]],
@@ -3187,24 +3258,12 @@ lemma (in delete_one_conc_pre) finaliseCap_replaceable:
            | wpc)+
   apply clarsimp
   apply (frule cte_wp_at_valid_objs_valid_cap', clarsimp+)
-  apply (rule conjI)
-   apply (case_tac "cteCap cte",
+  apply (case_tac "cteCap cte",
          simp_all add: isCap_simps capRange_def
                        final_matters'_def objBits_simps
                        not_Final_removeable finaliseCap_def,
          simp_all add: removeable'_def)[1]
-     (* 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)+)[2]
-  apply (rule impI)
-  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)
+   apply fastforce+
   done
 
 lemma cteDeleteOne_cte_wp_at_preserved:
@@ -3253,7 +3312,9 @@ lemma cancelIPC_cte_wp_at':
   apply (clarsimp simp: cteCaps_of_def cte_wp_at_ctes_of x)
   done
 
-crunch cte_wp_at'[wp]: tcbSchedDequeue "cte_wp_at' P p"
+crunches tcbSchedDequeue
+  for cte_wp_at'[wp]: "cte_wp_at' P p"
+  (wp: crunch_wps)
 
 lemma suspend_cte_wp_at':
   assumes x: "\<And>cap final. P cap \<Longrightarrow> finaliseCap cap final True = fail"
@@ -3381,25 +3442,6 @@ crunch sch_act_not[wp]: cteDeleteOne "sch_act_not t"
   (simp: crunch_simps case_Null_If unless_def
    wp: crunch_wps getObject_inv loadObject_default_inv)
 
-lemma cancelAllIPC_mapM_x_valid_queues:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. \<forall>t\<in>set q. tcb_at' t s)\<rbrace>
-   mapM_x (\<lambda>t. do
-                 y \<leftarrow> setThreadState Structures_H.thread_state.Restart t;
-                 tcbSchedEnqueue t
-               od) q
-   \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (rule_tac R="\<lambda>_ s. (\<forall>t\<in>set q. tcb_at' t s) \<and> valid_objs' s"
-               in hoare_post_add)
-  apply (rule hoare_pre)
-  apply (rule mapM_x_wp')
-  apply (rule hoare_name_pre_state)
-  apply (wp hoare_vcg_const_Ball_lift
-            tcbSchedEnqueue_valid_queues tcbSchedEnqueue_not_st
-            sts_valid_queues sts_st_tcb_at'_cases setThreadState_not_st
-       | simp
-       | ((elim conjE)?, drule (1) bspec, clarsimp elim!: obj_at'_weakenE simp: valid_tcb_state'_def))+
-  done
-
 lemma cancelAllIPC_mapM_x_weak_sch_act:
   "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
    mapM_x (\<lambda>t. do
@@ -3413,13 +3455,15 @@ lemma cancelAllIPC_mapM_x_weak_sch_act:
   done
 
 lemma cancelAllIPC_mapM_x_valid_objs':
-  "\<lbrace>valid_objs'\<rbrace>
+  "\<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 (wpsimp wp: mapM_x_wp' sts_valid_objs')
+  apply (rule hoare_strengthen_post)
+   apply (rule mapM_x_wp')
+  apply (wpsimp wp: sts_valid_objs')
    apply (clarsimp simp: valid_tcb_state'_def)+
   done
 
@@ -3430,18 +3474,12 @@ lemma cancelAllIPC_mapM_x_tcbDomain_obj_at':
                  tcbSchedEnqueue t
                od) q
   \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
-apply (wp mapM_x_wp' tcbSchedEnqueue_not_st setThreadState_oa_queued | simp)+
-done
+  by (wpsimp wp: mapM_x_wp')
 
 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)
-apply (wp tcbSchedEnqueue_not_st
-     | wpc
-     | simp)+
-done
+  "rescheduleRequired \<lbrace>obj_at' (\<lambda>tcb. Q (tcbDomain tcb) (tcbPriority tcb)) t\<rbrace>"
+  unfolding rescheduleRequired_def tcbSchedEnqueue_def tcbQueuePrepend_def
+  by wpsimp
 
 lemma cancelAllIPC_tcbDomain_obj_at':
   "\<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>
@@ -3455,21 +3493,6 @@ apply (wp hoare_vcg_conj_lift hoare_vcg_const_Ball_lift
      | simp)+
 done
 
-lemma cancelAllIPC_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)\<rbrace>
-   cancelAllIPC ep_ptr
-   \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: cancelAllIPC_def ep'_Idle_case_helper)
-  apply (wp hoare_vcg_conj_lift hoare_vcg_const_Ball_lift
-            cancelAllIPC_mapM_x_valid_queues cancelAllIPC_mapM_x_valid_objs' cancelAllIPC_mapM_x_weak_sch_act
-            set_ep_valid_objs' getEndpoint_wp)
-  apply (clarsimp simp: valid_ep'_def)
-  apply (drule (1) ko_at_valid_objs')
-  apply (auto simp: valid_obj'_def valid_ep'_def valid_tcb'_def projectKOs
-             split: endpoint.splits
-              elim: valid_objs_valid_tcbE)
-  done
-
 lemma cancelAllSignals_tcbDomain_obj_at':
   "\<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>
      cancelAllSignals epptr
@@ -3483,44 +3506,9 @@ apply (wp hoare_vcg_conj_lift hoare_vcg_const_Ball_lift
 done
 
 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>"
-  apply (simp add: unbindMaybeNotification_def)
-  apply (wp setBoundNotification_oa_queued getNotification_wp gbn_wp' | wpc | simp)+
-  done
-
-lemma cancelAllSignals_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)\<rbrace>
-   cancelAllSignals ntfn
-   \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: cancelAllSignals_def)
-  apply (rule hoare_seq_ext [OF _ get_ntfn_sp'])
-  apply (case_tac "ntfnObj ntfna", simp_all)
-    apply (wp, simp)+
-    apply (wp hoare_vcg_conj_lift hoare_vcg_const_Ball_lift
-              cancelAllIPC_mapM_x_valid_queues cancelAllIPC_mapM_x_valid_objs' cancelAllIPC_mapM_x_weak_sch_act
-              set_ntfn_valid_objs'
-          | simp)+
-  apply (clarsimp simp: valid_ep'_def)
-  apply (drule (1) ko_at_valid_objs')
-  apply (auto simp: valid_obj'_def valid_ntfn'_def valid_tcb'_def projectKOs
-             split: endpoint.splits
-              elim: valid_objs_valid_tcbE)
-  done
-
-lemma finaliseCapTrue_standin_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)\<rbrace>
-   finaliseCapTrue_standin cap final
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: finaliseCapTrue_standin_def Let_def)
-  apply (safe)
-       apply (wp | clarsimp | wpc)+
-  done
-
-
-crunch valid_queues[wp]: isFinalCapability "Invariants_H.valid_queues"
-  (simp: crunch_simps)
+  "unbindMaybeNotification r \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  unfolding unbindMaybeNotification_def
+  by (wpsimp wp: getNotification_wp gbn_wp' simp: setBoundNotification_def)+
 
 crunch sch_act[wp]: isFinalCapability "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
   (simp: crunch_simps)
@@ -3529,96 +3517,6 @@ crunch weak_sch_act[wp]:
   isFinalCapability "\<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. \<lbrace>obj_at' (inQ d p) tcb\<rbrace> f \<lbrace>\<lambda>_. obj_at' (inQ d p) tcb\<rbrace>"
-  and     prq: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueues s)\<rbrace>"
-  shows   "\<lbrace>valid_inQ_queues\<rbrace> f \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  proof -
-    show ?thesis
-      apply (clarsimp simp: valid_def valid_inQ_queues_def)
-      apply safe
-       apply (rule use_valid [OF _ tat], assumption)
-       apply (drule spec, drule spec, erule conjE, erule bspec)
-       apply (rule ccontr)
-       apply (erule notE[rotated], erule(1) use_valid [OF _ prq])
-      apply (erule use_valid [OF _ prq])
-      apply simp
-      done
-  qed
-
-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)+
-
-crunch valid_inQ_queues[wp]: emptySlot valid_inQ_queues
-  (simp: crunch_simps)
-
-lemma cancelAllIPC_mapM_x_valid_inQ_queues:
-  "\<lbrace>valid_inQ_queues\<rbrace>
-   mapM_x (\<lambda>t. do
-                 y \<leftarrow> setThreadState Structures_H.thread_state.Restart t;
-                 tcbSchedEnqueue t
-               od) q
-   \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (rule mapM_x_wp_inv)
-  apply (wp sts_valid_queues [where st="Structures_H.thread_state.Restart", simplified]
-            setThreadState_st_tcb)
-   done
-
-lemma cancelAllIPC_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace>
-   cancelAllIPC ep_ptr
-   \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (simp add: cancelAllIPC_def ep'_Idle_case_helper)
-  apply (wp cancelAllIPC_mapM_x_valid_inQ_queues)
-  apply (wp hoare_conjI hoare_drop_imp | simp)+
-  done
-
-lemma cancelAllSignals_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace>
-   cancelAllSignals ntfn
-   \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (simp add: cancelAllSignals_def)
-  apply (rule hoare_seq_ext [OF _ get_ntfn_sp'])
-  apply (case_tac "ntfnObj ntfna", simp_all)
-    apply (wp, simp)+
-    apply (wp cancelAllIPC_mapM_x_valid_inQ_queues)+
-   apply (simp)
-  done
-
-crunches unbindNotification, unbindMaybeNotification
-  for valid_inQ_queues[wp]: "valid_inQ_queues"
-
-lemma finaliseCapTrue_standin_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace>
-   finaliseCapTrue_standin cap final
-   \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  apply (simp add: finaliseCapTrue_standin_def Let_def)
-  apply (safe)
-       apply (wp | clarsimp | wpc)+
-  done
-
-crunch valid_inQ_queues[wp]: isFinalCapability valid_inQ_queues
-  (simp: crunch_simps)
-
-lemma cteDeleteOne_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<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)
-  done
-
 crunch ksCurDomain[wp]: cteDeleteOne "\<lambda>s. P (ksCurDomain s)"
   (wp: crunch_wps simp: crunch_simps unless_def)
 
@@ -3848,10 +3746,8 @@ lemma vcpuFinalise_corres [corres]:
    apply (frule sym_refs_vcpu_tcb)
      apply (simp add: vcpu_relation_def)
     apply fastforce
-   apply (clarsimp simp: obj_at_def vcpu_relation_def)
+   apply (fastforce simp: obj_at_def vcpu_relation_def)
   apply clarsimp
-  apply (drule ko_at_valid_objs', fastforce, simp add: projectKOs)
-  apply (clarsimp simp: valid_obj'_def valid_vcpu'_def typ_at_tcb')
   done
 
 lemma arch_finaliseCap_corres:
@@ -3908,6 +3804,9 @@ lemma unbindNotification_corres:
            apply (clarsimp simp: ntfn_relation_def split:Structures_A.ntfn.splits)
           apply (rule setBoundNotification_corres)
          apply (wp gbn_wp' gbn_wp)+
+   apply clarsimp
+   apply (frule invs_psp_aligned)
+   apply (frule invs_distinct)
    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
@@ -3934,6 +3833,9 @@ lemma unbindMaybeNotification_corres:
          apply (clarsimp simp: ntfn_relation_def split: Structures_A.ntfn.splits)
         apply (rule setBoundNotification_corres)
        apply (wp get_simple_ko_wp getNotification_wp)+
+   apply clarsimp
+   apply (frule invs_psp_aligned)
+   apply (frule invs_distinct)
    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
@@ -4105,12 +4007,6 @@ lemma arch_recycleCap_improve_cases:
          \<not> isASIDControlCap cap \<rbrakk> \<Longrightarrow> (if isASIDPoolCap cap then v else undefined) = v"
   by (cases cap, simp_all add: isCap_simps)
 
-crunch queues[wp]: copyGlobalMappings "Invariants_H.valid_queues"
-  (wp: crunch_wps ignore: storePDE)
-
-crunch queues'[wp]: copyGlobalMappings "Invariants_H.valid_queues'"
-  (wp: crunch_wps ignore: storePDE)
-
 crunch ifunsafe'[wp]: copyGlobalMappings "if_unsafe_then_cap'"
   (wp: crunch_wps ignore: storePDE)
 
@@ -4210,178 +4106,6 @@ lemma cteCaps_of_ctes_of_lift:
 
 lemmas final_matters'_simps = final_matters'_def [split_simps capability.split arch_capability.split]
 
-definition set_thread_all :: "obj_ref \<Rightarrow> Structures_A.tcb \<Rightarrow> etcb
-                                \<Rightarrow> unit det_ext_monad" where
-  "set_thread_all ptr tcb etcb \<equiv>
-     do s \<leftarrow> get;
-       kh \<leftarrow> return $ (kheap s)(ptr \<mapsto> (TCB tcb));
-       ekh \<leftarrow> return $ (ekheap s)(ptr \<mapsto> etcb);
-       put (s\<lparr>kheap := kh, ekheap := ekh\<rparr>)
-     od"
-
-definition thread_gets_the_all :: "obj_ref \<Rightarrow> (Structures_A.tcb \<times> etcb) det_ext_monad" where
-  "thread_gets_the_all tptr \<equiv>
-          do tcb \<leftarrow> gets_the $ get_tcb tptr;
-             etcb \<leftarrow> gets_the $ get_etcb tptr;
-             return $ (tcb, etcb) od"
-
-definition thread_set_all :: "(Structures_A.tcb \<Rightarrow> Structures_A.tcb) \<Rightarrow> (etcb \<Rightarrow> etcb)
-                  \<Rightarrow> obj_ref \<Rightarrow> unit det_ext_monad" where
-  "thread_set_all f g tptr \<equiv>
-     do (tcb, etcb) \<leftarrow> thread_gets_the_all tptr;
-        set_thread_all tptr (f tcb) (g etcb)
-     od"
-
-lemma set_thread_all_corres:
-  fixes ob' :: "'a :: pspace_storable"
-  assumes x: "updateObject ob' = updateObject_default ob'"
-  assumes z: "\<And>s. obj_at' P ptr s
-               \<Longrightarrow> map_to_ctes ((ksPSpace s) (ptr \<mapsto> injectKO ob')) = map_to_ctes (ksPSpace s)"
-  assumes b: "\<And>ko. P ko \<Longrightarrow> objBits ko = objBits ob'"
-  assumes P: "\<And>(v::'a::pspace_storable). (1 :: word32) < 2 ^ (objBits v)"
-  assumes e: "etcb_relation etcb tcb'"
-  assumes is_t: "injectKO (ob' :: 'a :: pspace_storable) = KOTCB tcb'"
-  shows      "other_obj_relation (TCB tcb) (injectKO (ob' :: 'a :: pspace_storable)) \<Longrightarrow>
-  corres dc (obj_at (same_caps (TCB tcb)) ptr and is_etcb_at ptr)
-            (obj_at' (P :: 'a \<Rightarrow> bool) ptr)
-            (set_thread_all ptr tcb etcb) (setObject ptr ob')"
-  apply (rule corres_no_failI)
-   apply (rule no_fail_pre)
-    apply wp
-    apply (rule x)
-   apply (clarsimp simp: b elim!: obj_at'_weakenE)
-  apply (unfold set_thread_all_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
-                        updateObject_default_def in_magnitude_check [OF _ P])
-  apply (clarsimp simp add: state_relation_def z)
-  apply (simp add: trans_state_update'[symmetric] trans_state_update[symmetric]
-         del: trans_state_update)
-  apply (clarsimp simp add: swp_def fun_upd_def obj_at_def is_etcb_at_def)
-  apply (subst cte_wp_at_after_update,fastforce simp add: obj_at_def)
-  apply (subst caps_of_state_after_update,fastforce simp add: obj_at_def)
-  apply clarsimp
-  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
-                   split: Structures_A.kernel_object.splits if_split_asm)
-
-  apply (fold fun_upd_def)
-  apply (simp only: pspace_relation_def dom_fun_upd2 simp_thms)
-  apply (subst pspace_dom_update)
-    apply assumption
-   apply simp
-  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: is_other_obj_relation_type)
-   apply (drule(1) bspec)
-   apply clarsimp
-   apply (frule_tac ko'="TCB tcb'" and x'=ptr in obj_relation_cut_same_type,
-           (fastforce simp add: is_other_obj_relation_type)+)[1]
-  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 (clarsimp simp: projectKOs)
-  apply (insert e is_t)
-  by (clarsimp simp: other_obj_relation_def etcb_relation_def is_other_obj_relation_type split: Structures_A.kernel_object.splits Structures_H.kernel_object.splits ARM_A.arch_kernel_obj.splits)
-
-lemma tcb_update_all_corres':
-  assumes tcbs: "tcb_relation tcb tcb' \<Longrightarrow> tcb_relation tcbu tcbu'"
-  assumes tables: "\<forall>(getF, v) \<in> ran tcb_cap_cases. getF tcbu = getF tcb"
-  assumes tables': "\<forall>(getF, v) \<in> ran tcb_cte_cases. getF tcbu' = getF tcb'"
-  assumes r: "r () ()"
-  assumes e: "etcb_relation etcb tcb' \<Longrightarrow> etcb_relation etcbu tcbu'"
-  shows "corres r (ko_at (TCB tcb) add and (\<lambda>s. ekheap s add = Some etcb))
-                  (ko_at' tcb' add)
-                  (set_thread_all add tcbu etcbu) (setObject add tcbu')"
-  apply (rule_tac F="tcb_relation tcb tcb' \<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 (force simp: projectKOs other_obj_relation_def ekheap_relation_def e)
-  apply (erule conjE)
-  apply (rule corres_guard_imp)
-    apply (rule corres_rel_imp)
-     apply (rule set_thread_all_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 simp: is_etcb_at_def 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 mask_def objBits_defs)
-  apply (subst if_not_P)
-   apply (fastforce dest: bspec [OF tables', OF ranI])
-  apply simp
-  done
-
-lemma thread_gets_the_all_corres:
-  shows      "corres (\<lambda>(tcb, etcb) tcb'. tcb_relation tcb tcb' \<and> etcb_relation etcb tcb')
-                (tcb_at t and is_etcb_at t) (tcb_at' t)
-                (thread_gets_the_all t) (getObject t)"
-  apply (rule corres_no_failI)
-   apply wp
-  apply (clarsimp simp add: gets_def get_def return_def bind_def get_tcb_def thread_gets_the_all_def threadGet_def ethread_get_def gets_the_def assert_opt_def get_etcb_def is_etcb_at_def tcb_at_def liftM_def split: option.splits Structures_A.kernel_object.splits)
-  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 ko)
-   apply (simp_all add: fail_def return_def)
-  apply (clarsimp simp add: state_relation_def pspace_relation_def ekheap_relation_def)
-  apply (drule bspec)
-   apply clarsimp
-   apply blast
-  apply (drule bspec, erule domI)
-  apply (clarsimp simp add: other_obj_relation_def
-                            lookupAround2_known1)
-  done
-
-lemma thread_set_all_corresT:
-  assumes x: "\<And>tcb tcb'. tcb_relation tcb tcb' \<Longrightarrow>
-                         tcb_relation (f tcb) (f' tcb')"
-  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"
-  assumes e: "\<And>etcb tcb'. etcb_relation etcb tcb' \<Longrightarrow>
-                         etcb_relation (g etcb) (f' tcb')"
-  shows      "corres dc (tcb_at t and valid_etcbs)
-                        (tcb_at' t)
-                    (thread_set_all f g t) (threadSet f' t)"
-  apply (simp add: thread_set_all_def threadSet_def bind_assoc)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF thread_gets_the_all_corres])
-      apply (simp add: split_def)
-      apply (rule tcb_update_all_corres')
-          apply (erule x)
-         apply (rule y)
-        apply (clarsimp simp: bspec_split [OF spec [OF z]])
-       apply fastforce
-      apply (erule e)
-     apply (simp add: thread_gets_the_all_def, wp+)
-   apply clarsimp
-   apply (frule(1) tcb_at_is_etcb_at)
-   apply (clarsimp simp add: tcb_at_def get_etcb_def obj_at_def)
-   apply (drule get_tcb_SomeD)
-   apply fastforce
-  apply simp
-  done
-
-lemmas thread_set_all_corres =
-    thread_set_all_corresT [OF _ _ all_tcbI, OF _ ball_tcb_cap_casesI ball_tcb_cte_casesI]
-
 crunch idle_thread[wp]: deleteCallerCap "\<lambda>s. P (ksIdleThread s)"
   (wp: crunch_wps)
 crunch sch_act_simple: deleteCallerCap sch_act_simple
@@ -4399,89 +4123,6 @@ lemma setEndpoint_sch_act_not_ct[wp]:
    setEndpoint ptr val \<lbrace>\<lambda>_ s. sch_act_not (ksCurThread s) s\<rbrace>"
   by (rule hoare_weaken_pre, wps setEndpoint_ct', wp, simp)
 
-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
-
-lemma cancelAllIPC_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>
-   cancelAllIPC epptr
-   \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  (is "\<lbrace>?PRE\<rbrace> _ \<lbrace>\<lambda>_. ?POST\<rbrace>")
-  apply (simp add: cancelAllIPC_def)
-  apply (wp, wpc, wp)
-        apply (wps rescheduleRequired_ct')
-        apply (wp rescheduleRequired_ksQ')
-       apply (clarsimp simp: forM_x_def)
-       apply (wp cancelAll_ct_not_ksQ_helper mapM_x_wp_inv)
-      apply (wp hoare_lift_Pf2 [OF setEndpoint_ksQ setEndpoint_ct'])+
-      apply (wps rescheduleRequired_ct')
-      apply (wp rescheduleRequired_ksQ')
-     apply (clarsimp simp: forM_x_def)
-     apply (wp cancelAll_ct_not_ksQ_helper mapM_x_wp_inv)
-    apply (wp hoare_lift_Pf2 [OF setEndpoint_ksQ setEndpoint_ct'])+
-   prefer 2
-   apply assumption
-  apply (rule_tac Q="\<lambda>ep. ?PRE and ko_at' ep epptr" in hoare_post_imp)
-   apply (clarsimp)
-   apply (rule conjI)
-    apply ((clarsimp simp: invs'_def valid_state'_def
-                           sch_act_sane_def
-            | drule(1) ct_not_in_epQueue)+)[2]
-  apply (wp get_ep_sp')
-  done
-
-lemma cancelAllSignals_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>
-   cancelAllSignals ntfnptr
-   \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  (is "\<lbrace>?PRE\<rbrace> _ \<lbrace>\<lambda>_. ?POST\<rbrace>")
-  apply (simp add: cancelAllSignals_def)
-  apply (wp, wpc, wp+)
-      apply (wps rescheduleRequired_ct')
-      apply (wp rescheduleRequired_ksQ')
-     apply clarsimp
-     apply (wp cancelAll_ct_not_ksQ_helper mapM_x_wp_inv)
-    apply (wp hoare_lift_Pf2 [OF setNotification_ksQ setNotification_ksCurThread])
-    apply (wps setNotification_ksCurThread, wp)
-   prefer 2
-   apply assumption
-  apply (rule_tac Q="\<lambda>ep. ?PRE and ko_at' ep ntfnptr" in hoare_post_imp)
-   apply ((clarsimp simp: invs'_def valid_state'_def sch_act_sane_def
-          | drule(1) ct_not_in_ntfnQueue)+)[1]
-  apply (wp get_ntfn_sp')
-  done
-
-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 hoare_seq_ext[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 setNotification_ksCurThread, wp)
-  apply clarsimp
-  done
-
 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)
@@ -4514,37 +4155,6 @@ lemma unbindMaybeNotification_sch_act_sane[wp]:
   apply (wp setNotification_sch_act_sane sbn_sch_act_sane | wpc | clarsimp)+
   done
 
-lemma finaliseCapTrue_standin_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>
-   finaliseCapTrue_standin cap final
-   \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: finaliseCapTrue_standin_def Let_def)
-  apply (safe)
-      apply (wp cancelAllIPC_ct_not_ksQ cancelAllSignals_ct_not_ksQ
-                hoare_drop_imps unbindMaybeNotification_ct_not_ksQ
-             | wpc
-             | clarsimp simp: isNotificationCap_def isReplyCap_def split:capability.splits)+
-  done
-
-lemma cteDeleteOne_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>
-   cteDeleteOne slot
-   \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: cteDeleteOne_def unless_def split_def)
-  apply (rule hoare_seq_ext [OF _ getCTE_sp])
-  apply (case_tac "\<forall>final. finaliseCap (cteCap cte) final True = fail")
-   apply (simp add: finaliseCapTrue_standin_simple_def)
-   apply wp
-   apply (clarsimp)
-  apply (wp emptySlot_cteCaps_of hoare_lift_Pf2 [OF emptySlot_ksRQ emptySlot_ct])
-    apply (simp add: cteCaps_of_def)
-    apply (wp (once) hoare_drop_imps)
-    apply (wp finaliseCapTrue_standin_ct_not_ksQ isFinalCapability_inv)+
-  apply (clarsimp)
-  done
-
 end
 
 end
diff --git a/proof/refine/ARM_HYP/Init_R.thy b/proof/refine/ARM_HYP/Init_R.thy
index b12f9a916d..589a07a9a6 100644
--- a/proof/refine/ARM_HYP/Init_R.thy
+++ b/proof/refine/ARM_HYP/Init_R.thy
@@ -96,7 +96,7 @@ definition zeroed_intermediate_state ::
     ksDomSchedule = [],
     ksCurDomain = 0,
     ksDomainTime = 0,
-    ksReadyQueues = K [],
+    ksReadyQueues = K (TcbQueue None None),
     ksReadyQueuesL1Bitmap = K 0,
     ksReadyQueuesL2Bitmap = K 0,
     ksCurThread = 0,
@@ -117,9 +117,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: ekheap_relation_def)
-         apply (clarsimp simp: ready_queues_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_HYP/InterruptAcc_R.thy b/proof/refine/ARM_HYP/InterruptAcc_R.thy
index 174dad753f..cb47389eab 100644
--- a/proof/refine/ARM_HYP/InterruptAcc_R.thy
+++ b/proof/refine/ARM_HYP/InterruptAcc_R.thy
@@ -52,14 +52,14 @@ lemma setIRQState_invs[wp]:
   apply (simp add: setIRQState_def setInterruptState_def getInterruptState_def)
   apply (wp dmo_maskInterrupt)
   apply (clarsimp simp: invs'_def valid_state'_def cur_tcb'_def
-                        Invariants_H.valid_queues_def valid_queues'_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 split: option.splits)
+                        bitmapQ_defs valid_bitmaps_def
+                  split: option.splits)
    apply (rule conjI, clarsimp)
    apply (clarsimp simp: irqs_masked'_def ct_not_inQ_def)
    apply (rule conjI)
@@ -154,8 +154,8 @@ lemma invs'_irq_state_independent [simp, intro!]:
           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_queues_no_bitmap_def
-          valid_queues'_def valid_pde_mappings'_def
+          irqs_masked'_def bitmapQ_defs valid_bitmaps_def
+          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
diff --git a/proof/refine/ARM_HYP/Interrupt_R.thy b/proof/refine/ARM_HYP/Interrupt_R.thy
index b2007e80ef..dc1c9600a0 100644
--- a/proof/refine/ARM_HYP/Interrupt_R.thy
+++ b/proof/refine/ARM_HYP/Interrupt_R.thy
@@ -604,13 +604,6 @@ lemma decDomainTime_corres:
   apply (clarsimp simp:state_relation_def)
   done
 
-lemma tcbSchedAppend_valid_objs':
-  "\<lbrace>valid_objs'\<rbrace>tcbSchedAppend t \<lbrace>\<lambda>r. valid_objs'\<rbrace>"
-  apply (simp add:tcbSchedAppend_def)
-  apply (wpsimp wp: unless_wp threadSet_valid_objs' threadGet_wp)
-  apply (clarsimp simp add:obj_at'_def typ_at'_def)
-  done
-
 lemma thread_state_case_if:
  "(case state of Structures_A.thread_state.Running \<Rightarrow> f | _ \<Rightarrow> g) =
   (if state = Structures_A.thread_state.Running then f else g)"
@@ -621,35 +614,27 @@ lemma threadState_case_if:
   (if state = Structures_H.thread_state.Running then f else g)"
   by (case_tac state,auto)
 
-lemma tcbSchedAppend_invs_but_ct_not_inQ':
-  "\<lbrace>invs' and st_tcb_at' runnable' t \<rbrace>
-   tcbSchedAppend t \<lbrace>\<lambda>_. all_invs_but_ct_not_inQ'\<rbrace>"
-  apply (simp add: invs'_def valid_state'_def)
-  apply (rule hoare_pre)
-   apply (wp 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
-        | fastforce elim!: st_tcb_ex_cap'' split: thread_state.split_asm)+
-  done
+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 timerTick_corres:
-  "corres dc (cur_tcb and valid_sched)
-             invs'
-             timer_tick timerTick"
-  supply if_weak_cong[cong]
+  "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="\<top> and (cur_tcb and valid_sched)" and Q'="\<top> and invs'" in corres_guard_imp)
+  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_split[where r' = dc])
              apply (rule corres_if[where Q = \<top> and Q' = \<top>])
                apply (case_tac state,simp_all)[1]
-              apply (simp add: Let_def)
               apply (rule_tac r'="(=)" in corres_split[OF ethreadget_corres])
                  apply (simp add:etcb_relation_def)
                 apply (rename_tac ts ts')
@@ -659,55 +644,53 @@ lemma timerTick_corres:
                  apply (rule ethread_set_corres, simp+)
                  apply (clarsimp simp: etcb_relation_def)
                 apply simp
-                apply (rule corres_split)
-                   apply (rule ethread_set_corres; simp)
-                   apply (simp add: etcb_relation_def)
-                  apply (rule corres_split[OF tcbSchedAppend_corres])
+                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)[1]
-                  apply (rule hoare_strengthen_post)
-                   apply (rule tcbSchedAppend_invs_but_ct_not_inQ',
-                          clarsimp simp: sch_act_wf_weak)
-                 apply (wp threadSet_timeslice_invs threadSet_valid_queues
-                           threadSet_valid_queues' threadSet_pred_tcb_at_state)+
-             apply simp
-            apply simp
-            apply (rule corres_when,simp)
+                   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 (simp add:dec_domain_time_def)
-             apply wp+
-            apply (simp add:decDomainTime_def)
-            apply wp
-           apply (wp|wpc|unfold Let_def|simp)+
-              apply (wp hoare_weak_lift_imp threadSet_timeslice_invs threadSet_valid_queues  threadSet_valid_queues'
-                 threadSet_pred_tcb_at_state threadSet_weak_sch_act_wf tcbSchedAppend_valid_objs'
-                 rescheduleRequired_weak_sch_act_wf tcbSchedAppend_valid_queues| simp)+
-              apply (strengthen sch_act_wf_weak)
-              apply (clarsimp simp:conj_comms)
-              apply (wp tcbSchedAppend_valid_queues tcbSchedAppend_sch_act_wf)
-             apply simp
-             apply (wp threadSet_valid_queues threadSet_pred_tcb_at_state threadSet_sch_act
-              threadSet_tcbDomain_triv threadSet_valid_queues' threadSet_valid_objs'| simp)+
-           apply (wp threadGet_wp gts_wp gts_wp')+
-     apply (clarsimp simp: cur_tcb_def tcb_at_is_etcb_at valid_sched_def valid_sched_action_def)
-    prefer 2
-    apply clarsimp
-   apply (clarsimp simp add:cur_tcb_def valid_sched_def
-       valid_sched_action_def valid_etcbs_def is_tcb_def
-       is_etcb_at_def st_tcb_at_def obj_at_def
-       dest!:get_tcb_SomeD)
-   apply (clarsimp simp: invs'_def valid_state'_def
-   sch_act_wf_weak
-   cur_tcb'_def inQ_def
-   ct_in_state'_def obj_at'_def)
-   apply (clarsimp simp:st_tcb_at'_def
-      valid_idle'_def ct_idle_or_in_cur_domain'_def
-      obj_at'_def projectKO_eq)
-  apply simp
+             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
 
 lemma corres_return_VGICMaintenance [corres]:
@@ -802,7 +785,7 @@ lemma virqSetEOIIRQEN_eq[simp]:
 
 lemma vgic_maintenance_corres [corres]:
   "corres dc einvs
-    (\<lambda>s. invs' s \<and> sch_act_not (ksCurThread s) s \<and> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)))
+    (\<lambda>s. invs' s \<and> sch_act_not (ksCurThread s) s)
     vgic_maintenance vgicMaintenance"
 proof -
   (* hoare_lift_Pf-style rules match too often, slowing down proof unless specialised *)
@@ -813,7 +796,6 @@ proof -
   note wplr' = vilr'[where P="sch_act_not"]
                vilr'[where P="ex_nonz_cap_to'"]
                vilr'[where P="st_tcb_at' simple'"]
-               vilr'[where P="\<lambda>t s. t \<notin> set (ksReadyQueues s x)" for x]
   show ?thesis
     unfolding vgic_maintenance_def vgicMaintenance_def isRunnable_def Let_def
     apply (rule corres_guard_imp)
@@ -867,13 +849,12 @@ proof -
                             in hoare_post_imp)
                     apply (clarsimp cong: imp_cong conj_cong simp: not_pred_tcb runnable_eq pred_conj_def)
                     apply (strengthen st_tcb_ex_cap'[where P=active], clarsimp)
-                    apply (clarsimp simp: pred_tcb_at_def obj_at_def)
+                    apply (clarsimp simp: pred_tcb_at_def obj_at_def invs_psp_aligned invs_distinct)
                    apply wp
                   apply clarsimp
                   apply (rule_tac Q="\<lambda>rv x. tcb_at' rv x
                                             \<and> invs' x
-                                            \<and> sch_act_not rv x
-                                            \<and> (\<forall>d p. rv \<notin> set (ksReadyQueues x (d, p)))"
+                                            \<and> sch_act_not rv x"
                            in hoare_post_imp)
                    apply (rename_tac rv s)
                    apply clarsimp
@@ -903,7 +884,7 @@ qed
 
 lemma vppiEvent_corres:
   "corres dc einvs
-    (\<lambda>s. invs' s \<and> sch_act_not (ksCurThread s) s \<and> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)))
+    (\<lambda>s. invs' s \<and> sch_act_not (ksCurThread s) s)
     (vppi_event irq) (vppiEvent irq)"
   unfolding vppi_event_def vppiEvent_def isRunnable_def
   supply [[simproc del: defined_all]]
@@ -941,13 +922,13 @@ lemma vppiEvent_corres:
                                                     (ARM_A.VPPIEvent irq)))"
                     in hoare_post_imp)
             apply (clarsimp cong: imp_cong conj_cong simp: not_pred_tcb runnable_eq pred_conj_def)
-            apply (strengthen st_tcb_ex_cap'[where P=active], clarsimp)
+            apply (strengthen st_tcb_ex_cap'[where P=active],
+                   clarsimp simp: invs_psp_aligned invs_distinct)
            apply wp
           apply (clarsimp cong: imp_cong conj_cong simp: pred_conj_def)
           apply (rule_tac Q="\<lambda>rv x. tcb_at' rv x
                                     \<and> invs' x
-                                    \<and> sch_act_not rv x
-                                    \<and> (\<forall>d p. rv \<notin> set (ksReadyQueues x (d, p)))" in hoare_post_imp)
+                                    \<and> sch_act_not rv x" in hoare_post_imp)
            apply (rename_tac rv s)
            apply (strengthen st_tcb_ex_cap''[where P=active'])
            apply (strengthen invs_iflive')
@@ -975,8 +956,7 @@ lemma vppiEvent_corres:
 
 lemma handle_reserved_irq_corres[corres]:
   "corres dc einvs
-      (\<lambda>s. invs' s \<and> (irq \<in> non_kernel_IRQs \<longrightarrow>
-              sch_act_not (ksCurThread s) s \<and> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))))
+      (\<lambda>s. invs' s \<and> (irq \<in> non_kernel_IRQs \<longrightarrow> sch_act_not (ksCurThread s) s))
       (handle_reserved_irq irq) (handleReservedIRQ irq)"
   apply (clarsimp simp: handle_reserved_irq_def handleReservedIRQ_def irqVPPIEventIndex_def
                         irq_vppi_event_index_def non_kernel_IRQs_def IRQ_def irqVGICMaintenance_def
@@ -984,17 +964,13 @@ lemma handle_reserved_irq_corres[corres]:
   apply (rule conjI; clarsimp)
    apply (rule corres_guard_imp, rule vppiEvent_corres)
      apply (fastforce intro: vgic_maintenance_corres simp: unat_arith_simps)+
-  apply (rule conjI; clarsimp)
-   apply (rule corres_guard_imp)
-     apply (fastforce intro: vgic_maintenance_corres simp: unat_arith_simps)+
   done
 
 lemma handleInterrupt_corres:
   "corres dc
-     (einvs)
+     einvs
      (invs' and (\<lambda>s. intStateIRQTable (ksInterruptState s) irq \<noteq> IRQInactive) and
-       (\<lambda>s. irq \<in> non_kernel_IRQs \<longrightarrow>
-              sch_act_not (ksCurThread s) s \<and> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))))
+       (\<lambda>s. irq \<in> non_kernel_IRQs \<longrightarrow> sch_act_not (ksCurThread s) s))
      (handle_interrupt irq) (handleInterrupt irq)"
   (is "corres dc _ (invs' and _ and ?P') _ _")
   apply (simp add: handle_interrupt_def handleInterrupt_def)
@@ -1038,7 +1014,7 @@ lemma handleInterrupt_corres:
        apply (rule corres_machine_op)
        apply (rule corres_eq_trivial, (simp add: no_fail_ackInterrupt)+)
       apply wp+
-    apply clarsimp
+    apply fastforce
    apply clarsimp
   apply corresKsimp
   done
@@ -1062,15 +1038,6 @@ lemma updateTimeSlice_valid_pspace[wp]:
   apply (auto simp:tcb_cte_cases_def)
   done
 
-lemma updateTimeSlice_valid_queues[wp]:
-  "\<lbrace>\<lambda>s. Invariants_H.valid_queues s \<rbrace>
-   threadSet (tcbTimeSlice_update (\<lambda>_. ts')) thread
-   \<lbrace>\<lambda>r s. Invariants_H.valid_queues s\<rbrace>"
-  apply (wp threadSet_valid_queues,simp)
-  apply (clarsimp simp:obj_at'_def inQ_def)
-  done
-
-
 lemma dom_upd_eq:
   "f t = Some y \<Longrightarrow> dom (\<lambda>a. if a = t then Some x else f a) = dom f"
   by (auto split: if_split_asm)
@@ -1097,29 +1064,29 @@ crunch ct[wp]: tcbSchedAppend cur_tcb'
   (wp: cur_tcb_lift crunch_wps)
 
 lemma timerTick_invs'[wp]:
-  "\<lbrace>invs'\<rbrace> timerTick \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  "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
-                    tcbSchedAppend_invs_but_ct_not_inQ'
-                simp: tcb_cte_cases_def)
-     apply (rule_tac Q="\<lambda>rv. invs'" in hoare_post_imp)
-     apply (clarsimp simp add:invs'_def valid_state'_def)
+              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'
-                          del: tcbSchedAppend_sch_act_wf)+
-             apply (rule hoare_strengthen_post[OF tcbSchedAppend_invs_but_ct_not_inQ'])
-             apply (wpsimp simp: valid_pspace'_def sch_act_wf_weak)+
-           apply (wpsimp wp: threadSet_pred_tcb_no_state threadSet_tcbDomain_triv
-                             threadSet_valid_objs' threadSet_timeslice_invs)+
-       apply (wp threadGet_wp)
+            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 (clarsimp simp: invs'_def st_tcb_at'_def obj_at'_def valid_state'_def)
+  apply (auto simp: invs'_def st_tcb_at'_def obj_at'_def valid_state'_def cong: conj_cong)
   done
 
 lemma resetTimer_invs'[wp]:
@@ -1149,8 +1116,9 @@ lemma runnable'_eq:
   by (cases st; simp)
 
 lemma vgicMaintenance_invs'[wp]:
-  "\<lbrace>invs' and (\<lambda>s. sch_act_not (ksCurThread s) s \<and> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)))\<rbrace>
-    vgicMaintenance \<lbrace>\<lambda>y. invs'\<rbrace>"
+  "\<lbrace>invs' and (\<lambda>s. sch_act_not (ksCurThread s) s)\<rbrace>
+   vgicMaintenance
+   \<lbrace>\<lambda>_. invs'\<rbrace>"
   supply if_split[split del]
   apply (clarsimp simp: vgicMaintenance_def get_gic_vcpu_ctrl_lr_def set_gic_vcpu_ctrl_lr_def
                 get_gic_vcpu_ctrl_misr_def get_gic_vcpu_ctrl_eisr1_def get_gic_vcpu_ctrl_eisr0_def
@@ -1161,8 +1129,7 @@ lemma vgicMaintenance_invs'[wp]:
             apply (clarsimp cong: imp_cong conj_cong simp: pred_conj_def)
             apply (rule_tac Q="\<lambda>_ s. tcb_at' (ksCurThread s) s
                                       \<and> invs' s
-                                      \<and> sch_act_not (ksCurThread s) s
-                                      \<and> (\<forall>d p. (ksCurThread s) \<notin> set (ksReadyQueues s (d, p)))"
+                                      \<and> sch_act_not (ksCurThread s) s"
                     in hoare_post_imp)
              apply (clarsimp cong: imp_cong conj_cong simp: not_pred_tcb')
              apply (clarsimp simp: st_tcb_at'_def obj_at'_def runnable'_eq)
@@ -1185,7 +1152,7 @@ lemma vgicMaintenance_invs'[wp]:
   done
 
 lemma vppiEvent_invs'[wp]:
-  "\<lbrace>invs' and (\<lambda>s. sch_act_not (ksCurThread s) s \<and> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)))\<rbrace>
+  "\<lbrace>invs' and (\<lambda>s. sch_act_not (ksCurThread s) s)\<rbrace>
     vppiEvent irq \<lbrace>\<lambda>y. invs'\<rbrace>"
   supply if_split[split del]
   apply (clarsimp simp: vppiEvent_def doMachineOp_bind)
@@ -1195,8 +1162,7 @@ lemma vppiEvent_invs'[wp]:
             apply (clarsimp cong: imp_cong conj_cong simp: pred_conj_def)
             apply (rule_tac Q="\<lambda>_ s. tcb_at' (ksCurThread s) s
                                       \<and> invs' s
-                                      \<and> sch_act_not (ksCurThread s) s
-                                      \<and> (\<forall>d p. (ksCurThread s) \<notin> set (ksReadyQueues s (d, p)))"
+                                      \<and> sch_act_not (ksCurThread s) s"
                     in hoare_post_imp)
              apply (clarsimp cong: imp_cong conj_cong simp: not_pred_tcb')
              apply (clarsimp simp: st_tcb_at'_def obj_at'_def runnable'_eq)
@@ -1211,8 +1177,7 @@ lemma vppiEvent_invs'[wp]:
   done
 
 lemma hint_invs[wp]:
-  "\<lbrace>invs' and (\<lambda>s. irq \<in> non_kernel_IRQs \<longrightarrow>
-              sch_act_not (ksCurThread s) s \<and> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)))\<rbrace>
+  "\<lbrace>invs' and (\<lambda>s. irq \<in> non_kernel_IRQs \<longrightarrow> sch_act_not (ksCurThread s) s)\<rbrace>
     handleInterrupt irq \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (simp add: handleInterrupt_def getSlotCap_def cong: irqstate.case_cong)
   apply (rule conjI; rule impI)
diff --git a/proof/refine/ARM_HYP/InvariantUpdates_H.thy b/proof/refine/ARM_HYP/InvariantUpdates_H.thy
index c15fac0053..46a234c70a 100644
--- a/proof/refine/ARM_HYP/InvariantUpdates_H.thy
+++ b/proof/refine/ARM_HYP/InvariantUpdates_H.thy
@@ -38,8 +38,9 @@ lemma invs'_machine:
 proof -
   show ?thesis
     apply (cases "ksSchedulerAction s")
-    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_queues_def valid_queues_no_bitmap_def bitmapQ_defs
+    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
@@ -56,12 +57,13 @@ lemma invs_no_cicd'_machine:
 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_queues_def valid_queues_no_bitmap_def bitmapQ_defs
-                    vms ct_not_inQ_def
-                    state_refs_of'_def ps_clear_def
-                    valid_irq_node'_def mask
-              cong: option.case_cong)
+    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)
     done
 qed
 
@@ -98,14 +100,9 @@ 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_queues_ksSchedulerAction_update[simp]:
-  "valid_queues (ksSchedulerAction_update f s) = valid_queues s"
- unfolding valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs
- by simp
-
-lemma valid_queues'_ksSchedulerAction_update[simp]:
-  "valid_queues' (ksSchedulerAction_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_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'"
@@ -140,45 +137,25 @@ lemma tcb_in_cur_domain_ct[simp]:
   "tcb_in_cur_domain' t  (ksCurThread_update f s) = tcb_in_cur_domain' t s"
   by (fastforce simp: tcb_in_cur_domain'_def)
 
-lemma valid_queues'_ksCurDomain[simp]:
-  "valid_queues' (ksCurDomain_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
-
-lemma valid_queues'_ksDomScheduleIdx[simp]:
-  "valid_queues' (ksDomScheduleIdx_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
+lemma valid_bitmaps_ksCurDomain[simp]:
+  "valid_bitmaps (ksCurDomain_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
 
-lemma valid_queues'_ksDomSchedule[simp]:
-  "valid_queues' (ksDomSchedule_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
+lemma valid_bitmaps_ksDomScheduleIdx[simp]:
+  "valid_bitmaps (ksDomScheduleIdx_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
 
-lemma valid_queues'_ksDomainTime[simp]:
-  "valid_queues' (ksDomainTime_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
+lemma valid_bitmaps_ksDomSchedule[simp]:
+   "valid_bitmaps (ksDomSchedule_update f s) = valid_bitmaps s"
+   by (simp add: valid_bitmaps_def bitmapQ_defs)
 
-lemma valid_queues'_ksWorkUnitsCompleted[simp]:
-  "valid_queues' (ksWorkUnitsCompleted_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
+lemma valid_bitmaps_ksDomainTime[simp]:
+  "valid_bitmaps (ksDomainTime_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
 
-lemma valid_queues_ksCurDomain[simp]:
-  "valid_queues (ksCurDomain_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
-
-lemma valid_queues_ksDomScheduleIdx[simp]:
-  "valid_queues (ksDomScheduleIdx_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
-
-lemma valid_queues_ksDomSchedule[simp]:
-  "valid_queues (ksDomSchedule_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
-
-lemma valid_queues_ksDomainTime[simp]:
-  "valid_queues (ksDomainTime_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
-
-lemma valid_queues_ksWorkUnitsCompleted[simp]:
-  "valid_queues (ksWorkUnitsCompleted_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
+lemma valid_bitmaps_ksWorkUnitsCompleted[simp]:
+  "valid_bitmaps (ksWorkUnitsCompleted_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
 
 lemma valid_irq_node'_ksCurDomain[simp]:
   "valid_irq_node' w (ksCurDomain_update f s) = valid_irq_node' w s"
@@ -255,6 +232,10 @@ lemma valid_mdb_interrupts'[simp]:
   "valid_mdb' (ksInterruptState_update f s) = valid_mdb' s"
   by (simp add: valid_mdb'_def)
 
+lemma valid_mdb'_ksReadyQueues_update[simp]:
+  "valid_mdb' (ksReadyQueues_update f s) = valid_mdb' s"
+  by (simp add: valid_mdb'_def)
+
 lemma vms_ksReadyQueues_update[simp]:
   "valid_machine_state' (ksReadyQueues_update f s) = valid_machine_state' s"
   by (simp add: valid_machine_state'_def)
@@ -279,10 +260,10 @@ lemma ct_in_state_ksSched[simp]:
 
 lemma invs'_wu[simp]:
   "invs' (ksWorkUnitsCompleted_update f s) = invs' s"
-  apply (simp add: invs'_def cur_tcb'_def valid_state'_def Invariants_H.valid_queues_def
-                   valid_queues'_def valid_irq_node'_def valid_machine_state'_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 valid_queues_no_bitmap_def)
+                   bitmapQ_defs)
   done
 
 lemma valid_arch_state'_interrupt[simp]:
@@ -334,9 +315,8 @@ lemma sch_act_simple_ksReadyQueuesL2Bitmap[simp]:
 
 lemma ksDomainTime_invs[simp]:
   "invs' (ksDomainTime_update f s) = invs' s"
-  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)
+  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"
@@ -364,9 +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 valid_state'_def valid_queues_def valid_queues'_def
-                      valid_irq_node'_def cur_tcb'_def ct_idle_or_in_cur_domain'_def
-                      tcb_in_cur_domain'_def valid_queues_no_bitmap_def
-                      bitmapQ_no_L2_orphans_def bitmapQ_no_L1_orphans_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
\ No newline at end of file
diff --git a/proof/refine/ARM_HYP/Invariants_H.thy b/proof/refine/ARM_HYP/Invariants_H.thy
index 7d3acef6cc..60be16f4ba 100644
--- a/proof/refine/ARM_HYP/Invariants_H.thy
+++ b/proof/refine/ARM_HYP/Invariants_H.thy
@@ -11,6 +11,7 @@ imports
   "AInvs.Deterministic_AI"
   "AInvs.AInvs"
   "Lib.AddUpdSimps"
+  "Lib.Heap_List"
 begin
 
 context Arch begin
@@ -162,6 +163,21 @@ definition
 abbreviation
   "cte_at' \<equiv> cte_wp_at' \<top>"
 
+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 tcbSchedPrevs_of :: "kernel_state \<Rightarrow> obj_ref \<Rightarrow> obj_ref option" where
+   "tcbSchedPrevs_of s \<equiv> tcbs_of' s |> tcbSchedPrev"
+
+abbreviation tcbSchedNexts_of :: "kernel_state \<Rightarrow> obj_ref \<Rightarrow> obj_ref option" where
+  "tcbSchedNexts_of s \<equiv> tcbs_of' s |> tcbSchedNext"
+
+abbreviation sym_heap_sched_pointers :: "global.kernel_state \<Rightarrow> bool" where
+  "sym_heap_sched_pointers s \<equiv> sym_heap (tcbSchedNexts_of s) (tcbSchedPrevs_of s)"
+
 definition
   tcb_cte_cases :: "word32 \<rightharpoonup> ((tcb \<Rightarrow> cte) \<times> ((cte \<Rightarrow> cte) \<Rightarrow> tcb \<Rightarrow> tcb))"
 where
@@ -236,13 +252,14 @@ where
                                then refs_of' ko
                                else {}))"
 
-
 primrec
   live0' :: "Structures_H.kernel_object \<Rightarrow> bool"
 where
   "live0' (KOTCB tcb) =
-     (bound (tcbBoundNotification 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))"
 | "live0' (KOCTE cte)           = False"
 | "live0' (KOEndpoint ep)       = (ep \<noteq> IdleEP)"
 | "live0' (KONotification ntfn)     = (bound (ntfnBoundTCB ntfn) \<or> (\<exists>ts. ntfnObj ntfn = WaitingNtfn ts))"
@@ -315,14 +332,14 @@ where
 definition live' :: "kernel_object \<Rightarrow> bool"
 where
  "live' ko \<equiv> case ko of
-    (KOTCB tcb)           => live0' ko \<or> hyp_live' ko
-  | (KOCTE cte)           => False
-  | (KOEndpoint ep)       => live0' ko
-  | (KONotification ntfn) => live0' ko
-  | (KOUserData)          => False
-  | (KOUserDataDevice)    => False
-  | (KOKernelData)        => False
-  | (KOArch ako)          => hyp_live' ko"
+    KOTCB tcb           => live0' ko \<or> hyp_live' ko
+  | KOCTE cte           => False
+  | KOEndpoint ep       => live0' ko
+  | KONotification ntfn => live0' ko
+  | KOUserData          => False
+  | KOUserDataDevice    => False
+  | KOKernelData        => False
+  | KOArch ako          => hyp_live' ko"
 
 context begin interpretation Arch . (*FIXME: arch_split*)
 primrec
@@ -579,6 +596,11 @@ definition
 where
   "valid_arch_tcb' \<equiv> \<lambda>t s. \<forall>v. atcbVCPUPtr t = Some v \<longrightarrow> vcpu_at' v s "
 
+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' :: "Structures_H.tcb \<Rightarrow> kernel_state \<Rightarrow> bool"
 where
@@ -589,6 +611,8 @@ where
                   \<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
                   \<and> valid_arch_tcb' (tcbArch t) s"
 
 definition
@@ -1012,10 +1036,15 @@ where
 | "runnable' (Structures_H.BlockedOnSend a b c d e) = False"
 | "runnable' (Structures_H.BlockedOnNotification x) = False"
 
-definition
-  inQ :: "domain \<Rightarrow> priority \<Rightarrow> tcb \<Rightarrow> bool"
-where
- "inQ d p tcb \<equiv> tcbQueued tcb \<and> tcbPriority tcb = p \<and> tcbDomain tcb = d"
+definition inQ :: "domain \<Rightarrow> priority \<Rightarrow> tcb \<Rightarrow> bool" where
+  "inQ d p tcb \<equiv> tcbQueued tcb \<and> tcbPriority tcb = p \<and> tcbDomain tcb = d"
+
+lemma inQ_implies_tcbQueueds_of:
+  "(inQ domain priority |< tcbs_of' s') tcbPtr \<Longrightarrow> (tcbQueued |< tcbs_of' s') tcbPtr"
+  by (clarsimp simp: opt_map_def opt_pred_def inQ_def split: option.splits)
+
+defs ready_qs_runnable_def:
+  "ready_qs_runnable s \<equiv> \<forall>t. obj_at' tcbQueued t s \<longrightarrow> st_tcb_at' runnable' t s"
 
 definition
   (* for given domain and priority, the scheduler bitmap indicates a thread is in the queue *)
@@ -1025,15 +1054,6 @@ where
   "bitmapQ d p s \<equiv> ksReadyQueuesL1Bitmap s d !! prioToL1Index p
                      \<and> ksReadyQueuesL2Bitmap s (d, invertL1Index (prioToL1Index p))
                          !! unat (p && mask wordRadix)"
-
-definition
-  valid_queues_no_bitmap :: "kernel_state \<Rightarrow> bool"
-where
- "valid_queues_no_bitmap \<equiv> \<lambda>s.
-   (\<forall>d p. (\<forall>t \<in> set (ksReadyQueues s (d, p)). obj_at' (inQ d p and runnable' \<circ> tcbState) t s)
-    \<and>  distinct (ksReadyQueues s (d, p))
-    \<and> (d > maxDomain \<or> p > maxPriority \<longrightarrow> ksReadyQueues s (d,p) = []))"
-
 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
@@ -1057,31 +1077,62 @@ where
     \<forall>d i. ksReadyQueuesL1Bitmap s d !! i \<longrightarrow> ksReadyQueuesL2Bitmap s (d, invertL1Index i) \<noteq> 0 \<and>
                                              i < l2BitmapSize"
 
-definition
-  valid_bitmapQ :: "kernel_state \<Rightarrow> bool"
-where
-  "valid_bitmapQ \<equiv> \<lambda>s. (\<forall>d p. bitmapQ d p s \<longleftrightarrow> ksReadyQueues s (d,p) \<noteq> [])"
+definition valid_bitmapQ :: "kernel_state \<Rightarrow> bool" where
+  "valid_bitmapQ \<equiv> \<lambda>s. \<forall>d p. bitmapQ d p s \<longleftrightarrow> \<not> tcbQueueEmpty (ksReadyQueues s (d,p))"
 
-definition
-  valid_queues :: "kernel_state \<Rightarrow> bool"
-where
- "valid_queues \<equiv> \<lambda>s. valid_queues_no_bitmap s \<and> valid_bitmapQ s \<and>
-                     bitmapQ_no_L2_orphans s \<and> bitmapQ_no_L1_orphans s"
+definition valid_bitmaps :: "kernel_state \<Rightarrow> bool" where
+  "valid_bitmaps \<equiv> \<lambda>s. valid_bitmapQ s \<and> bitmapQ_no_L2_orphans s \<and> bitmapQ_no_L1_orphans s"
 
-definition
-  (* when a thread gets added to / removed from a queue, but before bitmap updated *)
-  valid_bitmapQ_except :: "domain \<Rightarrow> priority \<Rightarrow> kernel_state \<Rightarrow> bool"
-where
+lemma valid_bitmaps_valid_bitmapQ[elim!]:
+  "valid_bitmaps s \<Longrightarrow> valid_bitmapQ s"
+  by (simp add: valid_bitmaps_def)
+
+lemma valid_bitmaps_bitmapQ_no_L2_orphans[elim!]:
+  "valid_bitmaps s \<Longrightarrow> bitmapQ_no_L2_orphans s"
+  by (simp add: valid_bitmaps_def)
+
+lemma valid_bitmaps_bitmapQ_no_L1_orphans[elim!]:
+  "valid_bitmaps s \<Longrightarrow> bitmapQ_no_L1_orphans s"
+  by (simp add: valid_bitmaps_def)
+
+lemma valid_bitmaps_lift:
+  assumes prq: "\<And>P. f \<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace>"
+  assumes prqL1: "\<And>P. f \<lbrace>\<lambda>s. P (ksReadyQueuesL1Bitmap s)\<rbrace>"
+  assumes prqL2: "\<And>P. f \<lbrace>\<lambda>s. P (ksReadyQueuesL2Bitmap s)\<rbrace>"
+  shows "f \<lbrace>valid_bitmaps\<rbrace>"
+  unfolding valid_bitmaps_def valid_bitmapQ_def bitmapQ_def
+            bitmapQ_no_L1_orphans_def bitmapQ_no_L2_orphans_def
+  apply (rule hoare_pre)
+   apply (wps assms | wpsimp)+
+  done
+
+(* when a thread gets added to / removed from a queue, but before bitmap updated *)
+definition valid_bitmapQ_except :: "domain \<Rightarrow> priority \<Rightarrow> kernel_state \<Rightarrow> bool" where
   "valid_bitmapQ_except d' p' \<equiv> \<lambda>s.
-    (\<forall>d p. (d \<noteq> d' \<or> p \<noteq> p') \<longrightarrow> (bitmapQ d p s \<longleftrightarrow> ksReadyQueues s (d,p) \<noteq> []))"
+    \<forall>d p. (d \<noteq> d' \<or> p \<noteq> p') \<longrightarrow> (bitmapQ d p s \<longleftrightarrow> \<not> tcbQueueEmpty (ksReadyQueues s (d,p)))"
 
 lemmas bitmapQ_defs = valid_bitmapQ_def valid_bitmapQ_except_def bitmapQ_def
                        bitmapQ_no_L2_orphans_def bitmapQ_no_L1_orphans_def
 
-definition
-  valid_queues' :: "kernel_state \<Rightarrow> bool"
-where
- "valid_queues' \<equiv> \<lambda>s. \<forall>d p t. obj_at' (inQ d p) t s \<longrightarrow> t \<in> set (ksReadyQueues s (d, p))"
+\<comment> \<open>
+  The tcbSchedPrev and tcbSchedNext fields of a TCB are used only to indicate membership in
+  one of the ready queues. \<close>
+definition valid_sched_pointers_2 ::
+  "(obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> (obj_ref \<Rightarrow> bool) \<Rightarrow> bool "
+  where
+  "valid_sched_pointers_2 prevs nexts ready \<equiv>
+     \<forall>ptr. prevs ptr \<noteq> None \<or> nexts ptr \<noteq> None \<longrightarrow> ready ptr"
+
+abbreviation valid_sched_pointers :: "kernel_state \<Rightarrow> bool" where
+  "valid_sched_pointers s \<equiv>
+     valid_sched_pointers_2 (tcbSchedPrevs_of s) (tcbSchedNexts_of s) (tcbQueued |< tcbs_of' s)"
+
+lemmas valid_sched_pointers_def = valid_sched_pointers_2_def
+
+lemma valid_sched_pointersD:
+  "\<lbrakk>valid_sched_pointers s; \<not> (tcbQueued |< tcbs_of' s) t\<rbrakk>
+   \<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 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"
@@ -1316,7 +1367,7 @@ definition
   valid_state' :: "kernel_state \<Rightarrow> bool"
 where
   "valid_state' \<equiv> \<lambda>s. valid_pspace' s \<and> sch_act_wf (ksSchedulerAction s) s
-                      \<and> valid_queues s \<and> sym_refs (state_refs_of' s) \<and>sym_refs (state_hyp_refs_of' s)
+                      \<and> sym_refs (state_refs_of' s) \<and>sym_refs (state_hyp_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
@@ -1325,7 +1376,9 @@ where
                       \<and> valid_irq_states' s
                       \<and> valid_machine_state' s
                       \<and> irqs_masked' s
-                      \<and> valid_queues' 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
@@ -1378,6 +1431,11 @@ definition
 abbreviation
   "active' st \<equiv> st = Structures_H.Running \<or> st = Structures_H.Restart"
 
+lemma runnable_eq_active': "runnable' = active'"
+  apply (rule ext)
+  apply (case_tac st, simp_all)
+  done
+
 abbreviation
   "simple' st \<equiv> st = Structures_H.Inactive \<or>
                 st = Structures_H.Running \<or>
@@ -1393,11 +1451,12 @@ abbreviation
 abbreviation(input)
  "all_invs_but_sym_refs_ct_not_inQ'
     \<equiv> \<lambda>s. valid_pspace' s \<and> sch_act_wf (ksSchedulerAction s) s
-           \<and> valid_queues s \<and> if_live_then_nonz_cap' s \<and> if_unsafe_then_cap' 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> cur_tcb' s \<and> valid_queues' s \<and> ct_idle_or_in_cur_domain' s \<and> valid_pde_mappings' 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"
@@ -1405,12 +1464,13 @@ abbreviation(input)
 abbreviation(input)
  "all_invs_but_ct_not_inQ'
     \<equiv> \<lambda>s. valid_pspace' s \<and> sch_act_wf (ksSchedulerAction s) s
-           \<and> valid_queues s \<and> sym_refs (state_refs_of' s) \<and> sym_refs (state_hyp_refs_of' s)
+           \<and> sym_refs (state_refs_of' s) \<and> sym_refs (state_hyp_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> cur_tcb' s \<and> valid_queues' s \<and> ct_idle_or_in_cur_domain' s \<and> valid_pde_mappings' 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"
@@ -1426,12 +1486,13 @@ lemma all_invs_but_not_ct_inQ_check':
 definition
   "all_invs_but_ct_idle_or_in_cur_domain'
     \<equiv> \<lambda>s. valid_pspace' s \<and> sch_act_wf (ksSchedulerAction s) s
-           \<and> valid_queues s \<and> sym_refs (state_refs_of' s) \<and> sym_refs (state_hyp_refs_of' s)
+           \<and> sym_refs (state_refs_of' s) \<and> sym_refs (state_hyp_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> cur_tcb' s \<and> valid_queues' s \<and> ct_not_inQ s \<and> valid_pde_mappings' 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"
@@ -3292,9 +3353,9 @@ lemma sch_act_wf_arch [simp]:
   "sch_act_wf sa (ksArchState_update f s) = sch_act_wf sa s"
   by (cases sa) (simp_all add: ct_in_state'_def  tcb_in_cur_domain'_def)
 
-lemma valid_queues_arch [simp]:
-  "valid_queues (ksArchState_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
+lemma valid_bitmaps_arch[simp]:
+  "valid_bitmaps (ksArchState_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
 
 lemma if_unsafe_then_cap_arch' [simp]:
   "if_unsafe_then_cap' (ksArchState_update f s) = if_unsafe_then_cap' s"
@@ -3312,22 +3373,14 @@ lemma sch_act_wf_machine_state [simp]:
   "sch_act_wf sa (ksMachineState_update f s) = sch_act_wf sa s"
   by (cases sa) (simp_all add: ct_in_state'_def  tcb_in_cur_domain'_def)
 
-lemma valid_queues_machine_state [simp]:
-  "valid_queues (ksMachineState_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
-
-lemma valid_queues_arch' [simp]:
-  "valid_queues' (ksArchState_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
-
-lemma valid_queues_machine_state' [simp]:
-  "valid_queues' (ksMachineState_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
-
 lemma valid_irq_node'_machine_state [simp]:
   "valid_irq_node' x (ksMachineState_update f s) = valid_irq_node' x s"
   by (simp add: valid_irq_node'_def)
 
+lemma valid_bitmaps_machine_state[simp]:
+  "valid_bitmaps (ksMachineState_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
+
 (* these should be reasonable safe for automation because of the 0 pattern *)
 lemma no_0_ko_wp' [elim!]:
   "\<lbrakk> ko_wp_at' Q 0 s; no_0_obj' s \<rbrakk> \<Longrightarrow> P"
@@ -3405,19 +3458,6 @@ lemma typ_at_aligned':
   "\<lbrakk> typ_at' tp p s \<rbrakk> \<Longrightarrow> is_aligned p (objBitsT tp)"
   by (clarsimp simp add: typ_at'_def ko_wp_at'_def objBitsT_koTypeOf)
 
-lemma valid_queues_obj_at'D:
-   "\<lbrakk> t \<in> set (ksReadyQueues s (d, p)); valid_queues s \<rbrakk>
-        \<Longrightarrow> obj_at' (inQ d p) t s"
-  apply (unfold valid_queues_def valid_queues_no_bitmap_def)
-  apply (elim conjE)
-  apply (drule_tac x=d in spec)
-  apply (drule_tac x=p in spec)
-  apply (clarsimp)
-  apply (drule(1) bspec)
-  apply (erule obj_at'_weakenE)
-  apply (clarsimp)
-  done
-
 lemma obj_at'_and:
   "obj_at' (P and P') t s = (obj_at' P t s \<and> obj_at' P' t s)"
   by (rule iffI, (clarsimp simp: obj_at'_def)+)
@@ -3459,21 +3499,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 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> st_tcb_at' runnable' t s) \<and>
-                  distinct (ksReadyQueues s (d, p)) \<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_queues_running:
-  assumes Q: "t \<in> set(ksReadyQueues s (d, p))" "valid_queues s"
-  shows "st_tcb_at' runnable' t s"
-  using assms by (clarsimp simp add: valid_queues_def valid_queues_no_bitmap_def')
-
 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)
@@ -3558,8 +3583,16 @@ 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_queues [elim!]:
-  "invs' s \<Longrightarrow> valid_queues s"
+lemma invs_valid_bitmaps[elim!]:
+  "invs' s \<Longrightarrow> valid_bitmaps s"
+  by (simp add: invs'_def valid_state'_def)
+
+lemma invs_sym_heap_sched_pointers[elim!]:
+  "invs' s \<Longrightarrow> sym_heap_sched_pointers s"
+  by (simp add: invs'_def valid_state'_def)
+
+lemma invs_valid_sched_pointers[elim!]:
+  "invs' s \<Longrightarrow> valid_sched_pointers s"
   by (simp add: invs'_def valid_state'_def)
 
 lemma invs_valid_idle'[elim!]:
@@ -3574,21 +3607,9 @@ 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 valid_queues_valid_bitmapQ:
-  "valid_queues s \<Longrightarrow> valid_bitmapQ s"
-  by (simp add: valid_queues_def)
-
-lemma valid_queues_valid_queues_no_bitmap:
-  "valid_queues s \<Longrightarrow> valid_queues_no_bitmap s"
-  by (simp add: valid_queues_def)
-
-lemma valid_queues_bitmapQ_no_L1_orphans:
-  "valid_queues s \<Longrightarrow> bitmapQ_no_L1_orphans s"
-  by (simp add: valid_queues_def)
-
 lemma invs'_bitmapQ_no_L1_orphans:
   "invs' s \<Longrightarrow> bitmapQ_no_L1_orphans s"
-  by (drule invs_queues, simp add: valid_queues_def)
+  by (simp add: invs'_def valid_state'_def valid_bitmaps_def)
 
 lemma invs_ksCurDomain_maxDomain' [elim!]:
   "invs' s \<Longrightarrow> ksCurDomain s \<le> maxDomain"
@@ -3613,34 +3634,24 @@ lemma invs_no_0_obj'[elim!]:
 
 lemma invs'_gsCNodes_update[simp]:
   "invs' (gsCNodes_update f s') = invs' s'"
-  apply (clarsimp simp: invs'_def valid_state'_def valid_queues_def valid_queues_no_bitmap_def
-             bitmapQ_defs
-             valid_queues'_def 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'")
-  apply (simp_all add: ct_in_state'_def tcb_in_cur_domain'_def  ct_idle_or_in_cur_domain'_def ct_not_inQ_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_state'_def valid_queues_def valid_queues_no_bitmap_def
-             bitmapQ_defs
-             valid_queues'_def 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'")
-  apply (simp_all add: ct_in_state'_def ct_idle_or_in_cur_domain'_def   tcb_in_cur_domain'_def ct_not_inQ_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_queues_tcb_in_cur_domain':
-  "\<lbrakk> ksReadyQueues s (d, p) = x # xs; invs' s; d = ksCurDomain s\<rbrakk>
-     \<Longrightarrow> tcb_in_cur_domain' x s"
-apply (subgoal_tac "x \<in> set (ksReadyQueues s (d, p))")
- apply (drule (1) valid_queues_obj_at'D[OF _ invs_queues])
- apply (auto simp: inQ_def tcb_in_cur_domain'_def elim: obj_at'_weakenE)
-done
-
 lemma pred_tcb'_neq_contra:
   "\<lbrakk> pred_tcb_at' proj P p s; pred_tcb_at' proj Q p s; \<And>st. P st \<noteq> Q st \<rbrakk> \<Longrightarrow> False"
   by (clarsimp simp: pred_tcb_at'_def obj_at'_def)
@@ -3654,7 +3665,7 @@ lemma invs'_ksDomScheduleIdx:
 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> ksReadyQueues s (d,p) \<noteq> []) ;
+  "\<lbrakk> valid_bitmapQ_except d p s; bitmapQ d p s \<longleftrightarrow> \<not> tcbQueueEmpty (ksReadyQueues s (d,p));
      bitmapQ_no_L2_orphans s \<rbrakk>
    \<Longrightarrow> valid_bitmapQ s"
   unfolding valid_bitmapQ_def valid_bitmapQ_except_def
diff --git a/proof/refine/ARM_HYP/IpcCancel_R.thy b/proof/refine/ARM_HYP/IpcCancel_R.thy
index cdd9069ccc..56a9bac792 100644
--- a/proof/refine/ARM_HYP/IpcCancel_R.thy
+++ b/proof/refine/ARM_HYP/IpcCancel_R.thy
@@ -48,25 +48,6 @@ lemma set_ep_pred_tcb_at' [wp]:
   apply (simp add: updateObject_default_def in_monad projectKOs)
   done
 
-(* valid_queues is too strong *)
-definition valid_inQ_queues :: "KernelStateData_H.kernel_state \<Rightarrow> bool" where
-  "valid_inQ_queues \<equiv>
-     \<lambda>s. \<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s) \<and> distinct (ksReadyQueues s (d, p))"
-
-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_inQ_queues_ksReadyQueuesL1Bitmap_upd[simp]:
-  "valid_inQ_queues (ksReadyQueuesL1Bitmap_update f s) = valid_inQ_queues s"
-  unfolding valid_inQ_queues_def
-  by simp
-
-lemma valid_inQ_queues_ksReadyQueuesL2Bitmap_upd[simp]:
-  "valid_inQ_queues (ksReadyQueuesL2Bitmap_update f s) = valid_inQ_queues s"
-  unfolding valid_inQ_queues_def
-  by simp
-
 defs capHasProperty_def:
   "capHasProperty ptr P \<equiv> cte_wp_at' (\<lambda>c. P (cteCap c)) ptr"
 end
@@ -83,11 +64,6 @@ locale delete_one_conc_pre =
     "\<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_queues:
-    "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)\<rbrace>
-     cteDeleteOne sl \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  assumes delete_one_inQ_queues:
-    "\<lbrace>valid_inQ_queues\<rbrace> cteDeleteOne sl \<lbrace>\<lambda>rv. valid_inQ_queues\<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:
@@ -339,6 +315,8 @@ lemma cancelSignal_corres:
      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 (rule conjI, fastforce)
+   apply (rule conjI, fastforce)
    apply (erule pspace_valid_objsE)
     apply fastforce
    apply (clarsimp simp: valid_obj_def valid_tcb_def valid_tcb_state_def)
@@ -547,12 +525,12 @@ lemma (in delete_one) cancelIPC_ReplyCap_corres:
               and Q'="\<lambda>_. invs' and st_tcb_at' awaiting_reply' t"
                in corres_underlying_split)
      apply (rule corres_guard_imp)
-       apply (rule threadset_corresT)
+       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: tcb_cte_cases_def cteSizeBits_def)
        apply (simp add: exst_same_def)
-      apply (clarsimp simp: st_tcb_at_tcb_at)
+      apply (fastforce simp: st_tcb_at_tcb_at)
      apply clarsimp
     defer
     apply (wp thread_set_invs_trivial thread_set_no_change_tcb_state
@@ -587,7 +565,7 @@ lemma (in delete_one) cancelIPC_ReplyCap_corres:
     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)
+                    elim!: reply_mdbNext_is_descendantD)
     apply (simp add: when_def getSlotCap_def capHasProperty_def
                 del: split_paired_Ex)
     apply (rule corres_guard_imp)
@@ -639,7 +617,7 @@ lemma (in delete_one) cancel_ipc_corres:
     apply (rule hoare_strengthen_post)
      apply (rule gts_sp'[where P="\<top>"])
     apply (clarsimp elim!: pred_tcb'_weakenE)
-   apply simp
+   apply fastforce
   apply simp
   done
 
@@ -671,16 +649,15 @@ lemma sch_act_simple_not_t[simp]: "sch_act_simple s \<Longrightarrow> sch_act_no
 
 context begin interpretation Arch . (*FIXME: arch_split*)
 
+crunches setNotification
+  for sym_heap_sched_pointers[wp]: sym_heap_sched_pointers
+  and valid_bitmaps[wp]: valid_bitmaps
+  (wp: valid_bitmaps_lift)
+
 lemma cancelSignal_invs':
   "\<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> Invariants_H.valid_queues s; st_tcb_at' (Not \<circ> runnable') t s \<rbrakk>
-                                         \<Longrightarrow> \<forall>x. t \<notin> set (ksReadyQueues s x)"
-      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>"
@@ -691,9 +668,9 @@ lemma cancelSignal_invs':
     show ?thesis
       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 setNotification_ksQ] sts_valid_queues
+                hoare_vcg_all_lift
                 setThreadState_ct_not_inQ NTFNSN
-                hoare_vcg_all_lift setNotification_ksQ
+                hoare_vcg_all_lift
               | simp add: valid_tcb_state'_def list_case_If split del: if_split)+
        prefer 2
        apply assumption
@@ -701,8 +678,6 @@ lemma cancelSignal_invs':
        apply (rule get_ntfn_sp')
       apply (rename_tac rv s)
       apply (clarsimp simp: pred_tcb_at')
-      apply (frule NIQ)
-       apply (clarsimp simp: pred_tcb_at'_def obj_at'_def)
       apply (rule conjI)
        apply (clarsimp simp: valid_ntfn'_def)
        apply (case_tac "ntfnObj rv", simp_all add: isWaitingNtfn_def)
@@ -744,6 +719,7 @@ lemma cancelSignal_invs':
                                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")
@@ -827,17 +803,18 @@ lemma tcb_bound_refs'_not_NTFNBound[simp]:
   "(t, NTFNBound) \<notin> tcb_bound_refs' n"
   by (simp add: tcb_bound_refs'_def)
 
+crunches 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 NIQ: "\<And>s. \<lbrakk> Invariants_H.valid_queues s; st_tcb_at' (Not \<circ> runnable') t s \<rbrakk>
-                                       \<Longrightarrow> \<forall>x. t \<notin> set (ksReadyQueues s x)"
-    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 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>"
@@ -861,21 +838,20 @@ proof -
     apply (subst P)
     apply (wp valid_irq_node_lift valid_global_refs_lift'
               irqs_masked_lift sts_sch_act'
-              hoare_vcg_all_lift [OF setEndpoint_ksQ]
-              sts_valid_queues setThreadState_ct_not_inQ EPSCHN
-              hoare_vcg_all_lift setNotification_ksQ getEndpoint_wp
+              setThreadState_ct_not_inQ EPSCHN
+              hoare_vcg_all_lift getEndpoint_wp
               | simp add: valid_tcb_state'_def split del: if_split
               | wpc)+
     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 (frule NIQ)
-     apply (erule pred_tcb'_weakenE, fastforce)
     apply (clarsimp, rule conjI)
      apply (auto simp: pred_tcb_at'_def obj_at'_def)[1]
     apply (rule conjI)
@@ -1063,31 +1039,6 @@ apply (wp hoare_vcg_conj_lift delete_one_ksCurDomain
      | simp add: getThreadReplySlot_def o_def if_fun_split)+
 done
 
-(* FIXME move *)
-lemma tcbSchedEnqueue_not_st:
-  "(\<And>tcb st qd. P (tcb\<lparr>tcbState := st, tcbQueued := qd\<rparr>) \<longleftrightarrow> P tcb)
-     \<Longrightarrow> \<lbrace>obj_at' P t'\<rbrace> tcbSchedEnqueue t \<lbrace>\<lambda>_. obj_at' P t'\<rbrace>"
-apply (simp add: tcbSchedEnqueue_def unless_def)
-apply (wp threadGet_wp | simp)+
-apply (clarsimp simp: obj_at'_def)
-apply (case_tac obja)
-apply fastforce
-done
-
-(* FIXME move *)
-lemma setThreadState_not_st:
-  "(\<And>tcb st qd. P (tcb\<lparr>tcbState := st, tcbQueued := qd\<rparr>) \<longleftrightarrow> P tcb)
-     \<Longrightarrow> \<lbrace>obj_at' P t'\<rbrace> setThreadState st t \<lbrace>\<lambda>_. obj_at' P t'\<rbrace>"
-apply (simp add: setThreadState_def rescheduleRequired_def)
-apply (wp hoare_vcg_conj_lift tcbSchedEnqueue_not_st
-     | wpc
-     | rule hoare_drop_imps
-     | simp)+
-apply (clarsimp simp: obj_at'_def)
-apply (case_tac obj)
-apply fastforce
-done
-
 (* FIXME move *)
 lemma setBoundNotification_not_ntfn:
   "(\<And>tcb ntfn. P (tcb\<lparr>tcbBoundNotification := ntfn\<rparr>) \<longleftrightarrow> P tcb)
@@ -1099,15 +1050,6 @@ lemma setBoundNotification_not_ntfn:
      | simp)+
   done
 
-(* FIXME move *)
-lemma setThreadState_tcb_in_cur_domain'[wp]:
-  "\<lbrace>tcb_in_cur_domain' t'\<rbrace> setThreadState 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 setThreadState_not_st | simp)+
-done
-
 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)
@@ -1116,22 +1058,22 @@ lemma setBoundNotification_tcb_in_cur_domain'[wp]:
   apply (wp 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> \<lbrace>obj_at' P t'\<rbrace> cancelSignal t word \<lbrace>\<lambda>_. obj_at' P t'\<rbrace>"
-apply (simp add: cancelSignal_def setNotification_def)
-apply (wp setThreadState_not_st getNotification_wp | wpc | simp)+
-done
+lemma setThreadState_tcbDomain_obj_at'[wp]:
+  "setThreadState ts t \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  unfolding setThreadState_def
+  by wpsimp
+
+crunches 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 (simp add: cancelIPC_def Let_def)
-apply (wp hoare_vcg_conj_lift
-          setThreadState_not_st delete_one_tcbDomain_obj_at' cancelSignal_tcb_obj_at'
-     | wpc
-     | rule hoare_drop_imps
-     | simp add: getThreadReplySlot_def o_def if_fun_split)+
-done
+  "cancelIPC t \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  unfolding cancelIPC_def Let_def
+  by (wp hoare_vcg_conj_lift delete_one_tcbDomain_obj_at'
+      | wpc
+      | rule hoare_drop_imps
+      | simp add: getThreadReplySlot_def o_def if_fun_split)+
 
 lemma (in delete_one_conc_pre) cancelIPC_tcb_in_cur_domain':
   "\<lbrace>tcb_in_cur_domain' t'\<rbrace> cancelIPC t \<lbrace>\<lambda>_. tcb_in_cur_domain' t'\<rbrace>"
@@ -1234,189 +1176,48 @@ lemma setNotification_weak_sch_act_wf[wp]:
 lemmas ipccancel_weak_sch_act_wfs
     = weak_sch_act_wf_lift[OF _ setCTE_pred_tcb_at']
 
-lemma tcbSchedDequeue_corres':
-  "corres dc (is_etcb_at t) (tcb_at' t and valid_inQ_queues) (tcb_sched_action (tcb_sched_dequeue) t) (tcbSchedDequeue t)"
-  apply (simp only: tcbSchedDequeue_def tcb_sched_action_def)
-  apply (rule corres_symb_exec_r[OF _ _ threadGet_inv, where Q'="\<lambda>rv. tcb_at' t and valid_inQ_queues and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"])
-    defer
-    apply (wp threadGet_obj_at', simp, simp)
-   apply (wp, simp)
-  apply (case_tac queued)
-   defer
-   apply (simp add: unless_def when_def)
-   apply (rule corres_no_failI)
-    apply (wp)
-   apply (clarsimp simp: in_monad ethread_get_def get_etcb_def set_tcb_queue_def is_etcb_at_def state_relation_def gets_the_def gets_def get_def return_def bind_def assert_opt_def get_tcb_queue_def modify_def put_def)
-   apply (subgoal_tac "t \<notin> set (ready_queues a (tcb_domain y) (tcb_priority y))")
-    prefer 2
-    apply (force simp: tcb_sched_dequeue_def valid_inQ_queues_def
-           ready_queues_relation_def obj_at'_def inQ_def projectKO_eq project_inject)
-   apply (simp add: ready_queues_relation_def)
-  apply (simp add: unless_def when_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[where r'="(=)"])
-       apply (rule ethreadget_corres, simp add: etcb_relation_def)
-      apply (simp split del: if_split)
-      apply (rule corres_split_eqr)
-         apply (rule ethreadget_corres, simp add: etcb_relation_def)
-        apply (rule corres_split_eqr[OF getQueue_corres])
-          apply (simp split del: if_split)
-          apply (subst bind_return_unit, rule corres_split[where r'=dc])
-             apply (simp add: tcb_sched_dequeue_def)
-             apply (rule setQueue_corres)
-            apply (rule corres_split_noop_rhs)
-              apply (clarsimp, rule removeFromBitmap_corres_noop)
-             apply (simp add: dc_def[symmetric])
-             apply (rule threadSet_corres_noop, simp_all add: tcb_relation_def exst_same_def)[1]
-            apply (wp | simp)+
-  done
-
-lemma setQueue_valid_inQ_queues:
-  "\<lbrace>valid_inQ_queues
-      and (\<lambda>s. \<forall>t \<in> set ts. obj_at' (inQ d p) t s)
-      and K (distinct ts)\<rbrace>
-  setQueue d p ts
-  \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  apply (simp add: setQueue_def valid_inQ_queues_def)
-  apply wp
-  apply clarsimp
-  done
-
-lemma threadSet_valid_inQ_queues:
-  "\<lbrace>valid_inQ_queues and (\<lambda>s. \<forall>d p. (\<exists>tcb. (inQ d p tcb) \<and> \<not>(inQ d p (f tcb)))
-                        \<longrightarrow> obj_at' (\<lambda>tcb. (inQ d p tcb) \<and> \<not>(inQ d p (f tcb))) t s
-                        \<longrightarrow> t \<notin> set (ksReadyQueues s (d, p)))\<rbrace>
-     threadSet f t
-   \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (simp add: threadSet_def)
-  apply wp
-   apply (simp add: valid_inQ_queues_def pred_tcb_at'_def)
-   apply (wp setObject_queues_unchanged_tcb
-             hoare_Ball_helper
-             hoare_vcg_all_lift
-             setObject_tcb_strongest)[1]
-  apply (wp getObject_tcb_wp)
-  apply (clarsimp simp: valid_inQ_queues_def pred_tcb_at'_def)
-  apply (clarsimp simp: obj_at'_def projectKOs)
-  apply (fastforce)
-  done
-
-(* reorder the threadSet before the setQueue, useful for lemmas that don't refer to bitmap *)
-lemma setQueue_after_addToBitmap:
-  "(setQueue d p q >>= (\<lambda>rv. (when P (addToBitmap d p)) >>= (\<lambda>rv. threadSet f t))) =
-   (when P (addToBitmap d p) >>= (\<lambda>rv. (threadSet f t) >>= (\<lambda>rv. setQueue d p q)))"
-  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 (simp add: threadSet_def getObject_def setObject_def
-                   loadObject_default_def bitmap_fun_defs
-                   split_def projectKO_def2 alignCheck_assert
-                   magnitudeCheck_assert updateObject_default_def)
-  apply (intro oblivious_bind, simp_all)
-  apply (clarsimp simp: bind_assoc)
-  done
-
-lemma tcbSchedEnqueue_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> tcbSchedEnqueue t \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def setQueue_after_addToBitmap)
-  apply (rule hoare_pre)
-   apply (rule_tac B="\<lambda>rv. valid_inQ_queues and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"
-                in hoare_seq_ext)
-    apply (rename_tac queued)
-    apply (case_tac queued, simp_all add: unless_def)[1]
-     apply (wp setQueue_valid_inQ_queues threadSet_valid_inQ_queues threadGet_wp
-               hoare_vcg_const_Ball_lift
-          | simp add: inQ_def bitmap_fun_defs
-          | fastforce simp: valid_inQ_queues_def inQ_def obj_at'_def)+
-  done
-
- (* prevents wp from splitting on the when; stronger technique than hoare_when_weak_wp
-    FIXME: possible to replace with hoare_when_weak_wp?
- *)
-definition
-  "removeFromBitmap_conceal d p q t \<equiv> when (null [x\<leftarrow>q . x \<noteq> t]) (removeFromBitmap d p)"
-
-lemma removeFromBitmap_conceal_valid_inQ_queues[wp]:
-  "\<lbrace> valid_inQ_queues \<rbrace> removeFromBitmap_conceal d p q t \<lbrace> \<lambda>_. valid_inQ_queues \<rbrace>"
-  unfolding valid_inQ_queues_def removeFromBitmap_conceal_def
-  by (wp|clarsimp simp: bitmap_fun_defs)+
-
-lemma rescheduleRequired_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> rescheduleRequired \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply wpsimp
-  done
-
-lemma sts_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> setThreadState st t \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (simp add: setThreadState_def)
-  apply (wp threadSet_valid_inQ_queues [THEN hoare_strengthen_post])
-   apply (clarsimp simp: sch_act_simple_def Invariants_H.valid_queues_def inQ_def)+
-  done
-
 lemma updateObject_ep_inv:
   "\<lbrace>P\<rbrace> updateObject (obj::endpoint) ko p q n \<lbrace>\<lambda>rv. P\<rbrace>"
   by simp (rule updateObject_default_inv)
 
-lemma sbn_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> setBoundNotification ntfn t \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (simp add: setBoundNotification_def)
-  apply (wp threadSet_valid_inQ_queues [THEN hoare_strengthen_post])
-   apply (clarsimp simp: sch_act_simple_def Invariants_H.valid_queues_def inQ_def)+
+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>"
+  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 setEndpoint_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> setEndpoint ptr ep \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (unfold setEndpoint_def)
-  apply (rule setObject_ep_pre)
-  apply (simp add: valid_inQ_queues_def)
-  apply (wp hoare_Ball_helper hoare_vcg_all_lift setObject_queues_unchanged[OF updateObject_ep_inv])
-  apply simp
-  done
+context begin interpretation Arch .
 
-lemma set_ntfn_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> setNotification ptr ntfn \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (unfold setNotification_def)
-  apply (rule setObject_ntfn_pre)
-  apply (simp add: valid_inQ_queues_def)
-  apply (wpsimp wp: hoare_Ball_helper hoare_vcg_all_lift simp: updateObject_default_def in_monad)
-  done
+crunches cancel_ipc
+  for pspace_aligned[wp]: "pspace_aligned :: det_state \<Rightarrow> _"
+  and pspace_distinct[wp]: "pspace_distinct :: det_state \<Rightarrow> _"
+  (simp: crunch_simps wp: crunch_wps)
 
-crunch valid_inQ_queues[wp]: cancelSignal valid_inQ_queues
-  (simp: updateObject_tcb_inv crunch_simps wp: crunch_wps)
+end
 
-lemma (in delete_one_conc_pre) cancelIPC_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> cancelIPC t \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  apply (simp add: cancelIPC_def Let_def getThreadReplySlot_def)
-  apply (wp hoare_drop_imps delete_one_inQ_queues threadSet_valid_inQ_queues | wpc | simp add:if_apply_def2 Fun.comp_def)+
-   apply (clarsimp simp: valid_inQ_queues_def inQ_def)+
-   done
+crunches asUser
+  for valid_sched_pointers[wp]: valid_sched_pointers
+  (wp: crunch_wps)
 
-lemma valid_queues_inQ_queues:
-  "Invariants_H.valid_queues s \<Longrightarrow> valid_inQ_queues s"
-  by (force simp: Invariants_H.valid_queues_def valid_inQ_queues_def obj_at'_def
-                  valid_queues_no_bitmap_def)
+crunches set_thread_state
+  for in_correct_ready_q[wp]: in_correct_ready_q
+  (wp: crunch_wps ignore_del: set_thread_state_ext)
 
-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>"
-  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
+crunches set_thread_state_ext
+  for ready_qs_distinct[wp]: ready_qs_distinct
+  (wp: crunch_wps ignore_del: set_thread_state_ext)
 
-lemma asUser_valid_inQ_queues[wp]:
-  "\<lbrace> valid_inQ_queues \<rbrace> asUser t f \<lbrace>\<lambda>rv. valid_inQ_queues \<rbrace>"
-  unfolding valid_inQ_queues_def Ball_def
-  apply (wpsimp wp: hoare_vcg_all_lift)
-    defer
-    apply (wp asUser_ksQ)
-   apply assumption
-  apply (simp add: inQ_def[abs_def] obj_at'_conj)
-  apply (rule hoare_convert_imp)
-   apply (wp asUser_ksQ)
-  apply wp
-  done
+lemma set_thread_state_ready_qs_distinct[wp]:
+  "set_thread_state ref ts \<lbrace>ready_qs_distinct\<rbrace>"
+  unfolding set_thread_state_def
+  apply (wpsimp wp: set_object_wp)
+  by (clarsimp simp: ready_qs_distinct_def)
+
+lemma as_user_ready_qs_distinct[wp]:
+  "as_user tptr f \<lbrace>ready_qs_distinct\<rbrace>"
+  unfolding as_user_def
+  apply (wpsimp wp: set_object_wp)
+  by (clarsimp simp: ready_qs_distinct_def)
 
 lemma (in delete_one) suspend_corres:
   "corres dc (einvs and tcb_at t) (invs' and tcb_at' t)
@@ -1439,25 +1240,28 @@ lemma (in delete_one) suspend_corres:
            apply (rule corres_return_trivial)
           apply (rule corres_split_nor[OF setThreadState_corres])
              apply simp
-            apply (rule tcbSchedDequeue_corres')
+            apply (rule tcbSchedDequeue_corres)
            apply (wpsimp simp: update_restart_pc_def updateRestartPC_def)+
-       apply (rule hoare_post_imp[where Q = "\<lambda>rv s. tcb_at t s \<and> is_etcb_at t s"])
-        apply simp
+          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>_ 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>rv s. tcb_at' t s \<and> valid_inQ_queues s"])
-       apply (wpsimp simp: valid_queues_inQ_queues)
-      apply wp+
-   apply (force simp: valid_sched_def tcb_at_is_etcb_at)
-  apply (clarsimp simp add: invs'_def valid_state'_def valid_queues_inQ_queues)
+      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
 
 context begin interpretation Arch .
 
 lemma archThreadGet_corres:
   "(\<And>a a'. arch_tcb_relation a a' \<Longrightarrow> f a = f' a') \<Longrightarrow>
-   corres (=) (tcb_at t) (tcb_at' t) (arch_thread_get f t) (archThreadGet f' t)"
+   corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+              (arch_thread_get f t) (archThreadGet f' t)"
   unfolding arch_thread_get_def archThreadGet_def
-  apply (corresKsimp corres: get_tcb_corres)
+  apply (corresKsimp corres: getObject_TCB_corres)
   apply (clarsimp simp: tcb_relation_def)
   done
 
@@ -1466,7 +1270,8 @@ lemma tcb_vcpu_relation:
   unfolding arch_tcb_relation_def by auto
 
 lemma archThreadGet_VCPU_corres[corres]:
-  "corres (=) (tcb_at t) (tcb_at' t) (arch_thread_get tcb_vcpu t) (archThreadGet atcbVCPUPtr t)"
+  "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+     (arch_thread_get tcb_vcpu t) (archThreadGet atcbVCPUPtr t)"
   by (rule archThreadGet_corres) (erule tcb_vcpu_relation)
 
 lemma when_fail_assert:
@@ -1498,16 +1303,19 @@ lemma tcb_ko_at':
 
 lemma archThreadSet_corres:
   "(\<And>a a'. arch_tcb_relation a a' \<Longrightarrow> arch_tcb_relation (f a) (f' a')) \<Longrightarrow>
-  corres dc (tcb_at t) (tcb_at' t) (arch_thread_set f t) (archThreadSet f' t)"
+   corres dc (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+     (arch_thread_set f t) (archThreadSet f' t)"
   apply (simp add: arch_thread_set_def archThreadSet_def)
-  apply (corresK corres: get_tcb_corres setObject_update_TCB_corres')
+  apply (corresK corres: getObject_TCB_corres setObject_update_TCB_corres')
   apply wpsimp+
   apply (auto simp add: tcb_relation_def tcb_cap_cases_def tcb_cte_cases_def exst_same_def)+
   done
 
 lemma archThreadSet_VCPU_None_corres[corres]:
-  "t = t' \<Longrightarrow> corres dc (tcb_at t) (tcb_at' t')
-    (arch_thread_set (tcb_vcpu_update Map.empty) t) (archThreadSet (atcbVCPUPtr_update Map.empty) t')"
+  "t = t' \<Longrightarrow>
+   corres dc (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+     (arch_thread_set (tcb_vcpu_update Map.empty) t)
+     (archThreadSet (atcbVCPUPtr_update Map.empty) t')"
   apply simp
   apply (rule archThreadSet_corres)
   apply (simp add: arch_tcb_relation_def)
@@ -1523,13 +1331,15 @@ lemmas corresK_as_user' =
   asUser_corres'[atomized, THEN corresK_lift_rule, THEN mp]
 
 lemma asUser_sanitiseRegister_corres[corres]:
-  "b=b' \<Longrightarrow> t = t' \<Longrightarrow> corres dc (tcb_at t) (tcb_at' t')
-            (as_user t (do cpsr \<leftarrow> getRegister CPSR;
-                           setRegister CPSR (sanitise_register b CPSR cpsr)
-                        od))
-            (asUser t' (do cpsr \<leftarrow> getRegister CPSR;
-                          setRegister CPSR (sanitiseRegister b' CPSR cpsr)
-                       od))"
+  "b=b' \<Longrightarrow> t = t' \<Longrightarrow>
+   corres dc
+     (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+     (as_user t (do cpsr \<leftarrow> getRegister CPSR;
+                    setRegister CPSR (sanitise_register b CPSR cpsr)
+                 od))
+     (asUser t' (do cpsr \<leftarrow> getRegister CPSR;
+                    setRegister CPSR (sanitiseRegister b' CPSR cpsr)
+                 od))"
   unfolding sanitiseRegister_def sanitise_register_def
   apply (corresKsimp corresK: corresK_as_user')
   done
@@ -1548,23 +1358,22 @@ lemma imp_drop_strg:
 
 lemma dissociateVCPUTCB_corres [@lift_corres_args, corres]:
   "corres dc (obj_at (\<lambda>ko. \<exists>tcb. ko = TCB tcb \<and> tcb_vcpu (tcb_arch tcb) = Some v) t and
-              obj_at (\<lambda>ko. \<exists>vcpu. ko = ArchObj (VCPU vcpu) \<and> vcpu_tcb vcpu = Some t) v)
-             (tcb_at' t and vcpu_at' v and no_0_obj')
+              obj_at (\<lambda>ko. \<exists>vcpu. ko = ArchObj (VCPU vcpu) \<and> vcpu_tcb vcpu = Some t) v and
+              pspace_aligned and pspace_distinct)
+             (vcpu_at' v and no_0_obj')
              (dissociate_vcpu_tcb v t) (dissociateVCPUTCB v t)"
   unfolding dissociate_vcpu_tcb_def dissociateVCPUTCB_def
-  apply (clarsimp simp:  bind_assoc when_fail_assert opt_case_when)
-  apply (corresKsimp corres: getObject_vcpu_corres setObject_VCPU_corres get_tcb_corres)
-  apply (wpsimp wp: arch_thread_get_wp
-      simp: archThreadSet_def tcb_ko_at' tcb_at_typ_at'
-      | strengthen imp_drop_strg[where Q="tcb_at t s" for s]
-        imp_drop_strg[where Q="vcpu_at' v s \<and> typ_at' TCBT t s" for s]
-      | corresK_rv)+
-  apply (corresKsimp wp: get_vcpu_wp getVCPU_wp getObject_tcb_wp arch_thread_get_wp corres_rv_wp_left
-      simp: archThreadGet_def tcb_ko_at')+
+  apply (clarsimp simp: when_fail_assert opt_case_when)
+  apply (corresKsimp corres: getObject_vcpu_corres setObject_VCPU_corres getObject_TCB_corres)
+                   apply (wpsimp wp: arch_thread_get_wp
+                               simp: archThreadSet_def tcb_ko_at' tcb_at_typ_at'
+                          | corresK_rv)+
+  apply (corresKsimp wp: get_vcpu_wp getVCPU_wp getObject_tcb_wp arch_thread_get_wp
+                   simp: archThreadGet_def tcb_ko_at')+
   apply (clarsimp simp: typ_at_tcb' typ_at_to_obj_at_arches)
   apply normalise_obj_at'
   apply (clarsimp simp: obj_at_def is_tcb vcpu_relation_def tcb_relation_def
-      arch_tcb_relation_def vgic_map_def )
+                        arch_tcb_relation_def vgic_map_def obj_at'_def)
   done
 
 lemma sym_refs_tcb_vcpu:
@@ -1586,6 +1395,9 @@ lemma prepareThreadDelete_corres:
     apply (wp arch_thread_get_wp)
    apply (wpsimp wp: getObject_tcb_wp simp: archThreadGet_def)
   apply clarsimp
+  apply (frule invs_psp_aligned)
+  apply (frule invs_distinct)
+  apply clarsimp
   apply (rule conjI)
    apply clarsimp
    apply (frule (1) sym_refs_tcb_vcpu, fastforce)
@@ -1613,265 +1425,8 @@ lemma (in delete_one_conc_pre) cancelIPC_it[wp]:
   apply (wp hoare_drop_imps delete_one_it | wpc | simp add:if_apply_def2 Fun.comp_def)+
   done
 
-crunch ksQ: threadGet "\<lambda>s. P (ksReadyQueues s p)"
-
-lemma tcbSchedDequeue_notksQ:
-  "\<lbrace>\<lambda>s. t' \<notin> set(ksReadyQueues s p)\<rbrace>
-    tcbSchedDequeue t
-   \<lbrace>\<lambda>_ s. t' \<notin> set(ksReadyQueues s p)\<rbrace>"
-  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+
-     apply clarsimp
-     apply (rule_tac Q="\<lambda>_ s. t' \<notin> set(ksReadyQueues s p)" in hoare_post_imp)
-      apply (wp | clarsimp)+
-  done
-
-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 B="\<lambda>rv s. (rv = ResumeCurrentThread \<or> rv = ChooseNewThread)
-                       \<and> ?OAQ t' p s" in hoare_seq_ext)
-   including classic_wp_pre
-   apply (wp | clarsimp)+
-   apply (case_tac x)
-     apply (wp | clarsimp)+
-  done
-
-lemma setThreadState_oa_queued:
-  "\<lbrace>\<lambda>s. P' (obj_at' (\<lambda>tcb. P (tcbQueued tcb) (tcbDomain tcb) (tcbPriority tcb)) t' s) \<rbrace>
-    setThreadState st 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> setThreadState st t \<lbrace>\<lambda>_. ?Q R \<rbrace>"
-      apply (simp add: setThreadState_def)
-      apply (wp rescheduleRequired_oa_queued)
-      apply (simp add: sch_act_simple_def)
-      apply (rule_tac Q="\<lambda>_. ?Q R" in hoare_post_imp, clarsimp)
-      apply (wp threadSet_obj_at'_strongish)
-      apply (clarsimp)
-      done
-    show "\<lbrace>\<lambda>s. \<not> ?Q P s\<rbrace> setThreadState st t \<lbrace>\<lambda>_ s. \<not> ?Q P s\<rbrace>"
-      by (simp add: not_obj_at' comp_def, wp hoare_convert_imp pos)
-  qed
-
-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 tcbSchedDequeue_ksQ_distinct[wp]:
-  "\<lbrace>\<lambda>s. distinct (ksReadyQueues s p)\<rbrace>
-    tcbSchedDequeue t
-   \<lbrace>\<lambda>_ s. distinct (ksReadyQueues s p)\<rbrace>"
-  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+
-     apply (rule_tac Q="\<lambda>_ s. distinct (ksReadyQueues s p)" in hoare_post_imp)
-      apply (clarsimp | wp)+
-  done
-
-lemma sts_valid_queues_partial:
-  "\<lbrace>Invariants_H.valid_queues and sch_act_simple\<rbrace>
-    setThreadState st t
-   \<lbrace>\<lambda>_ s. \<forall>t' d p.
-            (t' \<in> set(ksReadyQueues s (d, p)) \<longrightarrow>
-             (obj_at' (\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d \<and> tcbPriority tcb = p) t' s
-              \<and> (t' \<noteq> t \<longrightarrow> st_tcb_at' runnable' t' s)))
-            \<and> distinct (ksReadyQueues s (d, p))\<rbrace>"
-  (is "\<lbrace>_\<rbrace> _ \<lbrace>\<lambda>_ s. \<forall>t' d p. ?OA t' d p s \<and> ?DISTINCT d p s \<rbrace>")
-  apply (rule_tac Q="\<lambda>_ s. (\<forall>t' d p. ?OA t' d p s) \<and> (\<forall>d p. ?DISTINCT d p s)"
-           in hoare_post_imp)
-   apply (clarsimp)
-  apply (rule hoare_conjI)
-   apply (rule_tac Q="\<lambda>s. \<forall>t' d p.
-             ((t'\<in>set(ksReadyQueues s (d, p))
-               \<or> \<not> (sch_act_simple s))
-                  \<longrightarrow> (obj_at'(\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d \<and> tcbPriority tcb = p) t' s
-                       \<and> st_tcb_at' runnable' t' s))" in hoare_pre_imp)
-    apply (fastforce simp: Invariants_H.valid_queues_def valid_queues_no_bitmap_def
-                           pred_tcb_at'_def obj_at'_def inQ_def)
-   apply (rule hoare_vcg_all_lift)+
-    apply (rule hoare_convert_imp)
-     including classic_wp_pre
-     apply (wp sts_ksQ setThreadState_oa_queued hoare_impI sts_pred_tcb_neq'
-            | clarsimp)+
-  apply (rule_tac Q="\<lambda>s. \<forall>d p. ?DISTINCT d p s \<and> sch_act_simple s" in hoare_pre_imp)
-   apply (clarsimp simp: Invariants_H.valid_queues_def valid_queues_no_bitmap_def)
-  apply (wp hoare_vcg_all_lift sts_ksQ)
-  apply (clarsimp)
-  done
-
-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 Q="(\<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)
-  done
-
-lemma sts_invs_minor'_no_valid_queues:
-  "\<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. runnable' st \<and> obj_at' tcbQueued t s \<longrightarrow> st_tcb_at' runnable' t s)
-      and sch_act_simple
-      and invs'\<rbrace>
-    setThreadState st t
-   \<lbrace>\<lambda>_ s. (\<forall>t' d p.
-            (t' \<in> set(ksReadyQueues s (d, p)) \<longrightarrow>
-             (obj_at' (\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d \<and> tcbPriority tcb = p) t' s
-              \<and> (t' \<noteq> t \<longrightarrow> st_tcb_at' runnable' t' s)))
-            \<and> distinct (ksReadyQueues s (d, p)) \<and> (maxDomain < d \<or> maxPriority < p \<longrightarrow> ksReadyQueues s (d, p) = [])) \<and>
-         valid_bitmapQ s \<and>
-         bitmapQ_no_L2_orphans s \<and>
-         bitmapQ_no_L1_orphans s \<and>
-         valid_pspace' s \<and>
-         sch_act_wf (ksSchedulerAction s) s \<and>
-         sym_refs (state_refs_of' s) \<and>
-         sym_refs (state_hyp_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>
-         valid_queues' 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 \<and>
-         cur_tcb' s \<and>
-         tcb_at' t s\<rbrace>"
-  apply (simp add: invs'_def valid_state'_def valid_queues_def)
-  apply (wp sts_valid_queues_partial sts_ksQ
-            setThreadState_oa_queued sts_st_tcb_at'_cases
-            irqs_masked_lift
-            valid_irq_node_lift
-            setThreadState_ct_not_inQ
-            sts_valid_bitmapQ_sch_act_simple
-            sts_valid_bitmapQ_no_L2_orphans_sch_act_simple
-            sts_valid_bitmapQ_no_L1_orphans_sch_act_simple
-            hoare_vcg_conj_lift hoare_vcg_imp_lift hoare_vcg_all_lift)+
-  apply (clarsimp simp: disj_imp)
-  apply (intro conjI)
-        apply (clarsimp simp: valid_queues_def)
-        apply (rule conjI, clarsimp)
-         apply (drule valid_queues_no_bitmap_objD, assumption)
-         apply (clarsimp simp: inQ_def comp_def)
-         apply (rule conjI)
-          apply (erule obj_at'_weaken)
-          apply (simp add: inQ_def)
-         apply (clarsimp simp: st_tcb_at'_def)
-         apply (erule obj_at'_weaken)
-         apply (simp add: inQ_def)
-        apply (simp add: valid_queues_no_bitmap_def)
-       apply clarsimp
-     apply (clarsimp simp: st_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 (fastforce simp: valid_tcb_state'_def
-                  split: Structures_H.thread_state.splits)
-    apply (clarsimp dest!: st_tcb_at_state_refs_ofD'
-                    elim!: rsubst[where P=sym_refs]
-                   intro!: ext)
-   apply (fastforce simp: valid_queues_def inQ_def pred_tcb_at' pred_tcb_at'_def
-                   elim!: st_tcb_ex_cap'' obj_at'_weakenE)+
-  done
-
 crunch ct_idle_or_in_cur_domain'[wp]: tcbSchedDequeue ct_idle_or_in_cur_domain'
-
-lemma tcbSchedDequeue_invs'_no_valid_queues:
-   "\<lbrace>\<lambda>s. (\<forall>t' d p.
-            (t' \<in> set(ksReadyQueues s (d, p)) \<longrightarrow>
-             (obj_at' (\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d \<and> tcbPriority tcb = p) t' s
-              \<and> (t' \<noteq> t \<longrightarrow> st_tcb_at' runnable' t' s)))
-            \<and> distinct (ksReadyQueues s (d, p)) \<and> (maxDomain < d \<or> maxPriority < p \<longrightarrow> ksReadyQueues s (d, p) = [])) \<and>
-         valid_bitmapQ s \<and>
-         bitmapQ_no_L2_orphans s \<and>
-         bitmapQ_no_L1_orphans s \<and>
-         valid_pspace' s \<and>
-         sch_act_wf (ksSchedulerAction s) s \<and>
-         sym_refs (state_refs_of' s) \<and>
-         sym_refs (state_hyp_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>
-         valid_queues' 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 \<and>
-         cur_tcb' s \<and>
-         tcb_at' t s\<rbrace>
-    tcbSchedDequeue t
-   \<lbrace>\<lambda>_. invs' \<rbrace>"
-  apply (simp add: invs'_def valid_state'_def)
-  apply (wp tcbSchedDequeue_valid_queues_weak valid_irq_handlers_lift
-            valid_irq_node_lift valid_irq_handlers_lift'
-            tcbSchedDequeue_irq_states irqs_masked_lift cur_tcb_lift
-            untyped_ranges_zero_lift
-         | clarsimp simp add: cteCaps_of_def valid_queues_def o_def)+
-  apply (rule conjI)
-   apply (fastforce simp: obj_at'_def inQ_def st_tcb_at'_def valid_queues_no_bitmap_except_def)
-  apply (rule conjI, clarsimp simp: correct_queue_def)
-  apply (fastforce simp: valid_pspace'_def intro: obj_at'_conjI
-                   elim: valid_objs'_maxDomain valid_objs'_maxPriority)
-  done
-
-lemmas sts_tcbSchedDequeue_invs' =
-  sts_invs_minor'_no_valid_queues
-  tcbSchedDequeue_invs'_no_valid_queues
+  (wp: crunch_wps)
 
 lemma asUser_sch_act_simple[wp]:
   "\<lbrace>sch_act_simple\<rbrace> asUser s t \<lbrace>\<lambda>_. sch_act_simple\<rbrace>"
@@ -1883,11 +1438,14 @@ lemma (in delete_one_conc) suspend_invs'[wp]:
   "\<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 (wp sts_tcbSchedDequeue_invs')
-      apply (simp add: updateRestartPC_def | strengthen no_refs_simple_strg')+
-      prefer 2
-    apply (wpsimp wp: hoare_drop_imps hoare_vcg_imp_lift'
-           | strengthen no_refs_simple_strg')+
+  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]:
@@ -1932,109 +1490,6 @@ lemma (in delete_one_conc_pre) suspend_st_tcb_at':
 lemmas (in delete_one_conc_pre) suspend_makes_simple' =
        suspend_st_tcb_at' [where P=simple', simplified]
 
-lemma valid_queues_not_runnable'_not_ksQ:
-  assumes "Invariants_H.valid_queues s" and "st_tcb_at' (Not \<circ> runnable') t s"
-  shows   "\<forall>d p. t \<notin> set (ksReadyQueues s (d, p))"
-  using assms
-  apply -
-  apply (clarsimp simp: Invariants_H.valid_queues_def valid_queues_no_bitmap_def pred_tcb_at'_def)
-  apply (erule_tac x=d in allE)
-  apply (erule_tac x=p in allE)
-  apply (clarsimp)
-  apply (drule(1) bspec)
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-declare valid_queues_not_runnable'_not_ksQ[OF ByAssum, simp]
-
-lemma cancelSignal_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues and st_tcb_at' (Not \<circ> runnable') t\<rbrace>
-   cancelSignal t ae \<lbrace>\<lambda>_. Invariants_H.valid_queues \<rbrace>"
-  apply (simp add: cancelSignal_def)
-  apply (wp sts_valid_queues)
-      apply (rule_tac Q="\<lambda>_ s. \<forall>p. t \<notin> set (ksReadyQueues s p)" in hoare_post_imp, simp)
-      apply (wp hoare_vcg_all_lift)
-     apply (wpc)
-      apply (wp)+
-   apply (rule_tac Q="\<lambda>_ s. Invariants_H.valid_queues s \<and> (\<forall>p. t \<notin> set (ksReadyQueues s p))" in hoare_post_imp)
-    apply (clarsimp)
-   apply (wp)
-  apply (clarsimp)
-  done
-
-lemma (in delete_one_conc_pre) cancelIPC_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)\<rbrace>
-   cancelIPC t \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: cancelIPC_def Let_def getThreadReplySlot_def
-             cong: Structures_H.thread_state.case_cong list.case_cong)
-  apply (rule hoare_seq_ext [OF _ gts_sp'])
-  apply (rule hoare_pre)
-   apply (wpc
-           | wp hoare_vcg_conj_lift delete_one_queues threadSet_valid_queues
-                threadSet_valid_objs' sts_valid_queues setEndpoint_ksQ
-                hoare_vcg_all_lift threadSet_sch_act threadSet_weak_sch_act_wf
-           | simp add: o_def if_apply_def2 inQ_def
-           | rule hoare_drop_imps
-           | clarsimp simp: valid_tcb'_def tcb_cte_cases_def
-                     elim!: pred_tcb'_weakenE)+
-  apply (fastforce dest: valid_queues_not_runnable'_not_ksQ elim: pred_tcb'_weakenE)
-  done
-
-(* FIXME: move to Schedule_R *)
-lemma tcbSchedDequeue_nonq[wp]:
-  "\<lbrace>Invariants_H.valid_queues and tcb_at' t and K (t = t')\<rbrace>
-    tcbSchedDequeue t \<lbrace>\<lambda>_ s. \<forall>d p. t' \<notin> set (ksReadyQueues s (d, p))\<rbrace>"
-  apply (rule hoare_gen_asm)
-  apply (simp add: tcbSchedDequeue_def)
-  apply (wp threadGet_wp|simp)+
-  apply (fastforce simp: Invariants_H.valid_queues_def valid_queues_no_bitmap_def obj_at'_def projectKOs inQ_def)
-  done
-
-lemma sts_ksQ_oaQ:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace>
-   setThreadState st t
-   \<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>"
-  (is "\<lbrace>_\<rbrace> _ \<lbrace>\<lambda>_. ?POST\<rbrace>")
-  proof -
-    have RR: "\<lbrace>sch_act_simple and ?POST\<rbrace> rescheduleRequired \<lbrace>\<lambda>_. ?POST\<rbrace>"
-      apply (simp add: rescheduleRequired_def)
-      apply (wp)
-        apply (clarsimp)
-       apply (rule_tac
-                Q="(\<lambda>s. action = ResumeCurrentThread \<or> action = ChooseNewThread) and ?POST"
-                                                               in hoare_pre_imp, assumption)
-       apply (case_tac action)
-         apply (clarsimp)+
-      apply (wp)
-      apply (clarsimp simp: sch_act_simple_def)
-      done
-    show ?thesis
-      apply (simp add: setThreadState_def)
-      apply (wp RR)
-      apply (rule_tac Q="\<lambda>_. ?POST" in hoare_post_imp)
-       apply (clarsimp simp add: sch_act_simple_def)
-      apply (wp hoare_convert_imp)
-      apply (clarsimp simp: Invariants_H.valid_queues_def valid_queues_no_bitmap_def)
-      apply (drule_tac x=d in spec)
-      apply (drule_tac x=p in spec)
-      apply (fastforce dest: bspec elim!: obj_at'_weakenE simp: inQ_def)
-      done
-  qed
-
-lemma (in delete_one_conc_pre) suspend_nonq:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and tcb_at' t
-                 and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
-                 and (\<lambda>s. t \<noteq> ksIdleThread s) and K (t = t')\<rbrace>
-     suspend t
-   \<lbrace>\<lambda>rv s. \<forall>d p. t' \<notin> set (ksReadyQueues s (d, p))\<rbrace>"
-  apply (rule hoare_gen_asm)
-  apply (simp add: suspend_def unless_def)
-  unfolding updateRestartPC_def
-  apply (wp hoare_allI tcbSchedDequeue_t_notksQ sts_ksQ_oaQ)
-    apply wpsimp+
-  done
-
 lemma suspend_makes_inactive:
   "\<lbrace>K (t = t')\<rbrace> suspend t \<lbrace>\<lambda>rv. st_tcb_at' ((=) Inactive) t'\<rbrace>"
   apply (cases "t = t'", simp_all)
@@ -2045,31 +1500,21 @@ lemma suspend_makes_inactive:
 declare threadSet_sch_act_sane [wp]
 declare sts_sch_act_sane [wp]
 
-lemma tcbSchedEnqueue_ksQset_weak:
-  "\<lbrace>\<lambda>s. t' \<in> set (ksReadyQueues s p)\<rbrace>
-   tcbSchedEnqueue t
-   \<lbrace>\<lambda>_ s. t' \<in> set (ksReadyQueues s p)\<rbrace>" (is "\<lbrace>?PRE\<rbrace> _ \<lbrace>_\<rbrace>")
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply (wp hoare_vcg_conj_lift hoare_vcg_imp_lift hoare_vcg_if_lift)
-  apply (rule_tac Q="\<lambda>_. ?PRE" in hoare_post_imp, ((wp | clarsimp)+))+
-  done
-
 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 tcbSchedEnqueue_ct', wp, simp)
+  by (rule hoare_weaken_pre, wps, wp, simp)
 
 lemma sts_sch_act_not_ct[wp]:
   "\<lbrace>\<lambda>s. sch_act_not (ksCurThread s) s\<rbrace>
    setThreadState st t \<lbrace>\<lambda>_ s. sch_act_not (ksCurThread s) s\<rbrace>"
-  by (rule hoare_weaken_pre, wps tcbSchedEnqueue_ct', wp, simp)
+  by (rule hoare_weaken_pre, wps, wp, simp)
 
 text \<open>Cancelling all IPC in an endpoint or notification object\<close>
 
 lemma ep_cancel_corres_helper:
-  "corres dc ((\<lambda>s. \<forall>t \<in> set list. tcb_at t s) and valid_etcbs)
-             ((\<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')
+  "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
@@ -2078,28 +1523,34 @@ lemma ep_cancel_corres_helper:
                         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 (rule corres_guard_imp [OF setThreadState_corres])
-            apply simp
-           apply (simp add: valid_tcb_state_def)
-          apply simp
-         apply (wp sts_valid_queues)+
-       apply (force simp: tcb_at_is_etcb_at)
-      apply (fastforce elim: obj_at'_weakenE)
-     apply ((wp hoare_vcg_const_Ball_lift | simp)+)[1]
-    apply (rule hoare_pre)
-     apply (wp hoare_vcg_const_Ball_lift
-               weak_sch_act_wf_lift_linear sts_st_tcb' setThreadState_not_st
-               sts_valid_queues tcbSchedEnqueue_not_st
-          | simp)+
-    apply (auto elim: obj_at'_weakenE simp: valid_tcb_state'_def)
+         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
 
+crunches 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 ep_cancel_corres:
   "corres dc (invs and valid_sched and ep_at ep) (invs' and ep_at' ep)
              (cancel_all_ipc ep) (cancelAllIPC ep)"
@@ -2107,10 +1558,10 @@ proof -
   have P:
     "\<And>list.
      corres dc (\<lambda>s. (\<forall>t \<in> set list. tcb_at t s) \<and> valid_pspace s \<and> ep_at ep s
-                        \<and> valid_etcbs s \<and> weak_valid_sched_action s)
+                        \<and> valid_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> Invariants_H.valid_queues s \<and> valid_queues' s \<and> valid_objs' 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;
@@ -2132,22 +1583,23 @@ proof -
         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 R="\<lambda>_ s. \<forall>x\<in>set list. tcb_at' x s \<and> valid_objs' s"
+      apply (rule_tac R="\<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 (rule hoare_name_pre_state)
-      apply ((wp hoare_vcg_const_Ball_lift mapM_x_wp'
-                sts_valid_queues setThreadState_not_st sts_st_tcb' tcbSchedEnqueue_not_st
-           | clarsimp
-           | fastforce elim: obj_at'_weakenE simp: valid_tcb_state'_def)+)[2]
-    apply (rule hoare_name_pre_state)
+      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 elim!: valid_objs_valid_tcbE))+
+           | (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 (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
@@ -2174,7 +1626,10 @@ lemma set_ntfn_tcb_obj_at' [wp]:
 lemma cancelAllSignals_corres:
   "corres dc (invs and valid_sched and ntfn_at ntfn) (invs' and ntfn_at' ntfn)
              (cancel_all_signals ntfn) (cancelAllSignals ntfn)"
+  supply projectKOs[simp]
   apply (simp add: cancel_all_signals_def cancelAllSignals_def)
+  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+
@@ -2185,22 +1640,27 @@ lemma cancelAllSignals_corres:
       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 setThreadState_not_st
+                 weak_sch_act_wf_lift_linear
                  set_thread_state_runnable_weak_valid_sched_action
             | simp)+
       apply (rename_tac list)
-      apply (rule_tac R="\<lambda>_ s. (\<forall>x\<in>set list. tcb_at' x s) \<and> valid_objs' s"
+      apply (rule_tac R="\<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_queues setThreadState_not_st
-                  simp: valid_tcb_state'_def)
+      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')+
+   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
+          | erule obj_at_valid_objsE | drule ko_at_valid_objs'
+          | fastforce)+
   done
 
 lemma ep'_Idle_case_helper:
@@ -2239,6 +1699,11 @@ proof -
   done
 qed
 
+lemma tcbSchedEnqueue_valid_pspace'[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>valid_pspace'\<rbrace>"
+  unfolding valid_pspace'_def
+  by wpsimp
+
 lemma cancel_all_invs'_helper:
   "\<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}
@@ -2254,8 +1719,7 @@ lemma cancel_all_invs'_helper:
    apply clarsimp
   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_valid_queues sts_st_tcb' setThreadState_not_st
+             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
@@ -2264,7 +1728,7 @@ lemma cancel_all_invs'_helper:
                  elim!: rsubst[where P=sym_refs]
                  dest!: set_mono_suffix
                 intro!: ext
-       | (drule (1) bspec, clarsimp simp: valid_pspace'_def valid_tcb'_def elim!: valid_objs_valid_tcbE))+
+       | (drule (1) bspec, clarsimp simp: valid_pspace'_def valid_tcb'_def))+
   done
 
 lemma ep_q_refs_max:
@@ -2280,22 +1744,10 @@ lemma ep_q_refs_max:
              | case_tac ntfnptr)+
   done
 
-crunch ct' [wp]: setEndpoint "\<lambda>s. P (ksCurThread s)"
-  (wp: setObject_ep_ct)
-
-crunch ct' [wp]: setNotification "\<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>"
+  "rescheduleRequired \<lbrace>invs'\<rbrace>"
   apply (simp add: rescheduleRequired_def)
-  apply (wp ssa_invs' | simp add: invs'_update_cnt | wpc)+
-  apply (clarsimp simp: invs'_def valid_state'_def)
+  apply (wpsimp wp: ssa_invs')
   done
 
 lemma invs_rct_ct_activatable':
@@ -2422,6 +1874,7 @@ lemma rescheduleRequired_all_invs_but_ct_not_inQ:
 lemma cancelAllIPC_invs'[wp]:
   "\<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 hoare_seq_ext[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' getEndpoint_wp
@@ -2445,6 +1898,7 @@ lemma cancelAllIPC_invs'[wp]:
 lemma cancelAllSignals_invs'[wp]:
   "\<lbrace>invs'\<rbrace> cancelAllSignals ntfn \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (simp add: cancelAllSignals_def)
+  apply (rule hoare_seq_ext[OF _ stateAssert_sp])
   apply (rule hoare_seq_ext [OF _ get_ntfn_sp'])
   apply (case_tac "ntfnObj ntfna", simp_all)
     apply (wp, simp)
@@ -2479,12 +1933,14 @@ crunch valid_objs'[wp]: tcbSchedEnqueue 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>"
+  "\<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 hoare_seq_ext[OF _ stateAssert_sp])
   apply (rule hoare_seq_ext [OF _ get_ep_sp'])
   apply (rule hoare_pre)
    apply (wp set_ep_valid_objs' setSchedulerAction_valid_objs')
-    apply (rule_tac Q="\<lambda>rv s. valid_objs' s \<and> (\<forall>x\<in>set (epQueue ep). tcb_at' x s)"
+    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)
@@ -2501,8 +1957,9 @@ lemma cancelAllIPC_valid_objs'[wp]:
   done
 
 lemma cancelAllSignals_valid_objs'[wp]:
-  "\<lbrace>valid_objs'\<rbrace> cancelAllSignals ntfn \<lbrace>\<lambda>rv. valid_objs'\<rbrace>"
+  "\<lbrace>valid_objs' and pspace_aligned' and pspace_distinct'\<rbrace> cancelAllSignals ntfn \<lbrace>\<lambda>rv. valid_objs'\<rbrace>"
   apply (simp add: cancelAllSignals_def)
+  apply (rule hoare_seq_ext[OF _ stateAssert_sp])
   apply (rule hoare_seq_ext [OF _ get_ntfn_sp'])
   apply (case_tac "ntfnObj ntfna", simp_all)
     apply (wp, simp)
@@ -2555,19 +2012,17 @@ 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>"
-  apply (simp add: setThreadState_def setQueue_def
-                   rescheduleRequired_def tcbSchedEnqueue_def
-                   unless_def bitmap_fun_defs
-             cong: scheduler_action.case_cong  cong del: if_cong
-            | wp | wpcw)+
-  done
+  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 unless_def)
+  apply (simp add: tcbSchedEnqueue_def tcbQueuePrepend_def unless_def)
   apply (wp | simp add: setQueue_def bitmap_fun_defs)+
   done
 
@@ -2601,19 +2056,42 @@ lemma setObject_ko_wp_at':
                      objBits_def[symmetric] ps_clear_upd
                      in_magnitude_check v projectKOs)
 
-lemma rescheduleRequired_unlive:
-  "\<lbrace>\<lambda>s. ko_wp_at' (Not \<circ> live') p s \<and> ksSchedulerAction s \<noteq> SwitchToThread p\<rbrace>
-      rescheduleRequired
+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>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | simp | wpc)+
-   apply (simp add: tcbSchedEnqueue_def unless_def
-                    threadSet_def setQueue_def threadGet_def)
-   apply (wp setObject_ko_wp_at getObject_tcb_wp
-            | simp add: objBits_simps' bitmap_fun_defs split del: if_split)+
-  apply (clarsimp simp: o_def)
-  apply (drule obj_at_ko_at')
-  apply clarsimp
+  by (clarsimp simp: threadSet_def valid_def getObject_def
+                     setObject_def in_monad loadObject_default_def
+                     ko_wp_at'_def split_def in_magnitude_check
+                     objBits_simps' updateObject_default_def
+                     ps_clear_upd live'_def projectKOs)
+
+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>"
+  supply projectKOs[simp]
+  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 live'_def
+                   split: option.splits)
+  done
+
+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>"
+  supply comp_apply[simp del]
+  unfolding rescheduleRequired_def
+  apply (wpsimp wp: tcbSchedEnqueue_unlive_other)
   done
 
 lemmas setEndpoint_ko_wp_at'
@@ -2623,6 +2101,7 @@ 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>"
   apply (simp add: cancelAllIPC_def ep'_Idle_case_helper)
+  apply (rule hoare_seq_ext[OF _ stateAssert_sp])
   apply (rule hoare_seq_ext [OF _ get_ep_sp'])
   apply (rule hoare_pre)
    apply (wp cancelAll_unlive_helper setEndpoint_ko_wp_at'
@@ -2642,6 +2121,7 @@ lemma cancelAllSignals_unlive:
       \<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 (rule hoare_seq_ext[OF _ stateAssert_sp])
   apply (rule hoare_seq_ext [OF _ get_ntfn_sp'])
   apply (case_tac "ntfnObj ntfn", simp_all add: setNotification_def)
     apply wp
@@ -2709,25 +2189,21 @@ lemma cancelBadgedSends_filterM_helper':
   apply (rule hoare_pre)
    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' sts_valid_queues setThreadState_not_st
-             tcbSchedEnqueue_not_st
-             untyped_ranges_zero_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
+  apply (clarsimp simp: valid_pspace'_def cong: conj_cong)
   apply (intro conjI)
-      apply (clarsimp simp: valid_pspace'_def valid_tcb'_def elim!: valid_objs_valid_tcbE dest!: st_tcb_ex_cap'')
-     apply (fastforce dest!: 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)
-    apply (fastforce elim!: obj_atE'
-                      simp: state_refs_of'_def projectKOs tcb_bound_refs'_def
-                            subsetD symreftype_inverse'
-                     split: if_split_asm)+
-  done
+    by (fastforce elim!: obj_atE'
+                  simp: state_refs_of'_def projectKOs tcb_bound_refs'_def
+                        subsetD symreftype_inverse'
+                 split: if_split_asm)+
 
 lemmas cancelBadgedSends_filterM_helper
     = spec [where x=Nil, OF cancelBadgedSends_filterM_helper', simplified]
@@ -2737,7 +2213,8 @@ lemma cancelBadgedSends_invs[wp]:
   shows
   "\<lbrace>invs'\<rbrace> cancelBadgedSends epptr badge \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (simp add: cancelBadgedSends_def)
-  apply (rule hoare_seq_ext [OF _ get_ep_sp'])
+  apply (rule hoare_seq_ext[OF _ stateAssert_sp])
+  apply (rule hoare_seq_ext [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",
@@ -2771,10 +2248,21 @@ crunches tcb_sched_action
   and state_hyp_refs_of[wp]: "\<lambda>s. P (state_hyp_refs_of s)"
   (ignore_del: tcb_sched_action)
 
+lemma setEndpoint_valid_tcbs'[wp]:
+  "setEndpoint ePtr val \<lbrace>valid_tcbs'\<rbrace>"
+  supply projectKOs[simp]
+  unfolding setEndpoint_def
+  apply (wpsimp wp: setObject_valid_tcbs'[where P=\<top>])
+   apply (clarsimp simp: updateObject_default_def monad_simps)
+  apply fastforce
+  done
+
 lemma cancelBadgedSends_corres:
   "corres dc (invs and valid_sched and ep_at epptr) (invs' and ep_at' epptr)
          (cancel_badged_sends epptr bdg) (cancelBadgedSends epptr bdg)"
   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 Q'=invs'])
@@ -2784,10 +2272,16 @@ lemma cancelBadgedSends_corres:
   apply (rule corres_guard_imp)
     apply (rule corres_split_nor[OF setEndpoint_corres])
        apply (simp add: ep_relation_def)
-      apply (rule corres_split_eqr[OF _ _ _ hoare_post_add[where R="\<lambda>_. valid_objs'"]])
+      apply (rule corres_split_eqr[OF _ _ _ hoare_post_add
+                                             [where R="\<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 Q'="\<lambda>xs s. (\<forall>x \<in> set xs. tcb_at' x s) \<and> weak_sch_act_wf (ksSchedulerAction s) s \<and> Invariants_H.valid_queues s \<and> valid_queues' s \<and> valid_objs' 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)
@@ -2798,55 +2292,53 @@ lemma cancelBadgedSends_corres:
                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])
+                 apply (rule corres_split[OF tcbSchedEnqueue_corres], simp)
                    apply (rule corres_trivial)
                    apply simp
                   apply wp+
                apply simp
-               apply (wp sts_valid_queues gts_st_tcb_at)+
+               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: is_tcb_def)
-           apply simp
+           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_queues
+            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 (wp gts_st_tcb_at hoare_vcg_imp_lift mapM_wp'
-                 sts_st_tcb' sts_valid_queues
-                 set_thread_state_runnable_weak_valid_sched_action
-                 | clarsimp simp: valid_tcb_state'_def)+
-    apply (wp hoare_vcg_const_Ball_lift weak_sch_act_wf_lift_linear set_ep_valid_objs'
-               | simp)+
+       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 (drule ko_at_valid_objs', clarsimp)
-   apply (simp add: projectKOs)
-  apply (clarsimp simp: valid_obj'_def valid_ep'_def invs_weak_sch_act_wf
-                        invs'_def valid_state'_def)
+  apply (fastforce simp: valid_ep'_def)
   done
 
+crunches 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 (simp add: threadGet_def| wp getObject_tcb_wp)+
-      apply (rule hoare_strengthen_post, rule hoare_post_taut)
-      apply (fastforce simp: obj_at'_def projectKOs)
-     apply (rule hoare_post_taut)
-    apply wp+
-  done
+  unfolding suspend_def
+  by (wpsimp simp: comp_def wp: tcbSchedDequeue_not_tcbQueued)
 
 crunch no_vcpu[wp]: vcpuInvalidateActive "obj_at' (P::'a:: no_vcpu \<Rightarrow> bool) t"
 
@@ -2888,7 +2380,6 @@ crunch ksQ[wp]: dissociateVCPUTCB "\<lambda>s. P (ksReadyQueues s)"
 
 crunch unqueued: prepareThreadDelete "obj_at' (Not \<circ> tcbQueued) t"
 crunch inactive: prepareThreadDelete "st_tcb_at' ((=) Inactive) t'"
-crunch nonq: prepareThreadDelete " \<lambda>s. \<forall>d p. t' \<notin> set (ksReadyQueues s (d, p))"
 
 end
 end
diff --git a/proof/refine/ARM_HYP/Ipc_R.thy b/proof/refine/ARM_HYP/Ipc_R.thy
index 52cdaa3108..4803ed08d1 100644
--- a/proof/refine/ARM_HYP/Ipc_R.thy
+++ b/proof/refine/ARM_HYP/Ipc_R.thy
@@ -13,9 +13,9 @@ context begin interpretation Arch . (*FIXME: arch_split*)
 lemmas lookup_slot_wrapper_defs'[simp] =
    lookupSourceSlot_def lookupTargetSlot_def lookupPivotSlot_def
 
-lemma getMessageInfo_corres: "corres ((=) \<circ> message_info_map)
-                      (tcb_at t) (tcb_at' t)
-                      (get_message_info t) (getMessageInfo t)"
+lemma getMessageInfo_corres:
+  "corres ((=) \<circ> message_info_map) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+     (get_message_info t) (getMessageInfo t)"
   apply (rule corres_guard_imp)
     apply (unfold get_message_info_def getMessageInfo_def fun_app_def)
     apply (simp add: ARM_HYP_H.msgInfoRegister_def
@@ -766,14 +766,6 @@ lemma tcts_sch_act[wp]:
    \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
   by (wp sch_act_wf_lift tcb_in_cur_domain'_lift transferCapsToSlots_pres1)
 
-lemma tcts_vq[wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> transferCapsToSlots ep buffer n caps slots mi \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  by (wp valid_queues_lift transferCapsToSlots_pres1)
-
-lemma tcts_vq'[wp]:
-  "\<lbrace>valid_queues'\<rbrace> transferCapsToSlots ep buffer n caps slots mi \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  by (wp valid_queues_lift' transferCapsToSlots_pres1)
-
 crunches setExtraBadge
   for state_refs_of'[wp]: "\<lambda>s. P (state_refs_of' s)"
   and state_hyp_refs_of'[wp]: "\<lambda>s. P (state_hyp_refs_of' s)"
@@ -995,6 +987,11 @@ crunch ksDomScheduleIdx[wp]: setExtraBadge "\<lambda>s. P (ksDomScheduleIdx s)"
 crunch ksDomSchedule[wp]: transferCapsToSlots "\<lambda>s. P (ksDomSchedule s)"
 crunch ksDomScheduleIdx[wp]: transferCapsToSlots "\<lambda>s. P (ksDomScheduleIdx s)"
 
+crunches transferCapsToSlots
+  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)
 
 lemma transferCapsToSlots_invs[wp]:
   "\<lbrace>\<lambda>s. invs' s \<and> distinct slots
@@ -1237,18 +1234,12 @@ lemma set_mrs_valid_objs' [wp]:
 crunch valid_objs'[wp]: copyMRs valid_objs'
   (wp: crunch_wps simp: crunch_simps)
 
-crunch valid_queues'[wp]: asUser "Invariants_H.valid_queues'"
-  (simp: crunch_simps wp: hoare_drop_imps)
-
-
 lemma setMRs_invs_bits[wp]:
   "\<lbrace>valid_pspace'\<rbrace> setMRs t buf mrs \<lbrace>\<lambda>rv. valid_pspace'\<rbrace>"
   "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>
      setMRs t buf mrs \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
   "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
      setMRs t buf mrs \<lbrace>\<lambda>rv s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> setMRs t buf mrs \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  "\<lbrace>valid_queues'\<rbrace> setMRs t buf mrs \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
   "\<lbrace>\<lambda>s. P (state_refs_of' s)\<rbrace>
      setMRs t buf mrs
    \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
@@ -1268,8 +1259,6 @@ lemma copyMRs_invs_bits[wp]:
   "\<lbrace>valid_pspace'\<rbrace> copyMRs s sb r rb n \<lbrace>\<lambda>rv. valid_pspace'\<rbrace>"
   "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace> copyMRs s sb r rb n
       \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> copyMRs s sb r rb n \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  "\<lbrace>valid_queues'\<rbrace> copyMRs s sb r rb n \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
   "\<lbrace>\<lambda>s. P (state_refs_of' s)\<rbrace>
       copyMRs s sb r rb n
    \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
@@ -1531,15 +1520,15 @@ lemma msgFromLookupFailure_map[simp]:
   by (cases lf, simp_all add: lookup_failure_map_def msgFromLookupFailure_def)
 
 lemma asUser_getRestartPC_corres:
-  "corres (=) (tcb_at t) (tcb_at' t)
-                 (as_user t getRestartPC) (asUser t getRestartPC)"
+  "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+     (as_user t getRestartPC) (asUser t getRestartPC)"
   apply (rule asUser_corres')
   apply (rule corres_Id, simp, simp)
   apply (rule no_fail_getRestartPC)
   done
 
 lemma asUser_mapM_getRegister_corres:
-  "corres (=) (tcb_at t) (tcb_at' t)
+  "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
      (as_user t (mapM getRegister regs))
      (asUser t (mapM getRegister regs))"
   apply (rule asUser_corres')
@@ -1549,9 +1538,8 @@ lemma asUser_mapM_getRegister_corres:
   done
 
 lemma makeArchFaultMessage_corres:
-  "corres (=) (tcb_at t) (tcb_at' t)
-  (make_arch_fault_msg f t)
-  (makeArchFaultMessage (arch_fault_map f) t)"
+  "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+    (make_arch_fault_msg f t) (makeArchFaultMessage (arch_fault_map f) t)"
   apply (cases f; clarsimp simp: makeArchFaultMessage_def ucast_nat_def split: arch_fault.split)
   apply (rule corres_guard_imp)
     apply (rule corres_split_eqr[OF asUser_getRestartPC_corres])
@@ -1560,7 +1548,7 @@ lemma makeArchFaultMessage_corres:
   done
 
 lemma makeFaultMessage_corres:
-  "corres (=) (tcb_at t) (tcb_at' t)
+  "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
      (make_fault_msg ft t)
      (makeFaultMessage (fault_map ft) t)"
   apply (cases ft, simp_all add: makeFaultMessage_def split del: if_split)
@@ -1632,7 +1620,8 @@ lemmas threadget_fault_corres =
 lemma doFaultTransfer_corres:
   "corres dc
     (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 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)
@@ -1641,7 +1630,8 @@ lemma doFaultTransfer_corres:
                         ARM_HYP_H.badgeRegister_def badge_register_def)
   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"
+                             case_option \<top> in_user_frame recv_buf and
+                             pspace_aligned and pspace_distinct"
               and Q'="\<lambda>fault'. tcb_at' sender and tcb_at' receiver and
                                case_option \<top> valid_ipc_buffer_ptr' recv_buf"
                in corres_underlying_split)
@@ -1779,10 +1769,6 @@ crunch vp[wp]: doIPCTransfer "valid_pspace'"
   (wp: crunch_wps hoare_vcg_const_Ball_lift get_rs_cte_at' wp: transferCapsToSlots_vp simp:ball_conj_distrib )
 crunch sch_act_wf[wp]: doIPCTransfer "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
   (wp: crunch_wps get_rs_cte_at' ignore: transferCapsToSlots  simp: zipWithM_x_mapM)
-crunch vq[wp]: doIPCTransfer "Invariants_H.valid_queues"
-  (wp: crunch_wps get_rs_cte_at' ignore: transferCapsToSlots  simp: zipWithM_x_mapM)
-crunch vq'[wp]: doIPCTransfer "valid_queues'"
-  (wp: crunch_wps get_rs_cte_at' ignore: transferCapsToSlots  simp: zipWithM_x_mapM)
 crunch state_refs_of[wp]: doIPCTransfer "\<lambda>s. P (state_refs_of' s)"
   (wp: crunch_wps get_rs_cte_at' ignore: transferCapsToSlots  simp: zipWithM_x_mapM)
 crunch state_hyp_refs_of[wp]: doIPCTransfer "\<lambda>s. P (state_hyp_refs_of' s)"
@@ -1860,17 +1846,21 @@ crunch nosch[wp]: doIPCTransfer "\<lambda>s. P (ksSchedulerAction s)"
    simp: split_def zipWithM_x_mapM)
 
 lemma arch_getSanitiseRegisterInfo_corres:
-  "corres (=) (tcb_at t) (tcb_at' t)
+  "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
       (arch_get_sanitise_register_info t)
       (getSanitiseRegisterInfo t)"
   unfolding arch_get_sanitise_register_info_def getSanitiseRegisterInfo_def
   apply (fold archThreadGet_def)
   by (corresKsimp corres: archThreadGet_VCPU_corres)
 
+crunches arch_get_sanitise_register_info
+  for pspace_aligned[wp]: pspace_aligned
+  and pspace_distinct[wp]: pspace_distinct
+
 crunch tcb_at'[wp]: getSanitiseRegisterInfo "tcb_at' t"
 
 lemma handle_fault_reply_registers_corres:
-  "corres (=) (tcb_at t) (tcb_at' t)
+  "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
            (do t' \<leftarrow> arch_get_sanitise_register_info t;
                y \<leftarrow> as_user t
                 (zipWithM_x
@@ -1886,7 +1876,6 @@ lemma handle_fault_reply_registers_corres:
                   msg_template msg);
                return (label = 0)
             od)"
-
   apply (rule corres_guard_imp)
     apply (rule corres_split[OF arch_getSanitiseRegisterInfo_corres])
       apply (rule corres_split)
@@ -1900,7 +1889,7 @@ lemma handle_fault_reply_registers_corres:
 
 lemma handleFaultReply_corres:
   "ft' = fault_map ft \<Longrightarrow>
-   corres (=) (tcb_at t) (tcb_at' t)
+   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)
@@ -1950,16 +1939,6 @@ lemma getThreadCallerSlot_inv:
   "\<lbrace>P\<rbrace> getThreadCallerSlot t \<lbrace>\<lambda>_. P\<rbrace>"
   by (simp add: getThreadCallerSlot_def, wp)
 
-lemma deleteCallerCap_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>
-   deleteCallerCap t
-   \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: deleteCallerCap_def getSlotCap_def getThreadCallerSlot_def locateSlot_conv)
-  apply (wp getThreadCallerSlot_inv cteDeleteOne_ct_not_ksQ getCTE_wp)
-  apply (clarsimp simp: cte_wp_at_ctes_of)
-  done
-
 crunch tcb_at'[wp]: unbindNotification "tcb_at' x"
 
 lemma finaliseCapTrue_standin_tcb_at' [wp]:
@@ -2119,39 +2098,11 @@ crunch weak_sch_act_wf[wp]: emptySlot "\<lambda>s. weak_sch_act_wf (ksSchedulerA
 
 crunches archThreadGet, 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 sch_act_wf[wp]: unbindNotification "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
 (wp: sbn_sch_act')
 
-crunch valid_queues'[wp]: cteDeleteOne valid_queues'
-  (simp: crunch_simps unless_def inQ_def
-     wp: crunch_wps sts_st_tcb' getObject_inv loadObject_default_inv
-         threadSet_valid_queues' rescheduleRequired_valid_queues'_weak)
-
-lemma cancelSignal_valid_queues'[wp]:
-  "\<lbrace>valid_queues'\<rbrace> cancelSignal t ntfn \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (simp add: cancelSignal_def)
-  apply (rule hoare_pre)
-   apply (wp getNotification_wp| wpc | simp)+
-  done
-
-lemma cancelIPC_valid_queues'[wp]:
-  "\<lbrace>valid_queues' and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) \<rbrace> cancelIPC t \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (simp add: cancelIPC_def Let_def getThreadReplySlot_def locateSlot_conv liftM_def)
-  apply (rule hoare_seq_ext[OF _ gts_sp'])
-  apply (case_tac state, simp_all) defer 2
-  apply (rule hoare_pre)
-   apply ((wp getEndpoint_wp getCTE_wp | wpc | simp)+)[8]
-  apply (wp cteDeleteOne_valid_queues')
-  apply (rule_tac Q="\<lambda>_. valid_queues' and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)" in hoare_post_imp)
-  apply (clarsimp simp: capHasProperty_def cte_wp_at_ctes_of)
-   apply (wp threadSet_valid_queues' threadSet_sch_act| simp)+
-  apply (clarsimp simp: inQ_def)
-  done
-
 crunches archThreadGet, handleFaultReply
   for valid_objs'[wp]: valid_objs'
 
@@ -2160,6 +2111,17 @@ lemma cte_wp_at_is_reply_cap_toI:
    \<Longrightarrow> cte_wp_at (is_reply_cap_to t) ptr s"
   by (fastforce simp: cte_wp_at_reply_cap_to_ex_rights)
 
+crunches handle_fault_reply
+  for pspace_alignedp[wp]: pspace_aligned
+  and pspace_distinct[wp]: pspace_distinct
+
+crunches 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 doReplyTransfer_corres:
   "corres dc
      (einvs and tcb_at receiver and tcb_at sender
@@ -2171,7 +2133,8 @@ lemma doReplyTransfer_corres:
   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)+)
+     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
@@ -2205,8 +2168,12 @@ lemma doReplyTransfer_corres:
            apply (rule corres_split[OF setThreadState_corres])
               apply simp
              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_queues sts_valid_objs' delete_one_tcbDomain_obj_at'
-                   | simp add: valid_tcb_state'_def)+
+            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])
@@ -2215,12 +2182,16 @@ lemma doReplyTransfer_corres:
           apply (fastforce)
          apply (clarsimp simp:is_cap_simps)
         apply (wp weak_valid_sched_action_lift)+
-       apply (rule_tac Q="\<lambda>_. valid_queues' and valid_objs' and cur_tcb' and tcb_at' receiver and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)" in hoare_post_imp, simp add: sch_act_wf_weak)
+       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)
+    apply (clarsimp simp: invs_psp_aligned invs_distinct)
     apply (rule conjI, erule invs_valid_objs)
     apply (rule conjI, clarsimp)+
     apply (rule conjI)
@@ -2244,36 +2215,38 @@ lemma doReplyTransfer_corres:
                  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 P="valid_sched and cur_tcb and tcb_at receiver"
-                            and P'="tcb_at' receiver and cur_tcb'
+                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 Invariants_H.valid_queues and valid_queues' and valid_objs'"
-                              in corres_inst)
+                                      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_queues | simp | force simp: valid_sched_def valid_sched_action_def valid_tcb_state'_def)+
+                      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_valid_queues threadSet_valid_queues'
-                         threadSet_tcbDomain_triv threadSet_valid_objs'
-                    | simp add: valid_tcb_state'_def)+
-            apply (wp threadSet_cur weak_sch_act_wf_lift_linear threadSet_pred_tcb_no_state
-                      thread_set_not_state_valid_sched threadSet_valid_queues threadSet_valid_queues'
-                 | simp add: runnable_def inQ_def valid_tcb'_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"
+                   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)
+     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>)
@@ -2485,7 +2458,7 @@ proof -
              apply (rule setEndpoint_corres)
              apply (simp add: ep_relation_def)
             apply wp+
-          apply (clarsimp simp: st_tcb_at_tcb_at valid_tcb_state_def)
+          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)
@@ -2495,7 +2468,7 @@ proof -
             apply (rule setEndpoint_corres)
             apply (simp add: ep_relation_def)
            apply wp+
-         apply (clarsimp simp: st_tcb_at_tcb_at valid_tcb_state_def)
+         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)
@@ -2534,10 +2507,12 @@ proof -
                  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 setThreadState_valid_queues' sts_valid_queues sts_weak_sch_act_wf
+               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)
+              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)
@@ -2602,11 +2577,13 @@ proof -
                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 setThreadState_valid_queues' sts_valid_queues sts_weak_sch_act_wf
+              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)+)[1]
+                     | 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)
@@ -2687,14 +2664,15 @@ lemma sendSignal_corres:
                apply (rule possibleSwitchTo_corres)
               apply wp
              apply (wp set_thread_state_runnable_weak_valid_sched_action sts_st_tcb_at'
-                       sts_valid_queues sts_st_tcb' hoare_disjI2
+                       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 (clarsimp simp: invs'_def valid_state'_def sch_act_wf_weak
-                               valid_tcb_state'_def)
+         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)+
@@ -2720,23 +2698,23 @@ lemma sendSignal_corres:
           apply (rule corres_split[OF asUser_setRegister_corres])
             apply (rule possibleSwitchTo_corres)
            apply ((wp | simp)+)[1]
-          apply (rule_tac Q="\<lambda>_. Invariants_H.valid_queues and valid_queues' and
-                                 (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and
+          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'"
-                   in hoare_post_imp, clarsimp simp: pred_tcb_at' elim!: sch_act_wf_weak)
+                                 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')
           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_queues setThreadState_valid_queues'
-                  setThreadState_st_tcb
+        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 (clarsimp 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 (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)
 
@@ -2754,16 +2732,14 @@ lemma sendSignal_corres:
           apply (wp cur_tcb_lift | 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_queues setThreadState_valid_queues'
-                 setThreadState_st_tcb
-            | 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 (clarsimp 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 (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]
@@ -2794,38 +2770,6 @@ lemma possibleSwitchTo_sch_act[wp]:
   apply (auto simp: obj_at'_def projectKOs tcb_in_cur_domain'_def)
   done
 
-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>"
-  apply (simp add: possibleSwitchTo_def curDomain_def bitmap_fun_defs)
-  apply (wp hoare_drop_imps | wpc | simp)+
-  apply (auto simp: valid_tcb'_def weak_sch_act_wf_def
-              dest: pred_tcb_at'
-             elim!: valid_objs_valid_tcbE)
-  done
-
-lemma possibleSwitchTo_ksQ':
-  "\<lbrace>(\<lambda>s. t' \<notin> set (ksReadyQueues s p) \<and> sch_act_not t' s) and K(t' \<noteq> t)\<rbrace>
-     possibleSwitchTo t
-   \<lbrace>\<lambda>_ s. t' \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: possibleSwitchTo_def curDomain_def bitmap_fun_defs)
-  apply (wp hoare_weak_lift_imp rescheduleRequired_ksQ' tcbSchedEnqueue_ksQ threadGet_wp
-         | wpc
-         | simp split del: if_split)+
-  apply (auto simp: obj_at'_def)
-  done
-
-lemma possibleSwitchTo_valid_queues'[wp]:
-  "\<lbrace>valid_queues' and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)
-                  and st_tcb_at' runnable' t\<rbrace>
-   possibleSwitchTo t
-   \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (simp add: possibleSwitchTo_def curDomain_def)
-  apply (wp hoare_weak_lift_imp threadGet_wp | wpc | simp)+
-  apply (auto simp: obj_at'_def)
-  done
-
 crunch st_refs_of'[wp]: possibleSwitchTo "\<lambda>s. P (state_refs_of' s)"
   (wp: crunch_wps)
 
@@ -2840,16 +2784,12 @@ crunch st_hyp_refs_of'[wp]: possibleSwitchTo "\<lambda>s. P (state_hyp_refs_of'
   (wp: 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>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>rv. if_live_then_nonz_cap'\<rbrace>"
-  apply (simp add: possibleSwitchTo_def curDomain_def bitmap_fun_defs)
-  apply (wp | wpc | simp)+
-      apply (simp only: imp_conv_disj, wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-    apply (wp threadGet_wp)+
-  apply (auto simp: obj_at'_def projectKOs)
-  done
+  unfolding possibleSwitchTo_def curDomain_def
+  by (wpsimp wp: threadGet_wp)
 
 crunches possibleSwitchTo
   for ifunsafe[wp]: if_unsafe_then_cap'
@@ -2877,10 +2817,6 @@ crunches sendSignal, setBoundNotification
    rule: irqs_masked_lift)
 end
 
-lemma sts_running_valid_queues:
-  "runnable' st \<Longrightarrow> \<lbrace> Invariants_H.valid_queues \<rbrace> setThreadState st t \<lbrace>\<lambda>_. Invariants_H.valid_queues \<rbrace>"
-  by (wp sts_valid_queues, clarsimp)
-
 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)
@@ -2893,24 +2829,21 @@ lemma setThreadState_nonqueued_state_update:
                \<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)
-               \<and> (\<not> runnable' st \<longrightarrow> (\<forall>p. t \<notin> set (ksReadyQueues s p)))\<rbrace>
-  setThreadState st t \<lbrace>\<lambda>rv. invs'\<rbrace>"
+               \<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
-                            sts_valid_queues
-                            setThreadState_ct_not_inQ)
+  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 (drule simple_st_tcb_at_state_refs_ofD')
   apply (drule bound_tcb_at_state_refs_ofD')
-  apply (rule conjI, fastforce)
-  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 (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
 
 lemma cteDeleteOne_reply_cap_to'[wp]:
@@ -2987,16 +2920,14 @@ lemma cancelAllIPC_not_rct[wp]:
    \<lbrace>\<lambda>_ s. ksSchedulerAction s \<noteq> ResumeCurrentThread \<rbrace>"
   apply (simp add: cancelAllIPC_def)
   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 (wp)+
-     apply (rule hoare_post_imp [OF _ rescheduleRequired_notresume], simp)
-    apply simp
-    apply (rule mapM_x_wp_inv)
-    apply (wp)+
-  apply (wp hoare_vcg_all_lift hoare_drop_imp)
-    apply (simp_all)
+      apply (wpsimp wp: hoare_vcg_all_lift hoare_drop_imp)+
   done
 
 lemma cancelAllSignals_not_rct[wp]:
@@ -3005,12 +2936,10 @@ lemma cancelAllSignals_not_rct[wp]:
    \<lbrace>\<lambda>_ s. ksSchedulerAction s \<noteq> ResumeCurrentThread \<rbrace>"
   apply (simp add: cancelAllSignals_def)
   apply (wp | wpc)+
-     apply (rule hoare_post_imp [OF _ rescheduleRequired_notresume], simp)
-    apply simp
-    apply (rule mapM_x_wp_inv)
-    apply (wp)+
-  apply (wp hoare_vcg_all_lift hoare_drop_imp)
-    apply (simp_all)
+       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 not_rct[wp]: finaliseCapTrue_standin "\<lambda>s. ksSchedulerAction s \<noteq> ResumeCurrentThread"
@@ -3095,7 +3024,6 @@ lemma sai_invs'[wp]:
      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
-               sts_valid_queues [where st="Structures_H.thread_state.Running", simplified]
                set_ntfn_valid_objs' cur_tcb_lift sts_st_tcb'
                hoare_convert_imp [OF setNotification_nosch]
            | simp split del: if_split)+
@@ -3182,7 +3110,7 @@ lemma replyFromKernel_corres:
            apply simp
           apply (rule setMessageInfo_corres)
           apply (wp hoare_case_option_wp hoare_valid_ipc_buffer_ptr_typ_at'
-                 | clarsimp)+
+                 | fastforce)+
   done
 
 lemma rfk_invs':
@@ -3195,7 +3123,7 @@ lemma rfk_invs':
 crunch nosch[wp]: replyFromKernel "\<lambda>s. P (ksSchedulerAction s)"
 
 lemma completeSignal_corres:
-  "corres dc (ntfn_at ntfnptr and tcb_at tcb and pspace_aligned and valid_objs
+  "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)"
@@ -3220,10 +3148,8 @@ lemma completeSignal_corres:
 
 
 lemma doNBRecvFailedTransfer_corres:
-  "corres dc (tcb_at thread)
-            (tcb_at' thread)
-            (do_nbrecv_failed_transfer thread)
-            (doNBRecvFailedTransfer thread)"
+  "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 (simp add: badgeRegister_def badge_register_def, rule asUser_setRegister_corres)
 
@@ -3310,11 +3236,11 @@ lemma receiveIPC_corres:
                                              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 Invariants_H.valid_queues
-                                                   and valid_queues'
                                                    and valid_pspace'
                                                    and valid_objs'
-                                             and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)"
+                                             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])
@@ -3323,17 +3249,18 @@ lemma receiveIPC_corres:
                        apply (rule corres_split[OF setThreadState_corres])
                           apply simp
                          apply (rule possibleSwitchTo_corres)
-                        apply (wp sts_st_tcb_at' set_thread_state_runnable_weak_valid_sched_action
-                             | simp)+
-                       apply (wp sts_st_tcb_at'_cases sts_valid_queues setThreadState_valid_queues'
-                                 setThreadState_st_tcb
+                        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 (clarsimp simp: st_tcb_at_tcb_at st_tcb_def2 valid_sched_def
-                                            valid_sched_action_def)
+                      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"
-                         in hoare_post_imp, erule sch_act_wf_weak)
+                   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
@@ -3356,13 +3283,13 @@ lemma receiveIPC_corres:
                 apply wp+
               apply (rule corres_guard_imp, rule doNBRecvFailedTransfer_corres, simp)
               apply simp
-             apply (clarsimp simp: valid_tcb_state_def)
+             apply (clarsimp simp: valid_tcb_state_def invs_distinct)
             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 (clarsimp simp: valid_cap_def invs_psp_aligned invs_valid_objs pred_tcb_at_def
-                         valid_obj_def valid_tcb_def valid_bound_ntfn_def
+                         valid_obj_def valid_tcb_def valid_bound_ntfn_def invs_distinct
                   dest!: invs_valid_objs
                   elim!: obj_at_valid_objsE
                   split: option.splits)
@@ -3373,7 +3300,7 @@ lemma receiveIPC_corres:
   done
 
 lemma receiveSignal_corres:
- "\<lbrakk> is_ntfn_cap cap; cap_relation cap cap' \<rbrakk> \<Longrightarrow>
+  "\<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)"
@@ -3400,6 +3327,8 @@ lemma receiveSignal_corres:
              apply (simp add: ntfn_relation_def)
             apply wp+
           apply (rule corres_guard_imp, rule doNBRecvFailedTransfer_corres, simp+)
+         apply (clarsimp simp: invs_distinct)
+        apply simp
        \<comment> \<open>WaitingNtfn\<close>
        apply (simp add: ntfn_relation_def)
        apply (rule corres_guard_imp)
@@ -3410,7 +3339,8 @@ lemma receiveSignal_corres:
             apply (simp add: ntfn_relation_def)
            apply wp+
          apply (rule corres_guard_imp)
-           apply (rule doNBRecvFailedTransfer_corres, simp+)
+           apply (rule doNBRecvFailedTransfer_corres; simp)
+          apply (clarsimp simp: invs_distinct)+
       \<comment> \<open>ActiveNtfn\<close>
       apply (simp add: ntfn_relation_def)
       apply (rule corres_guard_imp)
@@ -3480,7 +3410,7 @@ lemma sendFaultIPC_corres:
                   | 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 (simp add: valid_cap_def)
+          apply (clarsimp simp: valid_cap_def invs_distinct)
          apply (clarsimp simp: valid_cap'_def inQ_def)
         apply auto[1]
         apply (clarsimp simp: lookup_failure_map_def)
@@ -3498,14 +3428,16 @@ lemma gets_the_noop_corres:
   done
 
 lemma handleDoubleFault_corres:
-  "corres dc (tcb_at thread)
-             (tcb_at' thread and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s))
+  "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_underlying_split [OF setThreadState_corres])
+           rule corres_split[OF setThreadState_corres])
        apply simp
       apply (rule corres_noop2)
          apply (simp add: exs_valid_def return_def)
@@ -3514,7 +3446,7 @@ lemma handleDoubleFault_corres:
         apply (rule asUser_inv)
         apply (rule getRestartPC_inv)
        apply (wp no_fail_getRestartPC)+
-    apply (wp|simp)+
+   apply (wp|simp)+
   done
 
 crunch tcb' [wp]: sendFaultIPC "tcb_at' t" (wp: crunch_wps)
@@ -3563,30 +3495,6 @@ crunch sch_act_wf: setupCallerCap
   "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
   (wp: crunch_wps ssa_sch_act sts_sch_act rule: sch_act_wf_lift)
 
-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 vq[wp]: cteInsert "Invariants_H.valid_queues"
-  (wp: crunch_wps)
-
-crunch vq[wp]: getThreadCallerSlot "Invariants_H.valid_queues"
-  (wp: crunch_wps)
-
-crunch vq[wp]: getThreadReplySlot "Invariants_H.valid_queues"
-  (wp: crunch_wps)
-
-lemma setupCallerCap_vq[wp]:
-  "\<lbrace>Invariants_H.valid_queues and (\<lambda>s. \<forall>p. send \<notin> set (ksReadyQueues s p))\<rbrace>
-   setupCallerCap send recv grant \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: setupCallerCap_def)
-  apply (wp crunch_wps sts_valid_queues)
-  apply (fastforce simp: valid_queues_def obj_at'_def inQ_def)
-  done
-
-crunch vq'[wp]: setupCallerCap "valid_queues'"
-  (wp: crunch_wps)
-
 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)"
@@ -3630,7 +3538,7 @@ lemma setupCallerCap_vp[wp]:
 declare haskell_assert_inv[wp del]
 
 lemma setupCallerCap_iflive[wp]:
-  "\<lbrace>if_live_then_nonz_cap' and ex_nonz_cap_to' sender\<rbrace>
+  "\<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
@@ -3642,7 +3550,7 @@ lemma setupCallerCap_iflive[wp]:
 
 lemma setupCallerCap_ifunsafe[wp]:
   "\<lbrace>if_unsafe_then_cap' and valid_objs' and
-    ex_nonz_cap_to' rcvr and tcb_at' rcvr\<rbrace>
+    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
@@ -3664,13 +3572,11 @@ lemma setupCallerCap_global_refs'[wp]:
    \<lbrace>\<lambda>rv. valid_global_refs'\<rbrace>"
   unfolding setupCallerCap_def getThreadCallerSlot_def
             getThreadReplySlot_def locateSlot_conv
-  apply (wp getSlotCap_cte_wp_at
-    | simp add: o_def unique_master_reply_cap'
-    | strengthen eq_imp_strg
-    | wp (once) getCTE_wp | clarsimp simp: cte_wp_at_ctes_of)+
-  (* at setThreadState *)
-  apply (rule_tac Q="\<lambda>_. valid_global_refs'" in hoare_post_imp, wpsimp+)
-  done
+  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 valid_arch'[wp]: setupCallerCap "valid_arch_state'"
   (wp: hoare_drop_imps)
@@ -3851,12 +3757,21 @@ lemmas possibleSwitchToTo_cteCaps_of[wp]
 
 crunch hyp_refs'[wp]: possibleSwitchTo "\<lambda>s. P (state_hyp_refs_of' s)"
 
+crunches asUser
+  for valid_bitmaps[wp]: valid_bitmaps
+  (rule: valid_bitmaps_lift wp: crunch_wps)
+
+crunches 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)
+
 (* 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 (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))
           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
@@ -3874,7 +3789,7 @@ lemma ri_invs' [wp]:
      apply (rule hoare_pre, wpc, wp valid_irq_node_lift)
       apply (simp add: valid_ep'_def del: fun_upd_apply)
       apply (wp sts_sch_act' hoare_vcg_const_Ball_lift valid_irq_node_lift
-                sts_valid_queues setThreadState_ct_not_inQ
+                setThreadState_ct_not_inQ
                 asUser_urz
            | simp add: doNBRecvFailedTransfer_def cteCaps_of_def del: fun_upd_apply)+
      apply (clarsimp simp: valid_tcb_state'_def pred_tcb_at' o_def)
@@ -3895,7 +3810,6 @@ lemma ri_invs' [wp]:
        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 (thin_tac "\<forall>a b. t \<notin> set (ksReadyQueues one (a, b))") \<comment> \<open>causes slowdown\<close>
          apply (safe ; solves \<open>auto\<close>)
         apply fastforce
        apply fastforce
@@ -3906,7 +3820,7 @@ lemma ri_invs' [wp]:
     apply (rule hoare_pre, wpc, wp valid_irq_node_lift)
      apply (simp add: valid_ep'_def del: fun_upd_apply)
      apply (wp sts_sch_act' valid_irq_node_lift
-               sts_valid_queues setThreadState_ct_not_inQ
+               setThreadState_ct_not_inQ
                asUser_urz
           | simp add: doNBRecvFailedTransfer_def cteCaps_of_def del: fun_upd_apply)+
     apply (clarsimp simp: pred_tcb_at' valid_tcb_state'_def o_def state_hyp_refs_of'_ep)
@@ -3930,9 +3844,8 @@ lemma ri_invs' [wp]:
    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' sts_valid_queues
-              setThreadState_ct_not_inQ possibleSwitchTo_valid_queues
-              possibleSwitchTo_valid_queues'
+              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
@@ -3950,8 +3863,6 @@ lemma ri_invs' [wp]:
                          st_tcb_at_refs_of_rev' conj_ac
               split del: if_split
                    cong: if_cong)
-   apply (frule_tac t=sender in valid_queues_not_runnable'_not_ksQ)
-    apply (erule pred_tcb'_weakenE, clarsimp)
    apply (subgoal_tac "sch_act_not sender s")
     prefer 2
     apply (clarsimp simp: pred_tcb_at'_def obj_at'_def)
@@ -3986,7 +3897,6 @@ lemma ri_invs' [wp]:
 lemma rai_invs'[wp]:
   "\<lbrace>invs' and sch_act_not t
           and st_tcb_at' simple' t
-          and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))
           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
@@ -4003,7 +3913,7 @@ lemma rai_invs'[wp]:
     apply (simp add: invs'_def valid_state'_def)
     apply (rule hoare_pre)
      apply (wp valid_irq_node_lift sts_sch_act' typ_at_lifts
-               sts_valid_queues setThreadState_ct_not_inQ
+               setThreadState_ct_not_inQ
                asUser_urz
             | simp add: valid_ntfn'_def doNBRecvFailedTransfer_def live'_def | wpc)+
     apply (clarsimp simp: pred_tcb_at' valid_tcb_state'_def)
@@ -4021,7 +3931,7 @@ lemma rai_invs'[wp]:
        apply (clarsimp split: if_split_asm)
       apply (fastforce simp: tcb_bound_refs'_def symreftype_inverse'
                       split: if_split_asm)
-     apply (clarsimp dest!: global'_no_ex_cap)
+     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)
@@ -4041,7 +3951,7 @@ lemma rai_invs'[wp]:
   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'
-             sts_valid_queues setThreadState_ct_not_inQ typ_at_lifts
+             setThreadState_ct_not_inQ typ_at_lifts
              asUser_urz
         | simp add: valid_ntfn'_def doNBRecvFailedTransfer_def live'_def | wpc)+
   apply (clarsimp simp: valid_tcb_state'_def)
@@ -4069,7 +3979,7 @@ lemma rai_invs'[wp]:
         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 (clarsimp dest!: global'_no_ex_cap)
+  apply (fastforce dest!: global'_no_ex_cap)
   done
 
 lemma getCTE_cap_to_refs[wp]:
@@ -4098,7 +4008,6 @@ 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>Invariants_H.valid_queues\<rbrace> cteInsert a b c \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<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
@@ -4138,9 +4047,12 @@ crunch irqs_masked'[wp]: possibleSwitchTo "irqs_masked'"
 crunch urz[wp]: possibleSwitchTo "untyped_ranges_zero'"
   (simp: crunch_simps unless_def wp: crunch_wps)
 
+crunches possibleSwitchTo
+  for pspace_aligned'[wp]: pspace_aligned'
+  and pspace_distinct'[wp]: pspace_distinct'
+
 lemma si_invs'[wp]:
   "\<lbrace>invs' and st_tcb_at' simple' t
-          and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))
           and sch_act_not t
           and ex_nonz_cap_to' ep and ex_nonz_cap_to' t\<rbrace>
   sendIPC bl call ba cg cgr t ep
@@ -4159,8 +4071,8 @@ lemma si_invs'[wp]:
      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 sts_valid_queues setThreadState_ct_not_inQ
-               possibleSwitchTo_ksQ' possibleSwitchTo_ct_not_inQ hoare_vcg_all_lift sts_ksQ'
+               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"]
@@ -4215,8 +4127,7 @@ lemma si_invs'[wp]:
     apply (simp add: invs'_def valid_state'_def)
     apply (rule hoare_pre, wp valid_irq_node_lift)
      apply (simp add: valid_ep'_def del: fun_upd_apply)
-     apply (wp valid_irq_node_lift sts_sch_act' sts_valid_queues
-               setThreadState_ct_not_inQ)
+     apply (wp valid_irq_node_lift sts_sch_act' setThreadState_ct_not_inQ)
     apply (clarsimp simp: valid_tcb_state'_def pred_tcb_at' state_hyp_refs_of'_ep
                     simp del: fun_upd_apply)
     apply (rule conjI, clarsimp elim!: obj_at'_weakenE)
@@ -4236,8 +4147,7 @@ lemma si_invs'[wp]:
    apply (simp add: invs'_def valid_state'_def)
    apply (rule hoare_pre, wp valid_irq_node_lift)
     apply (simp add: valid_ep'_def del: fun_upd_apply)
-    apply (wp hoare_vcg_const_Ball_lift valid_irq_node_lift sts_sch_act'
-              sts_valid_queues setThreadState_ct_not_inQ)
+    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' state_hyp_refs_of'_ep
                    simp del: fun_upd_apply)
    apply (rule conjI, clarsimp elim!: obj_at'_weakenE)
@@ -4265,19 +4175,15 @@ lemma si_invs'[wp]:
 lemma sfi_invs_plus':
   "\<lbrace>invs' and st_tcb_at' simple' t
           and sch_act_not t
-          and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))
           and ex_nonz_cap_to' t\<rbrace>
-      sendFaultIPC t f
-   \<lbrace>\<lambda>rv. invs'\<rbrace>, \<lbrace>\<lambda>rv. invs' and st_tcb_at' simple' t
-                      and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))
-                      and sch_act_not t and (\<lambda>s. ksIdleThread s \<noteq> 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'
            | wpc | simp)+
    apply (rule_tac Q'="\<lambda>rv s. invs' s \<and> sch_act_not t s
                              \<and> st_tcb_at' simple' t s
-                             \<and> (\<forall>p. t \<notin> set (ksReadyQueues s p))
                              \<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)"
@@ -4289,32 +4195,32 @@ lemma sfi_invs_plus':
   apply (subst(asm) global'_no_ex_cap, auto)
   done
 
+crunches send_fault_ipc
+  for pspace_aligned[wp]: "pspace_aligned :: det_ext state \<Rightarrow> _"
+  and pspace_distinct[wp]: "pspace_distinct :: det_ext state \<Rightarrow> _"
+  (simp: crunch_simps wp: crunch_wps)
+
 lemma handleFault_corres:
   "fr f f' \<Longrightarrow>
-   corres dc (einvs and  st_tcb_at active thread and ex_nonz_cap_to thread
-                   and (%_. valid_fault f))
+   corres dc (einvs and st_tcb_at active thread and ex_nonz_cap_to thread
+                   and (\<lambda>_. valid_fault f))
              (invs' and sch_act_not thread
-                    and (\<lambda>s. \<forall>p. thread \<notin> set(ksReadyQueues s p))
                     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_guard_imp)
     apply (subst return_bind [symmetric],
                rule corres_split[where P="tcb_at thread",
-                                  OF gets_the_noop_corres [where x="()"]])
+                                 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 (rule hoare_post_impErr, rule sfi_invs_plus', simp_all)[1]
-      apply clarsimp
-     apply wp+
-   apply (clarsimp simp: st_tcb_at_tcb_at st_tcb_def2 invs_def
-                         valid_state_def valid_idle_def)
-  apply auto
+       apply wpsimp+
+   apply (clarsimp simp: st_tcb_at_tcb_at st_tcb_def2 invs_def valid_state_def valid_idle_def)
+   apply auto
   done
 
 lemma sts_invs_minor'':
@@ -4322,17 +4228,13 @@ lemma sts_invs_minor'':
                    \<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. (\<exists>p. t \<in> set (ksReadyQueues s p)) \<longrightarrow> runnable' st)
-      and (\<lambda>s. runnable' st \<and> obj_at' tcbQueued t s
-                                      \<longrightarrow> st_tcb_at' runnable' t s)
       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' sts_valid_queues
-             setThreadState_ct_not_inQ)
+   apply (wp valid_irq_node_lift sts_sch_act' setThreadState_ct_not_inQ)
   apply clarsimp
   apply (rule conjI)
    apply fastforce
@@ -4347,12 +4249,11 @@ lemma sts_invs_minor'':
    apply (clarsimp dest!: st_tcb_at_state_refs_ofD'
                    elim!: rsubst[where P=sym_refs]
                   intro!: ext)
-  apply (clarsimp elim!: st_tcb_ex_cap'')
+  apply (fastforce elim!: st_tcb_ex_cap'')
   done
 
 lemma hf_invs' [wp]:
   "\<lbrace>invs' and sch_act_not t
-          and (\<lambda>s. \<forall>p. t \<notin> set(ksReadyQueues s p))
           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>"
diff --git a/proof/refine/ARM_HYP/KHeap_R.thy b/proof/refine/ARM_HYP/KHeap_R.thy
index 6eec9c3cba..3406c39d83 100644
--- a/proof/refine/ARM_HYP/KHeap_R.thy
+++ b/proof/refine/ARM_HYP/KHeap_R.thy
@@ -14,8 +14,46 @@ lemma lookupAround2_known1:
   "m x = Some y \<Longrightarrow> fst (lookupAround2 x m) = Some (x, y)"
   by (fastforce simp: lookupAround2_char1)
 
+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
+
 context begin interpretation Arch . (*FIXME: arch_split*)
 
+lemma setObject_modify_variable_size:
+  fixes v :: "'a :: pspace_storable" shows
+  "\<lbrakk>obj_at' (P :: 'a \<Rightarrow> bool) p s; updateObject v = updateObject_default v;
+    (1 :: machine_word) < 2 ^ objBits v; obj_at' (\<lambda>obj. objBits v = objBits obj) p s\<rbrakk>
+   \<Longrightarrow> setObject p v s = modify (ksPSpace_update (\<lambda>ps. ps (p \<mapsto> injectKO v))) s"
+  supply projectKOs[simp]
+  apply (clarsimp simp: setObject_def split_def exec_gets obj_at'_def lookupAround2_known1
+                        assert_opt_def updateObject_default_def bind_assoc)
+  apply (simp add: projectKO_def alignCheck_assert)
+  apply (simp add: project_inject objBits_def)
+  apply (clarsimp simp only: koTypeOf_injectKO)
+  apply (frule in_magnitude_check[where s'=s])
+    apply blast
+   apply fastforce
+  apply (simp add: magnitudeCheck_assert in_monad bind_def gets_def oassert_opt_def
+                   get_def return_def)
+  apply (simp add: simpler_modify_def)
+  done
+
+lemma setObject_modify:
+  fixes v :: "'a :: pspace_storable" shows
+  "\<lbrakk>obj_at' (P :: 'a \<Rightarrow> bool) p s; updateObject v = updateObject_default v;
+    (1 :: machine_word) < 2 ^ objBits v; \<And>ko. P ko \<Longrightarrow> objBits ko = objBits v \<rbrakk>
+   \<Longrightarrow> setObject p v s = modify (ksPSpace_update (\<lambda>ps. ps (p \<mapsto> injectKO v))) s"
+  apply (rule setObject_modify_variable_size)
+     apply fastforce
+    apply fastforce
+  apply fastforce
+  unfolding obj_at'_def
+  by fastforce
+
 lemma obj_at_getObject:
   assumes R:
   "\<And>a b n ko s obj::'a::pspace_storable.
@@ -151,8 +189,7 @@ lemma corres_get_tcb [corres]:
   apply (drule bspec)
    apply clarsimp
    apply blast
-  apply (clarsimp simp add: other_obj_relation_def
-                            lookupAround2_known1)
+  apply (clarsimp simp: tcb_relation_cut_def lookupAround2_known1)
   done
 
 lemma lookupAround2_same1[simp]:
@@ -460,6 +497,40 @@ lemma setObject_tcb_strongest:
                         ps_clear_upd)
   done
 
+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 opt_pred_def projectKO_opts_defs projectKOs
+          split: if_split_asm
+                 Structures_H.kernel_object.split_asm
+
+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_tcbs_of'[wp]:
+  "setObject c (notification :: notification) \<lbrace>\<lambda>s. P' (tcbs_of' s)\<rbrace>"
+  by setObject_easy_cases
+
+lemma setObject_cte_tcbSchedNexts_of[wp]:
+  "setObject c (cte :: cte) \<lbrace>\<lambda>s. P' (tcbSchedNexts_of s)\<rbrace>"
+  by setObject_easy_cases
+
+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_tcbQueued[wp]:
+  "setObject c (cte :: cte) \<lbrace>\<lambda>s. P' (tcbQueued |< tcbs_of' s)\<rbrace>"
+  supply inQ_def[simp]
+  by setObject_easy_cases
+
+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 getObject_obj_at':
   assumes x: "\<And>q n ko. loadObject p q n ko =
                 (loadObject_default p q n ko :: ('a :: pspace_storable) kernel)"
@@ -960,7 +1031,7 @@ lemma obj_relation_cut_same_type:
          \<or> (a_type ko = AArch AVCPU \<and> a_type ko' = AArch AVCPU)"
   apply (rule ccontr)
   apply (simp add: obj_relation_cuts_def2 a_type_def)
-  apply (auto simp: other_obj_relation_def cte_relation_def
+  apply (auto simp: other_obj_relation_def tcb_relation_cut_def cte_relation_def
                     pte_relation_def pde_relation_def
              split: Structures_A.kernel_object.split_asm if_split_asm
                     Structures_H.kernel_object.split_asm
@@ -978,6 +1049,16 @@ where
   "exst_same' (KOTCB tcb) (KOTCB tcb') = exst_same tcb tcb'" |
   "exst_same' _ _ = True"
 
+lemma tcbs_of'_non_tcb_update:
+  "\<lbrakk>typ_at' (koTypeOf ko) ptr s'; koTypeOf ko \<noteq> TCBT\<rbrakk>
+   \<Longrightarrow> tcbs_of' (s'\<lparr>ksPSpace := (ksPSpace s')(ptr \<mapsto> ko)\<rparr>) = tcbs_of' s'"
+  by (fastforce simp: typ_at'_def ko_wp_at'_def opt_map_def projectKO_opts_defs
+               split: kernel_object.splits)
+
+lemma typ_at'_koTypeOf:
+  "ko_at' ob' ptr b \<Longrightarrow> typ_at' (koTypeOf (injectKO ob')) ptr b"
+  by (auto simp: typ_at'_def ko_wp_at'_def obj_at'_def project_inject projectKOs)
+
 lemma setObject_other_corres:
   fixes ob' :: "'a :: pspace_storable"
   assumes x: "updateObject ob' = updateObject_default ob'"
@@ -986,12 +1067,12 @@ lemma setObject_other_corres:
   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)"
+  assumes P: "\<And>v::'a::pspace_storable. (1 :: machine_word) < 2 ^ objBits v"
   shows      "other_obj_relation ob (injectKO (ob' :: 'a :: pspace_storable)) \<Longrightarrow>
   corres dc (obj_at (\<lambda>ko. a_type ko = a_type ob) ptr and obj_at (same_caps ob) ptr)
             (obj_at' (P :: 'a \<Rightarrow> bool) ptr)
             (set_object ptr ob) (setObject ptr ob')"
-  supply image_cong_simp [cong del]
+  supply image_cong_simp [cong del] projectKOs[simp del]
   apply (rule corres_no_failI)
    apply (rule no_fail_pre)
     apply wp
@@ -1002,11 +1083,12 @@ lemma setObject_other_corres:
                         put_def return_def modify_def get_object_def x
                         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
                             swp_def fun_upd_def obj_at_def)
   apply (subst conj_assoc[symmetric])
-  apply (rule conjI[rotated])
+  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 simp: obj_at_def a_type_def
@@ -1016,40 +1098,46 @@ lemma setObject_other_corres:
   apply (simp only: pspace_relation_def pspace_dom_update dom_fun_upd2 simp_thms)
   apply (elim conjE)
   apply (frule bspec, erule domI)
+  apply (prop_tac "typ_at' (koTypeOf (injectKO ob')) ptr b")
+   subgoal
+     by (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 clarsimp
   apply (rule conjI)
    apply (rule ballI, drule(1) bspec)
    apply (drule domD)
    apply (clarsimp simp: is_other_obj_relation_type t)
    apply (drule(1) bspec)
    apply clarsimp
-   apply (frule_tac ko'=koa and x'=ptr in obj_relation_cut_same_type,
+   apply (frule_tac ko'=ko and x'=ptr in obj_relation_cut_same_type,
            (fastforce simp add: is_other_obj_relation_type t)+)
-   apply (erule disjE)
-    apply (simp add: is_other_obj_relation_type t)
-   apply (erule disjE)
-    apply (insert t,
-      clarsimp simp: is_other_obj_relation_type_CapTable a_type_def)
-   apply (erule disjE)
-    apply (insert t,
-       clarsimp simp: is_other_obj_relation_type_UserData a_type_def)
-   apply (erule disjE)
-    apply (insert t,
-       clarsimp simp: is_other_obj_relation_type_DeviceData a_type_def)
-   apply (simp add: is_other_obj_relation_type t)
-  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)
-  by (clarsimp simp: is_other_obj_relation_type t exst_same_def
-              split: Structures_A.kernel_object.splits Structures_H.kernel_object.splits
-                     ARM_A.arch_kernel_obj.splits)+
+   apply (insert t)
+   apply ((erule disjE
+          | clarsimp simp: is_other_obj_relation_type is_other_obj_relation_type_def a_type_def)+)[1]
+  apply (extract_conjunct \<open>match conclusion in "ekheap_relation _ _" \<Rightarrow> -\<close>)
+   apply (simp only: ekheap_relation_def)
+   apply (rule ballI, drule(1) bspec)
+   apply (drule domD)
+   apply (insert e)
+   apply atomize
+   apply (clarsimp simp: obj_at'_def)
+   apply (erule_tac x=obj in allE)
+   apply (clarsimp simp: projectKO_eq project_inject)
+   apply (case_tac ob;
+          simp_all add: a_type_def other_obj_relation_def etcb_relation_def
+                        is_other_obj_relation_type t exst_same_def)[1]
+     apply (clarsimp simp: is_other_obj_relation_type t exst_same_def
+                    split: Structures_A.kernel_object.splits Structures_H.kernel_object.splits
+                           arch_kernel_obj.splits)+
+  \<comment> \<open>ready_queues_relation\<close>
+  apply (prop_tac "koTypeOf (injectKO ob') \<noteq> TCBT")
+   subgoal
+     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
@@ -1143,14 +1231,14 @@ lemma typ_at'_valid_obj'_lift:
       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,
+             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 valid_bound_ntfn'_def
-                     valid_arch_tcb'_def
-              split: option.splits,
-           wpsimp wp: P)
+           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)
@@ -1432,32 +1520,6 @@ lemma set_ep_bitmapQ_no_L2_orphans[wp]:
   apply (wp hoare_Ball_helper hoare_vcg_all_lift updateObject_default_inv | simp add: bitmapQ_def)+
   done
 
-lemma set_ep_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> setEndpoint epptr ep \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: Invariants_H.valid_queues_def)
-  apply (wp hoare_vcg_conj_lift)
-    apply (simp add: setEndpoint_def valid_queues_no_bitmap_def)
-    apply (wp hoare_Ball_helper hoare_vcg_all_lift)
-      apply (rule obj_at_setObject2)
-      apply (clarsimp simp: updateObject_default_def in_monad)
-     apply (wp updateObject_default_inv set_ep_valid_bitmapQ[unfolded setEndpoint_def]
-            | simp add: valid_queues_no_bitmap_def)+
-  done
-
-lemma set_ep_valid_queues'[wp]:
-  "\<lbrace>valid_queues'\<rbrace> setEndpoint epptr ep \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (unfold setEndpoint_def)
-  apply (simp only: valid_queues'_def imp_conv_disj
-                    obj_at'_real_def)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-    apply (rule setObject_ko_wp_at)
-      apply simp
-     apply (simp add: objBits_simps')
-    apply simp
-   apply (wp updateObject_default_inv | simp)+
-  apply (clarsimp simp: projectKOs ko_wp_at'_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>"
@@ -1723,34 +1785,6 @@ lemma set_ntfn_bitmapQ_no_L2_orphans[wp]:
   apply (wp hoare_Ball_helper hoare_vcg_all_lift updateObject_default_inv | simp)+
   done
 
-lemma set_ntfn_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> setNotification p ntfn \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: Invariants_H.valid_queues_def)
-  apply (rule hoare_pre)
-   apply (wp hoare_vcg_conj_lift)
-    apply (simp add: setNotification_def valid_queues_no_bitmap_def)
-    apply (wp hoare_Ball_helper hoare_vcg_all_lift)
-      apply (rule obj_at_setObject2)
-      apply (clarsimp simp: updateObject_default_def in_monad)
-     apply (wp updateObject_default_inv set_ep_valid_bitmapQ[unfolded setEndpoint_def]
-            | simp add: valid_queues_no_bitmap_def)+
-  done
-
-lemma set_ntfn_valid_queues'[wp]:
-  "\<lbrace>valid_queues'\<rbrace> setNotification p ntfn \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (unfold setNotification_def)
-  apply (rule setObject_ntfn_pre)
-  apply (simp only: valid_queues'_def imp_conv_disj
-                    obj_at'_real_def)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-    apply (rule setObject_ko_wp_at)
-      apply simp
-     apply (simp add: objBits_simps')
-    apply simp
-   apply (wp updateObject_default_inv | simp)+
-  apply (clarsimp simp: projectKOs ko_wp_at'_def)
-  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>
@@ -2203,6 +2237,21 @@ lemma setNotification_ct_idle_or_in_cur_domain'[wp]:
 crunch gsUntypedZeroRanges[wp]: setNotification "\<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>"
+  assumes nexts: "\<And>P. f \<lbrace>\<lambda>s. P (tcbSchedNexts_of s)\<rbrace>"
+  shows "f \<lbrace>sym_heap_sched_pointers\<rbrace>"
+  by (rule_tac f=tcbSchedPrevs_of in hoare_lift_Pf2; wpsimp wp: assms)
+
+crunches setNotification
+  for tcbSchedNexts_of[wp]: "\<lambda>s. P (tcbSchedNexts_of s)"
+  and tcbSchedPrevs_of[wp]: "\<lambda>s. P (tcbSchedPrevs_of s)"
+  and valid_sched_pointers[wp]: valid_sched_pointers
+  and ksReadyQueues[wp]: "\<lambda>s. P (ksReadyQueues s)"
+  and ksReadyQueuesL1Bitmap[wp]: "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
+  and ksReadyQueuesL2Bitmap[wp]: "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
+  (simp: updateObject_default_def)
+
 lemma set_ntfn_minor_invs':
   "\<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))
@@ -2212,11 +2261,14 @@ lemma set_ntfn_minor_invs':
          and (\<lambda>s. ptr \<noteq> ksIdleThread s) \<rbrace>
      setNotification ptr val
    \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (clarsimp simp add: invs'_def valid_state'_def cteCaps_of_def)
-  apply (wp irqs_masked_lift valid_irq_node_lift untyped_ranges_zero_lift; simp add: o_def)
-  by (clarsimp elim!: rsubst[where P=sym_refs]
-              intro!: ext
-               dest!: obj_at_state_refs_ofD')
+  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>"
@@ -2254,6 +2306,30 @@ lemma idle_is_global [intro!]:
   "ksIdleThread s \<in> global_refs' s"
   by (simp add: global_refs'_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"
+  supply projectKOs[simp]
+  apply (simp add: obj_at'_def project_inject pspace_distinct'_def pspace_aligned'_def)
+  apply (drule bspec, erule domI)+
+  apply (clarsimp simp: objBits_simps' word_bits_def
+                 split: kernel_object.splits arch_kernel_object.splits)
+  done
+
+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
+
+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)
+
 lemma valid_globals_cte_wpD':
   "\<lbrakk> valid_global_refs' s; cte_wp_at' P p s \<rbrakk>
        \<Longrightarrow> \<exists>cte. P cte \<and> ksIdleThread s \<notin> capRange (cteCap cte)"
@@ -2297,20 +2373,17 @@ crunch typ_at'[wp]: doMachineOp "\<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>"
-  by (simp add: doMachineOp_def split_def
-                valid_pspace'_def valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs
-       | wp cur_tcb_lift sch_act_wf_lift tcb_in_cur_domain'_lift
+  "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>\<lambda>s. P (state_hyp_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 obj_at'[wp]: doMachineOp "\<lambda>s. P (obj_at' P' p s)"
diff --git a/proof/refine/ARM_HYP/PageTableDuplicates.thy b/proof/refine/ARM_HYP/PageTableDuplicates.thy
index 44902c2764..a06d10e158 100644
--- a/proof/refine/ARM_HYP/PageTableDuplicates.thy
+++ b/proof/refine/ARM_HYP/PageTableDuplicates.thy
@@ -77,11 +77,6 @@ crunches threadSet, setBoundNotification
   for valid_duplicates'[wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
   (wp: setObject_ksInterrupt updateObject_default_inv)
 
-lemma tcbSchedEnqueue_valid_duplicates'[wp]:
- "\<lbrace>\<lambda>s. vs_valid_duplicates' (ksPSpace s)\<rbrace>
-  tcbSchedEnqueue a \<lbrace>\<lambda>rv s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
-  by (simp add:tcbSchedEnqueue_def unless_def setQueue_def | wp | wpc)+
-
 crunch valid_duplicates'[wp]: rescheduleRequired "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
   (wp: setObject_ksInterrupt updateObject_default_inv)
 
diff --git a/proof/refine/ARM_HYP/Refine.thy b/proof/refine/ARM_HYP/Refine.thy
index 01918758a6..21d902ed9b 100644
--- a/proof/refine/ARM_HYP/Refine.thy
+++ b/proof/refine/ARM_HYP/Refine.thy
@@ -82,7 +82,7 @@ lemma typ_at_UserDataI:
   apply (subst mask_lower_twice [where n = pageBits, OF pbfs_atleast_pageBits, symmetric])
   apply (clarsimp simp: obj_relation_cuts_def2 pte_relation_def
                         cte_relation_def other_obj_relation_def
-                        pde_relation_def
+                        pde_relation_def tcb_relation_cut_def
               split: Structures_A.kernel_object.split_asm
                      Structures_H.kernel_object.split_asm
                      if_split_asm arch_kernel_obj.split_asm)
@@ -113,7 +113,7 @@ lemma typ_at_DeviceDataI:
   apply (subst mask_lower_twice [where n = pageBits, OF pbfs_atleast_pageBits, symmetric])
   apply (clarsimp simp: obj_relation_cuts_def2 pte_relation_def
                         cte_relation_def other_obj_relation_def
-                        pde_relation_def
+                        pde_relation_def tcb_relation_cut_def
               split: Structures_A.kernel_object.split_asm
                      Structures_H.kernel_object.split_asm
                      if_split_asm arch_kernel_obj.split_asm)
@@ -578,7 +578,7 @@ lemma kernel_corres':
            apply simp
            apply (rule handleInterrupt_corres[simplified dc_def])
           apply simp
-          apply (wp hoare_drop_imps hoare_vcg_all_lift)[1]
+          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. irq \<notin> Some ` non_kernel_IRQs \<and> invs' s \<and>
                               (\<forall>irq'. irq = Some irq' \<longrightarrow>
@@ -656,7 +656,7 @@ lemma entry_corres:
     apply (rule corres_split[OF getCurThread_corres])
       apply (rule corres_split)
          apply simp
-         apply (rule threadset_corresT)
+         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)
@@ -668,7 +668,8 @@ lemma entry_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, simp add: invs_def cur_tcb_def)
+         apply (rule hoare_strengthen_post, rule akernel_invs_det_ext,
+                simp add: invs_def valid_state_def valid_pspace_def cur_tcb_def)
         apply (rule hoare_strengthen_post, rule ckernel_invs, simp add: invs'_def cur_tcb'_def)
        apply ((wp thread_set_invs_trivial thread_set_ct_running
                   thread_set_not_state_valid_sched hoare_weak_lift_imp
@@ -679,7 +680,7 @@ lemma entry_corres:
                  hoare_weak_lift_imp hoare_vcg_disj_lift
               | simp add: ct_in_state'_def atcbContextSet_def
               | (wps, wp threadSet_st_tcb_at2))+
-   apply (clarsimp simp: invs_def cur_tcb_def)
+   apply (fastforce simp: invs_def cur_tcb_def)
   apply (clarsimp simp: ct_in_state'_def)
   done
 
diff --git a/proof/refine/ARM_HYP/Retype_R.thy b/proof/refine/ARM_HYP/Retype_R.thy
index c29f7ab34c..616184c2f0 100644
--- a/proof/refine/ARM_HYP/Retype_R.thy
+++ b/proof/refine/ARM_HYP/Retype_R.thy
@@ -313,7 +313,7 @@ lemma state_relation_null_filterE:
      null_filter (caps_of_state t) = null_filter (caps_of_state s);
      null_filter' (ctes_of t') = null_filter' (ctes_of s');
      pspace_relation (kheap t) (ksPSpace t');
-     ekheap_relation (ekheap t) (ksPSpace t');
+     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';
@@ -1002,7 +1002,7 @@ lemma retype_ekheap_relation:
      apply (intro impI conjI)
       apply clarsimp
       apply (drule_tac x=a in bspec,force)
-      apply (clarsimp simp add: other_obj_relation_def split: if_split_asm)
+      apply (clarsimp simp: tcb_relation_cut_def split: if_split_asm)
        apply (case_tac ko,simp_all)
        apply (clarsimp simp add: makeObjectKO_def cong: if_cong split: sum.splits Structures_H.kernel_object.splits
                                  arch_kernel_object.splits ARM_HYP_H.object_type.splits
@@ -1183,6 +1183,11 @@ lemma update_gs_id:
   by (simp add: no_gs_types_def update_gs_def
            split: Structures_A.apiobject_type.splits aobject_type.splits)
 
+lemma ksReadyQueues_update_gs[simp]:
+  "ksReadyQueues (update_gs tp us addrs s) = ksReadyQueues s"
+  by (simp add: update_gs_def
+         split: aobject_type.splits Structures_A.apiobject_type.splits)
+
 lemma update_gs_simps[simp]:
   "update_gs Structures_A.apiobject_type.CapTableObject us ptrs =
    gsCNodes_update (\<lambda>cns x. if x \<in> ptrs then Some us else cns x)"
@@ -1197,6 +1202,144 @@ lemma update_gs_simps[simp]:
                                else ups x)"
   by (simp_all add: update_gs_def)
 
+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 -
+  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_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>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 (fastforce simp: ptr_add_def p_assoc_help)
+    done
+qed
+
+lemma retype_tcbSchedPrevs_of:
+  assumes   vs': "pspace_aligned' s'" "pspace_distinct' s'"
+  assumes   pn': "pspace_no_overlap' ptr sz s'"
+  assumes    ko: "makeObjectKO dev ty = Some ko"
+  assumes 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
+    "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 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_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
+    "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 -
+  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
+    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
+    by (cases ty;
+        fastforce simp: 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"
@@ -1225,7 +1368,7 @@ lemma retype_state_relation:
           \<in> state_relation"
   (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)
+  proof (rule state_relation_null_filterE[OF sr refl _ _ _ _ _ _ _ _ vs'], simp_all add: trans_state_update[symmetric] del: trans_state_update)
 
   have cover':"range_cover ptr sz (objBitsKO ko) m"
     by (rule range_cover_rel[OF cover objBits_le_obj_bits_api[OF ko] num_r])
@@ -1416,6 +1559,16 @@ lemma retype_state_relation:
                                   else cns x" in exI, simp)
       apply (rule_tac x=id in exI, simp)+
     done
+
+  have rdyqrel: "ready_queues_relation s s'"
+    using sr by (simp add: state_relation_def)
+
+  thus "ready_queues_relation_2 (ready_queues s) (ksReadyQueues s')
+                                (?ps' |> tcb_of' |> tcbSchedNext) (?ps' |> tcb_of' |> tcbSchedPrev)
+                                (\<lambda>d p. inQ d p |< (?ps' |> tcb_of'))"
+    using retype_ready_queues_relation[OF _ vs' pn' ko cover num_r]
+    by (clarsimp simp: ready_queues_relation_def Let_def)
+
 qed
 
 lemma new_cap_addrs_fold':
@@ -2431,7 +2584,6 @@ 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 :: Structures_H.notification)
-             | Structures_A.TCBObject \<Rightarrow> ko = injectKO (makeObject :: tcb)
              | _ \<Rightarrow> False \<rbrakk> \<Longrightarrow>
     obj_relation_retype (default_object ty dev n) ko"
   apply (rule obj_relation_retype_other_obj)
@@ -2452,6 +2604,13 @@ lemma other_objs_default_relation:
                  split: Structures_A.apiobject_type.split_asm)
   done
 
+lemma tcb_relation_retype:
+  "obj_relation_retype (default_object Structures_A.TCBObject dev n) (KOTCB makeObject)"
+  by (clarsimp simp: default_object_def obj_relation_retype_def tcb_relation_def default_tcb_def
+                     makeObject_tcb makeObject_cte new_context_def newContext_def tcb_relation_cut_def
+                     fault_rel_optionation_def initContext_def default_priority_def
+                     default_arch_tcb_def newArchTCB_def arch_tcb_relation_def objBits_simps')
+
 lemma captable_relation_retype:
   "n < word_bits \<Longrightarrow>
    obj_relation_retype (default_object Structures_A.CapTableObject dev n) (KOCTE makeObject)"
@@ -3152,10 +3311,10 @@ proof (intro conjI impI)
        apply (rule_tac ptr="x + xa" in cte_wp_at_tcbI', assumption+)
         apply fastforce
        apply simp
-      apply (rename_tac thread_state mcp priority bool option nat cptr vptr bound user_context)
-      apply (case_tac thread_state, simp_all add: valid_tcb_state'_def
-                                                  valid_bound_ntfn'_def obj_at_disj'
-                                           split: option.splits)[2]
+      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 (clarsimp simp add: valid_arch_tcb'_def typ_at_to_obj_at_arches obj_at_disj')
      apply (simp add: valid_cte'_def)
      apply (frule pspace_alignedD' [OF _ ad(1)])
@@ -3930,16 +4089,6 @@ lemma sch_act_wf_lift_asm:
   apply auto
   done
 
-lemma valid_queues_lift_asm':
-  assumes tat: "\<And>d p t. \<lbrace>\<lambda>s. \<not> obj_at' (inQ d p) t s \<and> Q d p s\<rbrace> f \<lbrace>\<lambda>_ s. \<not> obj_at' (inQ d p) t s\<rbrace>"
-  and     prq: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueues s)\<rbrace>"
-  shows   "\<lbrace>\<lambda>s. valid_queues' s \<and> (\<forall>d p. Q d p s)\<rbrace> f \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp only: valid_queues'_def imp_conv_disj)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift
-            tat prq)
-  apply simp
-  done
-
 lemma createObjects'_ct[wp]:
   "\<lbrace>\<lambda>s. P (ksCurThread s)\<rbrace> createObjects' p n v us \<lbrace>\<lambda>rv s. P (ksCurThread s)\<rbrace>"
   by (rule createObjects_pspace_only, simp)
@@ -4356,35 +4505,150 @@ crunch ksMachine[wp]: createObjects "\<lambda>s. P (ksMachineState s)"
 crunch cur_domain[wp]: createObjects "\<lambda>s. P (ksCurDomain s)"
   (simp: unless_def)
 
-lemma createNewCaps_valid_queues':
-  "\<lbrace>valid_queues' and pspace_no_overlap' ptr sz
-       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_queues'\<rbrace>"
-  apply (wp valid_queues_lift_asm' [OF createNewCaps_obj_at2])
-  apply (clarsimp simp: projectKOs)
-  apply (simp add: makeObjectKO_def
-            split: object_type.split_asm
-                   apiobject_type.split_asm)
-  apply (clarsimp simp: inQ_def)
-  apply (auto simp: makeObject_tcb
-             split: object_type.splits apiobject_type.splits)
+lemma createObjects_valid_bitmaps:
+  "createObjects' ptr n val gbits \<lbrace>valid_bitmaps\<rbrace>"
+  apply (clarsimp simp: createObjects'_def alignError_def split_def)
+  apply (wp case_option_wp[where P="\<lambda>_. P" and P'=P for P, simplified] assert_inv
+         | clarsimp simp del: fun_upd_apply)+
+  apply (clarsimp simp: valid_bitmaps_def valid_bitmapQ_def bitmapQ_def bitmapQ_no_L2_orphans_def
+                        bitmapQ_no_L1_orphans_def)
   done
 
-lemma createNewCaps_valid_queues:
-  "\<lbrace>valid_queues and pspace_no_overlap' ptr sz
-       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_queues\<rbrace>"
-  apply (rule hoare_gen_asm)
-  apply (wpsimp wp: valid_queues_lift_asm createNewCaps_obj_at2[where sz=sz])
-       apply (clarsimp simp: projectKO_opts_defs)
-       apply (simp add: inQ_def)
-      apply (wpsimp wp: createNewCaps_pred_tcb_at'[where sz=sz])+
+lemma valid_bitmaps_gsCNodes_update[simp]:
+  "valid_bitmaps (gsCNodes_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
+
+lemma valid_bitmaps_gsUserPages_update[simp]:
+  "valid_bitmaps (gsUserPages_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
+
+crunches curDomain, copyGlobalMappings
+  for valid_bitmaps[wp]: valid_bitmaps
+  and sched_pointers[wp]: "\<lambda>s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)"
+  and valid_sched_pointers[wp]: valid_sched_pointers
+
+lemma createNewCaps_valid_bitmaps:
+  "\<lbrace>\<lambda>s. valid_pspace' s \<and> pspace_no_overlap' ptr sz s \<and> valid_bitmaps s\<rbrace>
+   createNewCaps ty ptr n us dev
+   \<lbrace>\<lambda>_. valid_bitmaps\<rbrace>"
+  unfolding createNewCaps_def
+  apply (clarsimp simp: 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 (wpsimp wp: createObjects_valid_bitmaps)
+           by (wpsimp wp: createObjects_valid_bitmaps[simplified o_def] mapM_x_wp
+               | simp add: makeObject_tcb objBits_def createObjects_def
+               | intro conjI impI)+
+
+lemma createObjects_sched_queues:
+  "\<lbrace>\<lambda>s. n \<noteq> 0
+        \<and> range_cover ptr sz (objBitsKO val + gbits) n
+        \<and> P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)
+        \<and> (case val of KOTCB tcb \<Rightarrow> tcbSchedNext tcb = None \<and> tcbSchedPrev tcb = None
+                     | _ \<Rightarrow> True)
+        \<and> pspace_aligned' s \<and> pspace_distinct' s
+        \<and> pspace_no_overlap' ptr sz s\<rbrace>
+   createObjects' ptr n val gbits
+   \<lbrace>\<lambda>_ s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)\<rbrace>"
+  (is "\<lbrace> \<lambda>s. _ \<and> _ \<and> ?Pre s \<rbrace> _ \<lbrace>\<lambda>_. _\<rbrace>")
+proof (rule hoare_grab_asm)+
+  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>_ s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)\<rbrace>"
+  proof -
+    have shiftr_not_zero:" 1 \<le> ((of_nat n)::machine_word) << gbits"
+      using range_cover_not_zero_shift[OF not_0 cover,where gbits = gbits]
+      by (simp add:word_le_sub1)
+    show ?thesis
+      supply projectKOs[simp]
+      apply (clarsimp simp: createObjects'_def unless_def alignError_def split_def)
+      apply (wp | clarsimp simp del: fun_upd_apply)+
+      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 (clarsimp simp: foldr_upd_app_if)
+      apply (rule_tac a="tcbSchedNexts_of s" and b="tcbSchedPrevs_of s"
+                   in rsubst2[rotated, OF sym sym, where P=P])
+        apply (rule ext)
+        apply (clarsimp simp: opt_map_def)
+        apply (frule (3) retype_ksPSpace_None[simplified mult.commute])
+          apply (fastforce intro: cover)
+         apply fastforce
+        apply (clarsimp split: kernel_object.splits option.splits)
+       apply (rule ext)
+       apply (clarsimp simp: opt_map_def)
+       apply (frule (3) retype_ksPSpace_None[simplified mult.commute])
+         apply (fastforce intro: cover)
+        apply fastforce
+       apply (clarsimp split: kernel_object.splits option.splits)
+      apply simp
+      done
+  qed
+qed
+
+lemma createNewCaps_sched_queues:
+  assumes cover: "range_cover ptr sz (APIType_capBits ty us) n"
+  assumes not_0: "n \<noteq> 0"
+  shows
+    "\<lbrace>\<lambda>s. valid_pspace' s \<and> pspace_no_overlap' ptr sz s
+          \<and> P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)\<rbrace>
+     createNewCaps ty ptr n us dev
+     \<lbrace>\<lambda>_ s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)\<rbrace>"
+  unfolding createNewCaps_def
+  apply (clarsimp simp: ARM_HYP_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 (wp, simp)
+           apply (insert cover not_0)
+           apply (wpsimp wp: mapM_x_wp' createObjects_sched_queues threadSet_sched_pointers
+                         simp: curDomain_def createObjects_def)
+           apply (simp add: valid_pspace'_def makeObject_tcb)
+           by (wp createObjects_sched_queues mapM_x_wp'
+               | clarsimp simp: objBits_simps APIType_capBits_def createObjects_def
+                 vspace_bits_defs archObjSize_def
+               | intro conjI impI
+               | force)+
+
+
+lemma createObjects_valid_sched_pointers:
+  "\<lbrace>\<lambda>s. valid_sched_pointers s
+        \<and> (case val of KOTCB tcb \<Rightarrow> tcbSchedNext tcb = None \<and> tcbSchedPrev tcb = None
+                     | _ \<Rightarrow> True)\<rbrace>
+   createObjects' ptr n val gbits
+   \<lbrace>\<lambda>_. valid_sched_pointers\<rbrace>"
+  supply projectKOs[simp]
+  apply (clarsimp simp: createObjects'_def unless_def alignError_def split_def)
+  apply (wp case_option_wp[where P="\<lambda>_. P" and P'=P for P, simplified] assert_inv
+         | clarsimp simp del: fun_upd_apply)+
+  apply (clarsimp simp: valid_sched_pointers_def foldr_upd_app_if opt_pred_def opt_map_def comp_def)
+  apply (cases "tcb_of' val"; clarsimp)
   done
 
+lemma createNewCaps_valid_sched_pointers:
+  "\<lbrace>\<lambda>s. valid_pspace' s \<and> pspace_no_overlap' ptr sz s \<and> valid_sched_pointers s\<rbrace>
+   createNewCaps ty ptr n us dev
+   \<lbrace>\<lambda>_. valid_sched_pointers\<rbrace>"
+  unfolding createNewCaps_def
+  apply (clarsimp simp: 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 (wpsimp wp: createObjects_valid_sched_pointers)
+           by (wpsimp wp: createObjects_valid_sched_pointers[simplified o_def] mapM_x_wp
+                          threadSet_valid_sched_pointers
+               | simp add: makeObject_tcb objBits_def createObjects_def
+               | intro conjI impI)+
+
 lemma mapM_x_threadSet_valid_pspace:
   "\<lbrace>valid_pspace' and K (curdom \<le> maxDomain)\<rbrace>
     mapM_x (threadSet (tcbDomain_update (\<lambda>_. curdom))) addrs \<lbrace>\<lambda>y. valid_pspace'\<rbrace>"
@@ -4782,12 +5046,13 @@ proof (rule hoare_gen_asm, erule conjE)
                createNewCaps_valid_arch_state
                valid_irq_node_lift_asm [unfolded pred_conj_def, OF _ createNewCaps_obj_at']
                createNewCaps_irq_handlers' createNewCaps_vms
-               createNewCaps_valid_queues
-               createNewCaps_valid_queues'
                createNewCaps_pred_tcb_at' cnc_ct_not_inQ
                createNewCaps_ct_idle_or_in_cur_domain'
                createNewCaps_sch_act_wf
                createNewCaps_urz[where sz=sz]
+               createNewCaps_sched_queues[OF cover not_0]
+               createNewCaps_valid_sched_pointers
+               createNewCaps_valid_bitmaps
            | simp)+
   using not_0
   apply (clarsimp simp: valid_pspace'_def)
@@ -4860,35 +5125,6 @@ lemma createObjects_sch:
   apply (wp sch_act_wf_lift_asm createObjects_pred_tcb_at' createObjects_orig_obj_at3 | force)+
   done
 
-lemma createObjects_queues:
-  "\<lbrace>\<lambda>s. valid_queues 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. valid_queues\<rbrace>"
-  apply (wpsimp wp: valid_queues_lift_asm [unfolded pred_conj_def, OF createObjects_orig_obj_at3]
-                    createObjects_pred_tcb_at' [unfolded pred_conj_def])
-      apply fastforce
-     apply wp+
-  apply fastforce
-  done
-
-lemma createObjects_queues':
-  assumes no_tcb: "\<And>t. projectKO_opt val \<noteq> Some (t::tcb)"
-  shows
-  "\<lbrace>\<lambda>s. valid_queues' 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. valid_queues'\<rbrace>"
-  apply (simp add: createObjects_def)
-  apply (wp valid_queues_lift_asm')
-    apply (wp createObjects_orig_obj_at2')
-    apply clarsimp
-    apply assumption
-   apply wp
-  apply (clarsimp simp: no_tcb split: option.splits)
-  apply fastforce
-  done
-
 lemma createObjects_no_cte_ifunsafe':
   assumes no_cte: "\<And>c. projectKO_opt val \<noteq> Some (c::cte)"
   assumes no_tcb: "\<And>t. projectKO_opt val \<noteq> Some (t::tcb)"
@@ -5134,7 +5370,7 @@ proof -
    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 (wp createObjects_sch)
    apply (rule hoare_vcg_conj_lift)
     apply (simp add: createObjects_def)
     apply (wp createObjects_state_refs_of'')
@@ -5144,30 +5380,37 @@ proof -
    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]
-             assms | simp add: objBits_def )+
+   apply (wp createObjects_no_cte_ifunsafe'
+             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
+   apply (wp irqs_masked_lift 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_pspace_domain_valid co_ct_not_inQ
-             createObjects_ct_idle_or_in_cur_domain'
-             createObjects_untyped_ranges_zero'[OF moKO]
-         | simp)+
+             createObjects_no_cte_irq_handlers assms
+          | simp)+
+   apply (rule hoare_vcg_conj_lift)
+    apply (simp add: createObjects_def)
+    apply (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 (wp createObjects_idle')
+       apply (wpsimp wp: createObjects_valid_bitmaps)
+      apply (wp createObjects_cur'
+                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 (simp add: conj_comms)
   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 (clarsimp simp: invs'_def no_tcb valid_state'_def no_cte  split: option.splits)
-  done
+    apply (fastforce simp: no_cte no_tcb split_def split: option.splits)
+   apply (clarsimp simp: invs'_def no_tcb valid_state'_def no_cte  split: option.splits)
+  by (auto simp: invs'_def no_tcb valid_state'_def no_cte live'_def
+          split: option.splits kernel_object.splits)
 qed
 
 lemma corres_retype_update_gsI:
@@ -5203,7 +5446,7 @@ lemma gcd_corres: "corres (=) \<top> \<top> (gets cur_domain) curDomain"
 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. 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
@@ -5214,7 +5457,7 @@ lemma retype_region2_extra_ext_mapM_x_corres:
     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. tcb_at' t 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)
@@ -5222,8 +5465,10 @@ lemma retype_region2_extra_ext_mapM_x_corres:
             apply (case_tac tcb')
             apply simp
            apply fastforce
-          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
@@ -5255,10 +5500,11 @@ lemma retype_region2_obj_at:
   apply (auto simp: obj_at_def default_object_def is_tcb_def)
   done
 
-lemma createObjects_tcb_at':
+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\<rbrace>
-   createObjects ptr n (KOTCB makeObject) 0 \<lbrace>\<lambda>ptrs s. \<forall>addr\<in>set ptrs. tcb_at' addr 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
@@ -5335,7 +5581,7 @@ lemma corres_retype_region_createNewCaps:
                 apply (rule corres_retype[where 'a = tcb],
                        simp_all add: obj_bits_api_def objBits_simps' pageBits_def
                                     APIType_map2_def makeObjectKO_def
-                                    other_objs_default_relation)[1]
+                                    tcb_relation_retype)[1]
                 apply (fastforce simp: range_cover_def)
                apply (rule corres_split_nor)
                   apply (simp add: APIType_map2_def)
@@ -5346,7 +5592,7 @@ lemma corres_retype_region_createNewCaps:
                 apply wp
                apply wp
               apply ((wp retype_region2_obj_at | 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 ((wp createObjects_Not_tcbQueued[where sz=sz] | simp add: APIType_map2_def objBits_simps' obj_bits_api_def)+)[1]
             apply simp
            apply simp
           apply (subst retype_region2_extra_ext_trivial)
diff --git a/proof/refine/ARM_HYP/Schedule_R.thy b/proof/refine/ARM_HYP/Schedule_R.thy
index 709d465cbd..b89f389787 100644
--- a/proof/refine/ARM_HYP/Schedule_R.thy
+++ b/proof/refine/ARM_HYP/Schedule_R.thy
@@ -15,11 +15,6 @@ declare hoare_weak_lift_imp[wp_split del]
 (* Levity: added (20090713 10:04:12) *)
 declare sts_rel_idle [simp]
 
-lemma invs_no_cicd'_queues:
-  "invs_no_cicd' s \<Longrightarrow> valid_queues s"
-  unfolding invs_no_cicd'_def
-  by simp
-
 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)"
@@ -133,12 +128,17 @@ lemma arch_switchToThread_corres:
               and valid_vs_lookup and valid_global_objs
               and unique_table_refs o caps_of_state
               and st_tcb_at runnable t and (\<lambda>s. sym_refs (state_hyp_refs_of s)))
-             (valid_arch_state' and valid_pspace' and st_tcb_at' runnable' t
-              and (\<lambda>s. sym_refs (state_hyp_refs_of' s)))
+             (valid_arch_state' and no_0_obj' and (\<lambda>s. sym_refs (state_hyp_refs_of' s)))
              (arch_switch_to_thread t) (Arch.switchToThread t)"
+  apply (rule_tac Q'="tcb_at' t" in corres_cross_add_guard)
+   apply (fastforce intro!: tcb_at_cross 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 (simp add: arch_switch_to_thread_def ARM_HYP_H.switchToThread_def)
   apply (rule corres_guard_imp)
-    apply (rule corres_split[OF get_tcb_corres])
+    apply (rule corres_split[OF getObject_TCB_corres])
       apply (rule corres_split[OF vcpuSwitch_corres'])
          apply (clarsimp simp: tcb_relation_def arch_tcb_relation_def)
         apply (rule corres_split[OF setVMRoot_corres])
@@ -170,327 +170,280 @@ lemma schedule_choose_new_thread_sched_act_rct[wp]:
   unfolding schedule_choose_new_thread_def
   by wp
 
+\<comment> \<open>This proof shares many similarities with the proof of @{thm tcbSchedEnqueue_corres}\<close>
 lemma tcbSchedAppend_corres:
-  notes trans_state_update'[symmetric, simp del]
-  shows
-  "corres dc (is_etcb_at t) (tcb_at' t and Invariants_H.valid_queues and valid_queues') (tcb_sched_action (tcb_sched_append) t) (tcbSchedAppend t)"
-  apply (simp only: tcbSchedAppend_def tcb_sched_action_def)
-  apply (rule corres_symb_exec_r [OF _ _ threadGet_inv, 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, simp)
-   apply (rule no_fail_pre, wp, simp)
-  apply (case_tac queued)
-   apply (simp add: unless_def when_def)
-   apply (rule corres_no_failI)
-    apply wp+
-   apply (clarsimp simp: in_monad ethread_get_def gets_the_def bind_assoc
-                         assert_opt_def exec_gets is_etcb_at_def get_etcb_def get_tcb_queue_def
-                         set_tcb_queue_def simpler_modify_def)
-
-   apply (subgoal_tac "tcb_sched_append t (ready_queues a (tcb_domain y) (tcb_priority y))
-                       = (ready_queues a (tcb_domain y) (tcb_priority y))")
-    apply (simp add: state_relation_def ready_queues_relation_def)
-   apply (clarsimp simp: tcb_sched_append_def state_relation_def
-                         valid_queues'_def ready_queues_relation_def
-                         ekheap_relation_def etcb_relation_def
-                         obj_at'_def inQ_def projectKO_eq project_inject)
-   apply (drule_tac x=t in bspec,clarsimp)
+  "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_append tcb_ptr) (tcbSchedAppend tcbPtr)"
+  supply if_split[split del]
+         heap_path_append[simp del] fun_upd_apply[simp del] distinct_append[simp del]
+         projectKOs[simp]
+  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_append_def get_tcb_queue_def
+                        tcbSchedAppend_def getQueue_def unless_def when_def)
+  apply (rule corres_symb_exec_l[OF _ _ ethread_get_sp]; (solves wpsimp)?)
+  apply (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]; 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)
+   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 (clarsimp simp: unless_def when_def cong: if_cong)
-  apply (rule stronger_corres_guard_imp)
-    apply (rule corres_split[where r'="(=)"])
-       apply (rule ethreadget_corres)
-       apply (simp add: etcb_relation_def)
-      apply (rule corres_split[where r'="(=)"])
-         apply (rule ethreadget_corres)
-         apply (simp add: etcb_relation_def)
-        apply (rule corres_split[where r'="(=)"])
-           apply simp
-           apply (rule getQueue_corres)
-          apply (rule corres_split_noop_rhs2)
-             apply (simp add: tcb_sched_append_def)
-             apply (intro conjI impI)
-              apply (rule corres_guard_imp)
-                apply (rule setQueue_corres)
-               prefer 3
-               apply (rule_tac P=\<top> and Q="K (t \<notin> set queuea)" in corres_assume_pre)
-               apply simp
-              apply simp
-             apply simp
-            apply (rule corres_split_noop_rhs2)
-               apply (rule addToBitmap_if_null_noop_corres)
-              apply (rule threadSet_corres_noop, simp_all add: tcb_relation_def exst_same_def)[1]
-             apply wp+
-          apply (wp getObject_tcb_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
-
-
-crunches tcbSchedEnqueue, tcbSchedAppend, tcbSchedDequeue
-  for valid_pspace'[wp]: valid_pspace'
-  and valid_arch_state'[wp]: valid_arch_state'
-  and pred_tcb_at'[wp]: "pred_tcb_at' proj P t"
-  (wp: threadSet_pred_tcb_no_state simp: unless_def tcb_to_itcb'_def)
-
-lemma removeFromBitmap_valid_queues_no_bitmap_except[wp]:
-" \<lbrace> valid_queues_no_bitmap_except t \<rbrace>
-     removeFromBitmap d p
-  \<lbrace>\<lambda>_. valid_queues_no_bitmap_except t \<rbrace>"
-  unfolding bitmapQ_defs valid_queues_no_bitmap_except_def
-  by (wp| clarsimp simp: bitmap_fun_defs)+
-
-lemma removeFromBitmap_bitmapQ:
-  "\<lbrace> \<lambda>s. True \<rbrace> removeFromBitmap d p \<lbrace>\<lambda>_ s. \<not> bitmapQ d p s \<rbrace>"
-  unfolding bitmapQ_defs bitmap_fun_defs
-  by (wp| clarsimp simp: bitmap_fun_defs)+
-
-lemma removeFromBitmap_valid_bitmapQ[wp]:
-" \<lbrace> valid_bitmapQ_except d p and bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans and
-    (\<lambda>s. ksReadyQueues s (d,p) = []) \<rbrace>
-     removeFromBitmap d p
-  \<lbrace>\<lambda>_. valid_bitmapQ \<rbrace>"
-proof -
-  have "\<lbrace> valid_bitmapQ_except d p and bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans and
-            (\<lambda>s. ksReadyQueues s (d,p) = []) \<rbrace>
-         removeFromBitmap d p
-         \<lbrace>\<lambda>_. valid_bitmapQ_except d p and  bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans and
-              (\<lambda>s. \<not> bitmapQ d p s \<and> ksReadyQueues s (d,p) = []) \<rbrace>"
-    by (rule hoare_pre)
-       (wp removeFromBitmap_valid_queues_no_bitmap_except removeFromBitmap_valid_bitmapQ_except
-           removeFromBitmap_bitmapQ, simp)
-  thus ?thesis
-    by - (erule hoare_strengthen_post; fastforce elim: valid_bitmap_valid_bitmapQ_exceptE)
-qed
+  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)?)
 
-(* this should be the actual weakest precondition to establish valid_queues
-   under tagging a thread as not queued *)
-lemma threadSet_valid_queues_dequeue_wp:
- "\<lbrace> valid_queues_no_bitmap_except t and
-        valid_bitmapQ and bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans and
-        (\<lambda>s. \<forall>d p. t \<notin> set (ksReadyQueues s (d,p))) \<rbrace>
-          threadSet (tcbQueued_update (\<lambda>_. False)) t
-       \<lbrace>\<lambda>rv. valid_queues \<rbrace>"
-  unfolding threadSet_def
-  apply (rule hoare_seq_ext[OF _ getObject_tcb_sp])
-  apply (rule hoare_pre)
-   apply (simp add: valid_queues_def valid_queues_no_bitmap_except_def valid_queues_no_bitmap_def)
-   apply (wp setObject_queues_unchanged_tcb hoare_Ball_helper hoare_vcg_all_lift
-             setObject_tcb_strongest)
-  apply (clarsimp simp: valid_queues_no_bitmap_except_def obj_at'_def valid_queues_no_bitmap_def)
-  done
+  \<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'])
 
-(* FIXME move *)
-lemmas obj_at'_conjI = obj_at_conj'
-
-lemma setQueue_valid_queues_no_bitmap_except_dequeue_wp:
-  "\<And>d p ts t.
-   \<lbrace> \<lambda>s. valid_queues_no_bitmap_except t s \<and>
-         (\<forall>t' \<in> set ts. obj_at' (inQ d p and runnable' \<circ> tcbState) t' s) \<and>
-         t \<notin> set ts \<and> distinct ts \<and> p \<le> maxPriority \<and> d \<le> maxDomain \<rbrace>
-       setQueue d p ts
-   \<lbrace>\<lambda>rv. valid_queues_no_bitmap_except t \<rbrace>"
-  unfolding setQueue_def valid_queues_no_bitmap_except_def null_def
-  by wp force
-
-definition (* if t is in a queue, it should be tagged with right priority and domain *)
-  "correct_queue t s \<equiv> \<forall>d p. t \<in> set(ksReadyQueues s (d, p)) \<longrightarrow>
-             (obj_at' (\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d \<and> tcbPriority tcb = p) t s)"
-
-lemma valid_queues_no_bitmap_correct_queueI[intro]:
-  "valid_queues_no_bitmap s \<Longrightarrow> correct_queue t s"
-  unfolding correct_queue_def valid_queues_no_bitmap_def
-  by (fastforce simp: obj_at'_def inQ_def)
-
-
-lemma tcbSchedDequeue_valid_queues_weak:
-  "\<lbrace> valid_queues_no_bitmap_except t and valid_bitmapQ and
-     bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans and
-     correct_queue t and
-     obj_at' (\<lambda>tcb. tcbDomain tcb \<le> maxDomain \<and> tcbPriority tcb \<le> maxPriority) t \<rbrace>
-   tcbSchedDequeue t
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-proof -
-  show ?thesis
-  unfolding tcbSchedDequeue_def null_def valid_queues_def
-  apply wp (* stops on threadSet *)
-          apply (rule hoare_post_eq[OF _ threadSet_valid_queues_dequeue_wp],
-                 simp add: valid_queues_def)
-         apply (wp hoare_vcg_if_lift hoare_vcg_conj_lift hoare_vcg_imp_lift)+
-             apply (wp hoare_vcg_imp_lift setQueue_valid_queues_no_bitmap_except_dequeue_wp
-                       setQueue_valid_bitmapQ threadGet_const_tcb_at hoare_vcg_if_lift)+
-  (* wp done *)
-  apply (normalise_obj_at')
-  apply (clarsimp simp: correct_queue_def)
-  apply (normalise_obj_at')
-  apply (fastforce simp add: valid_queues_no_bitmap_except_def valid_queues_no_bitmap_def elim: obj_at'_weaken)+
-  done
-qed
-
-lemma tcbSchedDequeue_valid_queues:
-  "\<lbrace>Invariants_H.valid_queues
-    and obj_at' (\<lambda>tcb. tcbDomain tcb \<le> maxDomain) t
-    and obj_at' (\<lambda>tcb. tcbPriority tcb \<le> maxPriority) t\<rbrace>
-     tcbSchedDequeue t
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (rule hoare_pre, rule tcbSchedDequeue_valid_queues_weak)
-  apply (fastforce simp: valid_queues_def valid_queues_no_bitmap_def obj_at'_def inQ_def)
-  done
-
-lemma tcbSchedAppend_valid_queues'[wp]:
-  (* most of this is identical to tcbSchedEnqueue_valid_queues' in TcbAcc_R *)
-  "\<lbrace>valid_queues' and tcb_at' t\<rbrace> tcbSchedAppend t \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp add: tcbSchedAppend_def)
-  apply (rule hoare_pre)
-   apply (rule_tac B="\<lambda>rv. valid_queues' and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"
-           in hoare_seq_ext)
-    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 wpsimp
+    apply (wpsimp wp: hoare_vcg_if_lift hoare_vcg_ex_lift)
+   apply (corres corres: addToBitmap_if_null_noop_corres)
+
+  apply (rule corres_from_valid_det)
+    apply (fastforce intro: det_wp_modify det_wp_pre simp: set_tcb_queue_def)
+   apply (wpsimp simp: tcbQueueAppend_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'_tcbQueueEnd_ksReadyQueues simp: obj_at'_def)
+
+  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 simp: setQueue_def tcbQueueAppend_def)
+  apply normalise_obj_at'
+  apply (frule (1) tcb_at_is_etcb_at)
+  apply (clarsimp simp: obj_at_def is_etcb_at_def etcb_at_def)
+  apply (rename_tac s d p s' tcb' tcb etcb)
+  apply (frule_tac t=tcbPtr in ekheap_relation_tcb_domain_priority)
+    apply (force simp: obj_at_def)
+   apply (force simp: obj_at'_def)
+  apply (clarsimp split: if_splits)
+  apply (cut_tac ts="ready_queues s d p" in list_queue_relation_nil)
+   apply (force dest!: spec simp: list_queue_relation_def)
+  apply (cut_tac ts="ready_queues s (tcb_domain etcb) (tcb_priority etcb)"
+              in obj_at'_tcbQueueEnd_ksReadyQueues)
+      apply fast
+     apply fast
+    apply fastforce
+   apply fastforce
+  apply (cut_tac xs="ready_queues s d p" in heap_path_head')
+   apply (force dest!: spec simp: list_queue_relation_def)
+  apply (clarsimp simp: list_queue_relation_def)
+
+  apply (case_tac "d \<noteq> tcb_domain etcb \<or> p \<noteq> tcb_priority etcb")
+   apply (cut_tac d=d and d'="tcb_domain etcb" and p=p and p'="tcb_priority etcb"
+               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)
+    apply (metis inQ_def option.simps(5) tcb_of'_TCB)
+   apply (intro conjI impI; clarsimp)
+
+    \<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 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_def)+
-     apply (clarsimp simp: obj_at'_def inQ_def projectKOs valid_queues'_def)
-    apply (wp getObject_tcb_wp | simp add: threadGet_def)+
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-lemma threadSet_valid_queues'_dequeue: (* threadSet_valid_queues' is too weak for dequeue *)
-  "\<lbrace>\<lambda>s. (\<forall>d p t'. obj_at' (inQ d p) t' s \<and> t' \<noteq> t \<longrightarrow> t' \<in> set (ksReadyQueues s (d, p))) \<and>
-        obj_at' (inQ d p) t s \<rbrace>
-   threadSet (tcbQueued_update (\<lambda>_. False)) t
-   \<lbrace>\<lambda>rv. valid_queues' \<rbrace>"
-   unfolding valid_queues'_def
-   apply (rule hoare_pre)
-    apply (wp hoare_vcg_all_lift)
-    apply (simp only: imp_conv_disj not_obj_at')
-   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-   apply (simp add: not_obj_at')
-   apply (clarsimp simp: typ_at_tcb')
-   apply normalise_obj_at'
-   apply (fastforce elim: obj_at'_weaken simp: inQ_def)
-   done
-
-lemma setQueue_ksReadyQueues_lift:
-  "\<lbrace> \<lambda>s. P (s\<lparr>ksReadyQueues := (ksReadyQueues s)((d, p) := ts)\<rparr>) ts \<rbrace>
-   setQueue d p ts
-   \<lbrace> \<lambda>_ s. P s (ksReadyQueues s (d,p))\<rbrace>"
-  unfolding setQueue_def
-  by (wp, clarsimp simp: fun_upd_def snd_def)
-
-lemma tcbSchedDequeue_valid_queues'[wp]:
-  "\<lbrace>valid_queues' and tcb_at' t\<rbrace>
-    tcbSchedDequeue t \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  unfolding tcbSchedDequeue_def
-  apply (rule_tac B="\<lambda>rv. valid_queues' and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"
-                in hoare_seq_ext)
-   prefer 2
-   apply (wp threadGet_const_tcb_at)
-   apply (fastforce simp: obj_at'_def)
+        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 (tcbQueueEnd (ksReadyQueues s' (tcb_domain etcb, tcb_priority etcb)))
+                    \<notin> set (ready_queues s d p)")
+    apply (erule orthD2)
+    apply (drule_tac x="tcb_domain etcb" in spec)
+    apply (drule_tac x="tcb_priority etcb" in spec)
+    apply clarsimp
+    apply (drule_tac x="the (tcbQueueEnd (ksReadyQueues s' (tcb_domain etcb, tcb_priority etcb)))"
+                 in spec)
+    subgoal by (auto simp: in_opt_pred opt_map_red)
+   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";
+              clarsimp 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 split: if_splits)
+     apply (case_tac "t = the (tcbQueueEnd (ksReadyQueues s' (tcb_domain etcb, tcb_priority etcb)))")
+      apply (clarsimp simp: inQ_def opt_pred_def fun_upd_apply)
+     apply (clarsimp simp: inQ_def in_opt_pred opt_map_def fun_upd_apply)
+    apply (clarsimp simp: fun_upd_apply split: if_splits)
+   apply (clarsimp simp: fun_upd_apply split: if_splits)
+
+  \<comment> \<open>d = tcb_domain tcb \<and> p = tcb_priority tcb\<close>
   apply clarsimp
-  apply (rename_tac queued)
-  apply (case_tac queued, simp_all)
-   apply wp
-        apply (rule_tac d=tdom and p=prio in threadSet_valid_queues'_dequeue)
-       apply (rule hoare_pre_post, assumption)
-       apply (wp | clarsimp simp: bitmap_fun_defs)+
-      apply (wp hoare_vcg_all_lift setQueue_ksReadyQueues_lift)
-     apply clarsimp
-     apply (wp threadGet_obj_at' threadGet_const_tcb_at)+
-   apply clarsimp
-   apply (rule context_conjI, clarsimp simp: obj_at'_def)
-   apply (clarsimp simp: valid_queues'_def obj_at'_def projectKOs inQ_def|wp)+
+  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)
+  apply (frule valid_tcbs'_maxPriority[where t=tcbPtr], simp add: obj_at'_def)
+  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)
+  apply (intro conjI; clarsimp)
+
+   \<comment> \<open>the ready queue was originally empty\<close>
+   apply (force simp: inQ_def in_opt_pred fun_upd_apply opt_map_def obj_at'_def
+                      queue_end_valid_def prev_queue_head_def
+               split: if_splits option.splits)
+
+   \<comment> \<open>the ready queue was not originally empty\<close>
+  apply (drule (2) heap_ls_append[where new=tcbPtr])
+  apply (rule conjI)
+   apply (clarsimp simp: fun_upd_apply queue_end_valid_def opt_map_def split: if_splits)
+  apply (rule conjI)
+   apply (clarsimp simp: fun_upd_apply queue_end_valid_def)
+  apply (rule conjI)
+   apply (subst opt_map_upd_triv)
+    apply (clarsimp simp: opt_map_def fun_upd_apply queue_end_valid_def split: if_splits)
+   apply (clarsimp simp: prev_queue_head_def fun_upd_apply split: if_splits)
+  by (clarsimp simp: inQ_def in_opt_pred fun_upd_apply queue_end_valid_def split: if_splits)
+
+lemma tcbQueueAppend_valid_objs'[wp]:
+  "\<lbrace>\<lambda>s. valid_objs' s \<and> tcb_at' tcbPtr s \<and> (\<forall>end. tcbQueueEnd queue = Some end \<longrightarrow> tcb_at' end s)\<rbrace>
+   tcbQueueAppend queue tcbPtr
+   \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
+  unfolding tcbQueueAppend_def
+  apply (wpsimp wp: hoare_vcg_if_lift2 hoare_vcg_imp_lift')
+  apply (clarsimp simp: tcbQueueEmpty_def valid_bound_tcb'_def split: option.splits)
+  done
+
+lemma tcbSchedAppend_valid_objs'[wp]:
+  "\<lbrace>valid_objs' and pspace_aligned' and pspace_distinct'\<rbrace>
+   tcbSchedAppend tcbPtr
+   \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
+  apply (clarsimp simp: tcbSchedAppend_def setQueue_def)
+  apply (wpsimp wp: threadSet_valid_objs' threadGet_wp hoare_vcg_all_lift)
+  apply (normalise_obj_at', rename_tac tcb "end")
+  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
+  apply (frule tcbQueueHead_iff_tcbQueueEnd)
+  apply (force dest!: obj_at'_tcbQueueEnd_ksReadyQueues simp: tcbQueueEmpty_def obj_at'_def)
   done
 
-crunch tcb_at'[wp]: tcbSchedAppend "tcb_at' t"
-  (simp: unless_def)
-
-crunch state_refs_of'[wp]: tcbSchedAppend "\<lambda>s. P (state_refs_of' s)"
-  (wp: refl simp: crunch_simps unless_def)
-crunch state_refs_of'[wp]: tcbSchedDequeue "\<lambda>s. P (state_refs_of' s)"
-  (wp: refl simp: crunch_simps)
+crunches tcbSchedAppend, tcbSchedDequeue
+  for pred_tcb_at'[wp]: "pred_tcb_at' proj P t"
+  (wp: threadSet_pred_tcb_no_state simp: unless_def tcb_to_itcb'_def)
 
-crunch state_hyp_refs_of'[wp]: tcbSchedAppend "\<lambda>s. P (state_hyp_refs_of' s)"
-  (wp: refl simp: crunch_simps unless_def)
-crunch state_hyp_refs_of'[wp]: tcbSchedDequeue "\<lambda>s. P (state_hyp_refs_of' s)"
-  (wp: refl simp: crunch_simps)
+(* FIXME move *)
+lemmas obj_at'_conjI = obj_at_conj'
 
-crunch cap_to'[wp]: tcbSchedEnqueue "ex_nonz_cap_to' p"
-  (simp: unless_def)
-crunch cap_to'[wp]: tcbSchedAppend "ex_nonz_cap_to' p"
-  (simp: unless_def)
-crunch cap_to'[wp]: tcbSchedDequeue "ex_nonz_cap_to' p"
+crunches tcbSchedAppend, tcbSchedDequeue, tcbSchedEnqueue
+  for tcb_at'[wp]: "tcb_at' t"
+  and cap_to'[wp]: "ex_nonz_cap_to' p"
+  and ifunsafe'[wp]: if_unsafe_then_cap'
+  (wp: crunch_wps simp: crunch_simps)
 
 lemma tcbSchedAppend_iflive'[wp]:
-  "\<lbrace>if_live_then_nonz_cap' and ex_nonz_cap_to' tcb\<rbrace>
-    tcbSchedAppend tcb \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
-  apply (simp add: tcbSchedAppend_def unless_def)
-  apply (wp threadSet_iflive' hoare_drop_imps | simp add: crunch_simps)+
+  "\<lbrace>if_live_then_nonz_cap' and pspace_aligned' and pspace_distinct'\<rbrace>
+   tcbSchedAppend tcbPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  supply projectKOs[simp]
+  unfolding tcbSchedAppend_def
+  apply (wpsimp wp: tcbQueueAppend_if_live_then_nonz_cap' threadGet_wp simp: bitmap_fun_defs)
+  apply (frule_tac p=tcbPtr in if_live_then_nonz_capE')
+   apply (fastforce simp: ko_wp_at'_def st_tcb_at'_def obj_at'_def runnable_eq_active' live'_def)
+  apply (clarsimp simp: tcbQueueEmpty_def)
+  apply (erule if_live_then_nonz_capE')
+  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 (fastforce dest!: obj_at'_tcbQueueEnd_ksReadyQueues
+                    simp: ko_wp_at'_def inQ_def obj_at'_def tcbQueueEmpty_def live'_def)
   done
 
 lemma tcbSchedDequeue_iflive'[wp]:
-  "\<lbrace>if_live_then_nonz_cap'\<rbrace> tcbSchedDequeue tcb \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  "\<lbrace>if_live_then_nonz_cap' and valid_objs' and sym_heap_sched_pointers\<rbrace>
+   tcbSchedDequeue tcbPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  supply projectKOs[simp]
   apply (simp add: tcbSchedDequeue_def)
-  apply (wp threadSet_iflive' hoare_when_weak_wp | simp add: crunch_simps)+
-       apply ((wp | clarsimp simp: bitmap_fun_defs)+)[1] (* deal with removeFromBitmap *)
-      apply (wp threadSet_iflive' hoare_when_weak_wp | simp add: crunch_simps)+
-      apply (rule_tac Q="\<lambda>rv. \<top>" in hoare_post_imp, fastforce)
-      apply (wp | simp add: crunch_simps)+
+  apply (wpsimp wp: tcbQueueRemove_if_live_then_nonz_cap' threadGet_wp)
+  apply (fastforce elim: if_live_then_nonz_capE' simp: obj_at'_def ko_wp_at'_def live'_def)
   done
 
-crunch ifunsafe'[wp]: tcbSchedAppend if_unsafe_then_cap'
-  (simp: unless_def)
-crunch ifunsafe'[wp]: tcbSchedDequeue if_unsafe_then_cap'
-
-crunch idle'[wp]: tcbSchedAppend valid_idle'
-  (simp: crunch_simps unless_def)
-
-crunch global_refs'[wp]: tcbSchedEnqueue valid_global_refs'
-  (wp: threadSet_global_refs simp: unless_def)
-crunch global_refs'[wp]: tcbSchedAppend valid_global_refs'
-  (wp: threadSet_global_refs simp: unless_def)
-crunch global_refs'[wp]: tcbSchedDequeue valid_global_refs'
-  (wp: threadSet_global_refs)
-
-crunch irq_node'[wp]: tcbSchedAppend "\<lambda>s. P (irq_node' s)"
-  (simp: unless_def)
-crunch irq_node'[wp]: tcbSchedDequeue "\<lambda>s. P (irq_node' s)"
-
-crunch typ_at'[wp]: tcbSchedAppend "\<lambda>s. P (typ_at' T p s)"
-  (simp: unless_def)
-
-crunch ctes_of[wp]: tcbSchedAppend "\<lambda>s. P (ctes_of s)"
-  (simp: unless_def)
-
-crunch ksInterrupt[wp]: tcbSchedAppend "\<lambda>s. P (ksInterruptState s)"
-  (simp: unless_def)
-crunch ksInterrupt[wp]: tcbSchedDequeue "\<lambda>s. P (ksInterruptState s)"
-
-crunch irq_states[wp]: tcbSchedAppend valid_irq_states'
-  (simp: unless_def)
-crunch irq_states[wp]: tcbSchedDequeue valid_irq_states'
-
-crunch ct'[wp]: tcbSchedAppend "\<lambda>s. P (ksCurThread s)"
-  (simp: unless_def)
-
-crunch pde_mappings'[wp]: tcbSchedAppend "valid_pde_mappings'"
-  (simp: unless_def)
-crunch pde_mappings'[wp]: tcbSchedDequeue "valid_pde_mappings'"
+crunches tcbSchedAppend, tcbSchedDequeue, tcbSchedEnqueue
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+  and tcb_at'[wp]: "tcb_at' t"
+  and ctes_of[wp]: "\<lambda>s. P (ctes_of s)"
+  and ksInterrupt[wp]: "\<lambda>s. P (ksInterruptState s)"
+  and irq_states[wp]: valid_irq_states'
+  and irq_node'[wp]: "\<lambda>s. P (irq_node' s)"
+  and ct'[wp]: "\<lambda>s. P (ksCurThread s)"
+  and global_refs'[wp]: valid_global_refs'
+  and ifunsafe'[wp]: if_unsafe_then_cap'
+  and cap_to'[wp]: "ex_nonz_cap_to' p"
+  and state_refs_of'[wp]: "\<lambda>s. P (state_refs_of' s)"
+  and state_hyp_refs_of'[wp]: "\<lambda>s. P (state_hyp_refs_of' s)"
+  and idle'[wp]: valid_idle'
+  and valid_pde_mappings'[wp]: valid_pde_mappings'
+  (simp: unless_def crunch_simps obj_at'_def wp: getObject_tcb_wp)
 
 lemma tcbSchedEnqueue_vms'[wp]:
   "\<lbrace>valid_machine_state'\<rbrace> tcbSchedEnqueue t \<lbrace>\<lambda>_. valid_machine_state'\<rbrace>"
@@ -520,19 +473,85 @@ lemma ct_idle_or_in_cur_domain'_lift2:
   apply simp+
   done
 
+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 tcbSchedNext_update_valid_mdb'[wp]:
+  "\<lbrace>valid_mdb' and tcb_at' tcbPtr\<rbrace> threadSet (tcbSchedNext_update f) tcbPtr \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  apply (wpsimp wp: threadSet_mdb')
+  apply (fastforce simp: obj_at'_def valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)
+  done
+
+lemma tcbSchedPrev_update_valid_mdb'[wp]:
+  "\<lbrace>valid_mdb' and tcb_at' tcbPtr\<rbrace> threadSet (tcbSchedPrev_update f) tcbPtr \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  apply (wpsimp wp: threadSet_mdb')
+  apply (fastforce simp: obj_at'_def valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)
+  done
+
+lemma tcbQueueRemove_valid_mdb':
+  "\<lbrace>\<lambda>s. valid_mdb' s \<and> valid_objs' s\<rbrace> tcbQueueRemove q tcbPtr \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  unfolding tcbQueueRemove_def
+  apply (wpsimp wp: getTCB_wp)
+  apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+  apply (fastforce simp: valid_tcb'_def obj_at'_def)
+  done
+
+lemma tcbQueuePrepend_valid_mdb':
+  "\<lbrace>valid_mdb' and tcb_at' tcbPtr
+    and (\<lambda>s. \<not> tcbQueueEmpty queue \<longrightarrow> tcb_at' (the (tcbQueueHead queue)) s)\<rbrace>
+   tcbQueuePrepend queue tcbPtr
+   \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  unfolding tcbQueuePrepend_def
+  by (wpsimp wp: hoare_vcg_if_lift2 hoare_vcg_imp_lift')
+
+lemma tcbQueueAppend_valid_mdb':
+  "\<lbrace>\<lambda>s. valid_mdb' s \<and> tcb_at' tcbPtr s
+        \<and> (\<not> tcbQueueEmpty queue \<longrightarrow> tcb_at' (the (tcbQueueEnd queue)) s)\<rbrace>
+   tcbQueueAppend queue tcbPtr
+   \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  unfolding tcbQueueAppend_def
+  by (wpsimp wp: hoare_vcg_if_lift2 hoare_vcg_imp_lift')
+
+lemma tcbQueued_update_valid_mdb'[wp]:
+  "\<lbrace>valid_mdb' and tcb_at' tcbPtr\<rbrace> threadSet (tcbQueued_update f) tcbPtr \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  apply (wpsimp wp: threadSet_mdb')
+  apply (fastforce simp: obj_at'_def valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)
+  done
+
+lemma valid_mdb'_ksReadyQueuesL1Bitmap_update[simp]:
+  "valid_mdb' (ksReadyQueuesL1Bitmap_update f s) = valid_mdb' s"
+  by (simp add: valid_mdb'_def)
+
+lemma valid_mdb'_ksReadyQueuesL2Bitmap_update[simp]:
+  "valid_mdb' (ksReadyQueuesL2Bitmap_update f s) = valid_mdb' s"
+  by (simp add: valid_mdb'_def)
+
+lemma tcbSchedEnqueue_valid_mdb'[wp]:
+  "\<lbrace>valid_mdb' and valid_objs' and pspace_aligned' and pspace_distinct'\<rbrace>
+   tcbSchedEnqueue tcbPtr
+   \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  apply (clarsimp simp: tcbSchedEnqueue_def setQueue_def)
+  apply (wpsimp wp: tcbQueuePrepend_valid_mdb' threadGet_wp simp: bitmap_fun_defs)
+  apply normalise_obj_at'
+  apply (fastforce dest!: obj_at'_tcbQueueHead_ksReadyQueues
+                    simp: ready_queue_relation_def ksReadyQueues_asrt_def obj_at'_def)
+  done
+
+crunches tcbSchedEnqueue
+  for cur_tcb'[wp]: cur_tcb'
+  (wp: threadSet_cur)
+
 lemma tcbSchedEnqueue_invs'[wp]:
-  "\<lbrace>invs'
-    and st_tcb_at' runnable' t
-    and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t)\<rbrace>
-     tcbSchedEnqueue t
+  "\<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_state'_def)
-  apply (rule hoare_pre)
-   apply (wp tcbSchedEnqueue_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 tcbSchedEnqueue_ct_not_inQ
+              simp: cteCaps_of_def o_def)
   done
 
 crunch ksMachine[wp]: tcbSchedAppend "\<lambda>s. P (ksMachineState s)"
@@ -541,7 +560,7 @@ crunch ksMachine[wp]: tcbSchedAppend "\<lambda>s. P (ksMachineState s)"
 lemma tcbSchedAppend_vms'[wp]:
   "\<lbrace>valid_machine_state'\<rbrace> tcbSchedAppend t \<lbrace>\<lambda>_. valid_machine_state'\<rbrace>"
   apply (simp add: valid_machine_state'_def pointerInUserData_def pointerInDeviceData_def)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift tcbSchedAppend_ksMachine)
+  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
   done
 
 crunch pspace_domain_valid[wp]: tcbSchedAppend "pspace_domain_valid"
@@ -556,21 +575,29 @@ crunch ksIdleThread[wp]: tcbSchedAppend "\<lambda>s. P (ksIdleThread s)"
 crunch ksDomSchedule[wp]: tcbSchedAppend "\<lambda>s. P (ksDomSchedule s)"
 (simp: unless_def)
 
+lemma tcbQueueAppend_tcbPriority_obj_at'[wp]:
+  "tcbQueueAppend queue tptr \<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
+  supply projectKOs[simp]
+  unfolding tcbQueueAppend_def
+  apply (wpsimp wp: threadSet_wp)
+  by (auto simp: obj_at'_def objBits_simps ps_clear_def split: if_splits)
+
+lemma tcbQueueAppend_tcbDomain_obj_at'[wp]:
+  "tcbQueueAppend queue tptr \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  supply projectKOs[simp]
+  unfolding tcbQueueAppend_def
+  apply (wpsimp wp: threadSet_wp)
+  by (auto simp: obj_at'_def objBits_simps ps_clear_def split: if_splits)
+
 lemma tcbSchedAppend_tcbDomain[wp]:
-  "\<lbrace> obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t' \<rbrace>
-     tcbSchedAppend t
-   \<lbrace> \<lambda>_. obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t' \<rbrace>"
+  "tcbSchedAppend t \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
   apply (clarsimp simp: tcbSchedAppend_def)
-  apply (wpsimp simp: unless_def)+
-  done
+  by wpsimp
 
 lemma tcbSchedAppend_tcbPriority[wp]:
-  "\<lbrace> obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t' \<rbrace>
-     tcbSchedAppend t
-   \<lbrace> \<lambda>_. obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t' \<rbrace>"
+  "tcbSchedAppend t \<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
   apply (clarsimp simp: tcbSchedAppend_def)
-  apply (wpsimp simp: unless_def)+
-  done
+  by wpsimp
 
 lemma tcbSchedAppend_tcb_in_cur_domain'[wp]:
   "\<lbrace>tcb_in_cur_domain' t'\<rbrace> tcbSchedAppend t \<lbrace>\<lambda>_. tcb_in_cur_domain' t' \<rbrace>"
@@ -584,26 +611,60 @@ crunches tcbSchedAppend, tcbSchedDequeue
   (simp: unless_def)
 
 lemma tcbSchedAppend_sch_act_wf[wp]:
-  "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace> tcbSchedAppend thread
-  \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  apply (simp add:tcbSchedAppend_def bitmap_fun_defs)
-  apply (wp unless_wp setQueue_sch_act threadGet_wp|simp)+
-  apply (fastforce simp:typ_at'_def obj_at'_def)
+  "tcbSchedAppend thread \<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
+  by (wpsimp wp: sch_act_wf_lift)
+
+lemma tcbSchedAppend_valid_bitmapQ[wp]:
+  "\<lbrace>valid_bitmaps\<rbrace> tcbSchedAppend tcbPtr \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
+  supply if_split[split del]
+  unfolding tcbSchedAppend_def
+  apply (wpsimp simp: tcbQueueAppend_def
+                  wp: setQueue_valid_bitmapQ' addToBitmap_valid_bitmapQ_except addToBitmap_bitmapQ
+                      threadGet_wp hoare_vcg_if_lift2)
+  apply (clarsimp simp: ksReadyQueues_asrt_def split: if_splits)
+  apply normalise_obj_at'
+  apply (force dest: tcbQueueHead_iff_tcbQueueEnd
+               simp: valid_bitmaps_def valid_bitmapQ_def tcbQueueEmpty_def)
+  done
+
+lemma tcbSchedAppend_valid_mdb'[wp]:
+  "\<lbrace>valid_mdb' and valid_tcbs' and pspace_aligned' and pspace_distinct'\<rbrace>
+   tcbSchedAppend tcbPtr
+   \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  supply projectKOs[simp]
+  apply (clarsimp simp: tcbSchedAppend_def setQueue_def)
+  apply (wpsimp wp: tcbQueueAppend_valid_mdb' threadGet_wp simp: bitmap_fun_defs)
+  apply (fastforce dest: obj_at'_tcbQueueEnd_ksReadyQueues
+                   simp: ready_queue_relation_def ksReadyQueues_asrt_def obj_at'_def)
+  done
+
+lemma tcbSchedAppend_valid_bitmaps[wp]:
+  "tcbSchedAppend tcbPtr \<lbrace>valid_bitmaps\<rbrace>"
+  unfolding valid_bitmaps_def
+  apply wpsimp
+  apply (clarsimp simp: valid_bitmaps_def)
   done
 
 lemma tcbSchedAppend_invs'[wp]:
-  "\<lbrace>invs'
-    and st_tcb_at' runnable' t
-    and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t)\<rbrace>
-     tcbSchedAppend t
+  "\<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_state'_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:
@@ -632,7 +693,7 @@ crunch ksMachine[wp]: tcbSchedDequeue "\<lambda>s. P (ksMachineState s)"
 lemma tcbSchedDequeue_vms'[wp]:
   "\<lbrace>valid_machine_state'\<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>_. valid_machine_state'\<rbrace>"
   apply (simp add: valid_machine_state'_def pointerInUserData_def pointerInDeviceData_def)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift tcbSchedDequeue_ksMachine)
+  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
   done
 
 crunch pspace_domain_valid[wp]: tcbSchedDequeue "pspace_domain_valid"
@@ -650,43 +711,88 @@ lemma tcbSchedDequeue_tcb_in_cur_domain'[wp]:
   "\<lbrace>tcb_in_cur_domain' t'\<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>_. tcb_in_cur_domain' t' \<rbrace>"
   apply (rule tcb_in_cur_domain'_lift)
    apply wp
-  apply (clarsimp simp: tcbSchedDequeue_def)
-  apply (wp hoare_when_weak_wp | simp)+
+  apply (clarsimp simp: tcbSchedDequeue_def tcbQueueRemove_def)
+  apply (wpsimp wp: hoare_when_weak_wp getObject_tcb_wp threadGet_wp)
   done
 
-lemma tcbSchedDequeue_tcbDomain[wp]:
-  "\<lbrace> obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t' \<rbrace>
-     tcbSchedDequeue t
-   \<lbrace> \<lambda>_. obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t' \<rbrace>"
-  apply (clarsimp simp: tcbSchedDequeue_def)
-  apply (wp hoare_when_weak_wp | simp)+
-  done
-
-lemma tcbSchedDequeue_tcbPriority[wp]:
-  "\<lbrace> obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t' \<rbrace>
-     tcbSchedDequeue t
-   \<lbrace> \<lambda>_. obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t' \<rbrace>"
-  apply (clarsimp simp: tcbSchedDequeue_def)
-  apply (wp hoare_when_weak_wp | simp)+
+lemma tcbSchedDequeue_valid_mdb'[wp]:
+  "\<lbrace>valid_mdb' and valid_objs'\<rbrace> tcbSchedDequeue tcbPtr \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  unfolding tcbSchedDequeue_def
+  apply (wpsimp simp: bitmap_fun_defs setQueue_def wp: threadSet_mdb' tcbQueueRemove_valid_mdb')
+      apply (rule_tac Q="\<lambda>_. tcb_at' tcbPtr" in hoare_post_imp)
+       apply (fastforce simp: tcb_cte_cases_def cteSizeBits_def)
+      apply (wpsimp wp: threadGet_wp)+
+  apply (fastforce simp: obj_at'_def)
   done
 
 lemma tcbSchedDequeue_invs'[wp]:
-  "\<lbrace>invs' and tcb_at' t\<rbrace>
-     tcbSchedDequeue t
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  unfolding invs'_def valid_state'_def
-  apply (rule hoare_pre)
-   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
-             tcbSchedDequeue_valid_queues
-             untyped_ranges_zero_lift
-        | simp add: cteCaps_of_def o_def)+
-  apply (fastforce elim: valid_objs'_maxDomain valid_objs'_maxPriority simp: valid_pspace'_def)+
+  "tcbSchedDequeue t \<lbrace>invs'\<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 ct_idle_or_in_cur_domain'_lift2 cur_tcb_lift
+              simp: cteCaps_of_def o_def)
+  done
+
+lemma ready_qs_runnable_cross:
+  "\<lbrakk>(s, s') \<in> state_relation; pspace_aligned s; pspace_distinct s; valid_queues s\<rbrakk>
+   \<Longrightarrow> ready_qs_runnable s'"
+  supply projectKOs[simp]
+  apply (clarsimp simp: ready_qs_runnable_def)
+  apply normalise_obj_at'
+  apply (frule state_relation_ready_queues_relation)
+  apply (clarsimp simp: ready_queues_relation_def ready_queue_relation_def Let_def
+                        list_queue_relation_def)
+  apply (drule_tac x="tcbDomain ko" in spec)
+  apply (drule_tac x="tcbPriority ko" in spec)
+  apply (clarsimp simp: valid_queues_def)
+  apply (drule_tac x="tcbDomain ko" in spec)
+  apply (drule_tac x="tcbPriority ko" in spec)
+  apply clarsimp
+  apply (drule_tac x=t in bspec)
+   apply (fastforce simp: inQ_def in_opt_pred obj_at'_def opt_map_red)
+  apply (fastforce dest: st_tcb_at_runnable_cross simp: obj_at'_def st_tcb_at'_def)
+  done
+
+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_queues)?, (frule invs_psp_aligned)?, (frule invs_distinct)?,
+  fastforce dest: ready_qs_runnable_cross
+
+defs idleThreadNotQueued_def:
+  "idleThreadNotQueued s \<equiv> obj_at' (Not \<circ> tcbQueued) (ksIdleThread s) s"
+
+lemma idle_thread_not_queued:
+  "\<lbrakk>valid_idle s; valid_queues s; valid_etcbs s\<rbrakk>
+   \<Longrightarrow> \<not> (\<exists>d p. idle_thread s \<in> set (ready_queues s d p))"
+  apply (clarsimp simp: valid_queues_def)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply clarsimp
+  apply (drule_tac x="idle_thread s" in bspec)
+   apply fastforce
+  apply (clarsimp simp: valid_idle_def pred_tcb_at_def obj_at_def valid_etcbs_def)
   done
 
+lemma valid_idle_tcb_at:
+  "valid_idle s \<Longrightarrow> tcb_at (idle_thread s) s"
+  by (clarsimp simp: valid_idle_def pred_tcb_at_def obj_at_def is_tcb_def)
+
 lemma setCurThread_corres:
-  "corres dc \<top> \<top> (modify (cur_thread_update (\<lambda>_. t))) (setCurThread t)"
-  apply (unfold setCurThread_def)
+  "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)"
+  supply projectKOs[simp]
+  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 opt_pred_def opt_map_def)
   apply (rule corres_modify)
   apply (simp add: state_relation_def swp_def)
   done
@@ -709,48 +815,64 @@ proof -
     by (rule lift_neg_pred_tcb_at' [OF ArchThreadDecls_H_ARM_HYP_H_switchToThread_typ_at' pos])
 qed
 
-crunches Arch.switchToThread
-  for valid_queues[wp]: Invariants_H.valid_queues
-  (wp: crunch_wps simp: crunch_simps ignore: clearExMonitor)
+crunches storeWordUser, setVMRoot, asUser, storeWordUser, Arch.switchToThread
+  for ksQ[wp]: "\<lambda>s. P (ksReadyQueues s p)"
+  and ksIdleThread[wp]: "\<lambda>s. P (ksIdleThread s)"
+  and sym_heap_sched_pointers[wp]: sym_heap_sched_pointers
+  and valid_objs'[wp]: valid_objs'
+  (wp: crunch_wps threadSet_sched_pointers getObject_tcb_wp getASID_wp
+   simp: crunch_simps obj_at'_def)
+
+crunches arch_switch_to_thread, arch_switch_to_idle_thread
+  for pspace_aligned[wp]: pspace_aligned
+  and pspace_distinct[wp]: pspace_distinct
+  and ready_qs_distinct[wp]: ready_qs_distinct
+  and valid_idle_new[wp]: valid_idle
+  (wp: ready_qs_distinct_lift simp: crunch_simps)
+
+lemma valid_queues_in_correct_ready_q[elim!]:
+  "valid_queues s \<Longrightarrow> in_correct_ready_q s"
+  by (clarsimp simp: valid_queues_def in_correct_ready_q_def)
+
+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)
 
 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_vs_lookup and valid_global_objs
                 and unique_table_refs o caps_of_state
-                and st_tcb_at runnable t and valid_etcbs and (\<lambda>s. sym_refs (state_hyp_refs_of s)))
-             (valid_arch_state' and valid_pspace' and Invariants_H.valid_queues
-                and st_tcb_at' runnable' t and cur_tcb' and (\<lambda>s. sym_refs (state_hyp_refs_of' s)))
+                and st_tcb_at runnable t and valid_etcbs and (\<lambda>s. sym_refs (state_hyp_refs_of s))
+                and valid_queues and valid_idle)
+             (valid_arch_state' and no_0_obj' and sym_heap_sched_pointers and valid_objs'
+              and (\<lambda>s. sym_refs (state_hyp_refs_of' s)))
              (switch_to_thread t) (switchToThread t)"
-  (is "corres _ ?PA ?PH _ _")
-
-proof -
-  have mainpart: "corres dc (?PA) (?PH)
-     (do y \<leftarrow> arch_switch_to_thread t;
-         y \<leftarrow> (tcb_sched_action tcb_sched_dequeue t);
-         modify (cur_thread_update (\<lambda>_. t))
-      od)
-     (do y \<leftarrow> Arch.switchToThread t;
-         y \<leftarrow> tcbSchedDequeue t;
-         setCurThread 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)
+  apply add_ready_qs_runnable
+  apply (simp add: switch_to_thread_def Thread_H.switchToThread_def)
+  apply (rule corres_symb_exec_l[OF _ _ get_sp]; (solves wpsimp)?)
+  apply (rule corres_symb_exec_l[OF _ _ assert_sp]; (solves wpsimp)?)
+    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_stateAssert_ignore)
+     apply (fastforce dest!: state_relation_ready_queues_relation intro: ksReadyQueues_asrt_cross)
+    apply (rule corres_stateAssert_add_assertion[rotated])
+     apply fastforce
     apply (rule corres_guard_imp)
       apply (rule corres_split[OF arch_switchToThread_corres])
         apply (rule corres_split[OF tcbSchedDequeue_corres setCurThread_corres])
-         apply (wpsimp simp: tcb_at_is_etcb_at st_tcb_at_tcb_at)+
-    done
-
-  show ?thesis
-    apply -
-    apply (simp add: switch_to_thread_def Thread_H.switchToThread_def)
-    apply (rule corres_symb_exec_l [where Q = "\<lambda> s rv. (?PA and (=) rv) s",
-                                    OF corres_symb_exec_l [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 tcb_at_idle_thread_lift:
   assumes T: "\<And>T' t. \<lbrace>typ_at T' t\<rbrace> f \<lbrace>\<lambda>rv. typ_at T' t\<rbrace>"
@@ -803,16 +925,24 @@ lemma arch_switchToIdleThread_corres:
   done
 
 lemma switchToIdleThread_corres:
-  "corres dc invs invs_no_cicd' switch_to_idle_thread switchToIdleThread"
+  "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 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_trivial, rule corres_modify)
-        apply (simp add: state_relation_def cdt_relation_def)
-       apply (wp+, simp+)
-  apply (simp add: all_invs_but_ct_idle_or_in_cur_domain'_def valid_state'_def valid_pspace'_def)
+        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_psp_aligned invs_distinct
+                    invs_valid_idle)
+  apply (simp add: all_invs_but_ct_idle_or_in_cur_domain'_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>"
@@ -843,11 +973,9 @@ proof -
     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 Invariants_H.valid_queues_def
-                              sch_act_wf ct_in_state'_def state_refs_of'_def
-                              ps_clear_def valid_irq_node'_def valid_queues'_def ct_not_inQ_ct
-                              ct_idle_or_in_cur_domain'_def
-                              bitmapQ_defs valid_queues_no_bitmap_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
@@ -861,101 +989,20 @@ lemma setCurThread_invs:
   by (rule hoare_pre, rule setCurThread_invs_no_cicd')
      (simp add: invs'_to_invs_no_cicd'_def)
 
-lemma valid_queues_not_runnable_not_queued:
-  fixes s
-  assumes vq:  "Invariants_H.valid_queues 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
-
-  with vq have "st_tcb_at' runnable' t s"
-    unfolding Invariants_H.valid_queues_def valid_queues_no_bitmap_def
-    apply -
-    apply clarsimp
-    apply (drule_tac x=d in spec)
-    apply (drule_tac x=p in spec)
-    apply (clarsimp simp add: st_tcb_at'_def)
-    apply (drule(1) bspec)
-    apply (erule obj_at'_weakenE)
-    apply (clarsimp)
-    done
-
-  with st show False
-    apply -
-    apply (drule(1) pred_tcb_at_conj')
-    apply (clarsimp)
-    done
-qed
-
-(*
- * The idle thread is not part of any ready queues.
- *)
-lemma idle'_not_tcbQueued':
- assumes vq:   "Invariants_H.valid_queues 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 vq' show ?thesis
-     by (rule valid_queues_not_runnable_not_queued)
- qed
-
 lemma setCurThread_invs_no_cicd'_idle_thread:
-  "\<lbrace>invs_no_cicd' and (\<lambda>s. t = ksIdleThread s) \<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
-  have idle'_activatable': "\<And> s t. st_tcb_at' idle' t s \<Longrightarrow> st_tcb_at' activatable' t s"
-    apply (clarsimp simp: st_tcb_at'_def o_def obj_at'_def)
+  "\<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 ct_not_inQ_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 st_tcb_at'_def
+                        idleThreadNotQueued_def)
   done
-  show ?thesis
-    apply (simp add: setCurThread_def)
-    apply wp
-    apply (clarsimp simp: all_invs_but_ct_idle_or_in_cur_domain'_def)
-    apply (frule (2) idle'_not_tcbQueued'[simplified o_def])
-    apply (clarsimp simp add: ct_not_inQ_ct idle'_activatable'
-                              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_queues_no_bitmap_def valid_queues'_def
-                              pred_tcb_at'_def
-                        cong: option.case_cong)
-    apply (clarsimp simp: obj_at'_def projectKOs idle_tcb'_def)
-    done
-qed
 
 lemma setCurThread_invs_idle_thread:
   "\<lbrace>invs' and (\<lambda>s. t = ksIdleThread s) \<rbrace> setCurThread t \<lbrace>\<lambda>rv. invs'\<rbrace>"
@@ -996,13 +1043,13 @@ lemma Arch_switchToThread_tcb_in_cur_domain'[wp]:
   done
 
 lemma tcbSchedDequeue_not_tcbQueued:
-  "\<lbrace> tcb_at' t \<rbrace> tcbSchedDequeue t \<lbrace> \<lambda>_. obj_at' (\<lambda>x. \<not> tcbQueued x) t \<rbrace>"
+  "\<lbrace>\<top>\<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>_. obj_at' (\<lambda>x. \<not> tcbQueued x) t\<rbrace>"
   apply (simp add: tcbSchedDequeue_def)
   apply (wp|clarsimp)+
   apply (rule_tac Q="\<lambda>queued. obj_at' (\<lambda>x. tcbQueued x = queued) t" in hoare_post_imp)
-   apply (clarsimp simp: obj_at'_def)
-  apply (wp threadGet_obj_at')
-  apply (simp)
+     apply (clarsimp simp: obj_at'_def)
+    apply (wpsimp wp: threadGet_wp)+
+  apply (clarsimp simp: obj_at'_def)
   done
 
 lemma asUser_obj_at[wp]:  "\<lbrace>obj_at' (P \<circ> tcbState) t\<rbrace>
@@ -1043,10 +1090,6 @@ crunch valid_irq_states'[wp]: asUser "valid_irq_states'"
 crunch valid_machine_state'[wp]: asUser "valid_machine_state'"
 (wp: crunch_wps simp: crunch_simps)
 
-crunch valid_queues'[wp]: asUser "valid_queues'"
-(wp: crunch_wps simp: crunch_simps)
-
-
 lemma asUser_valid_irq_node'[wp]:
   "\<lbrace>\<lambda>s. valid_irq_node' (irq_node' s) s\<rbrace> asUser t (setRegister f r)
           \<lbrace>\<lambda>_ s. valid_irq_node' (irq_node' s) s\<rbrace>"
@@ -1123,22 +1166,17 @@ lemma Arch_switchToThread_invs_no_cicd':
 
 
 lemma tcbSchedDequeue_invs_no_cicd'[wp]:
-  "\<lbrace>invs_no_cicd' and tcb_at' t\<rbrace>
-     tcbSchedDequeue t
-   \<lbrace>\<lambda>_. invs_no_cicd'\<rbrace>"
-  unfolding all_invs_but_ct_idle_or_in_cur_domain'_def valid_state'_def
+  "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
-            tcbSchedDequeue_valid_queues_weak
             untyped_ranges_zero_lift
         | simp add: cteCaps_of_def o_def)+
   apply clarsimp
-  apply (fastforce simp: valid_pspace'_def valid_queues_def
-                   elim: valid_objs'_maxDomain valid_objs'_maxPriority intro: obj_at'_conjI)
   done
 
 lemma switchToThread_invs_no_cicd':
-  "\<lbrace>invs_no_cicd' and st_tcb_at' runnable' t and tcb_in_cur_domain' t \<rbrace> ThreadDecls_H.switchToThread t \<lbrace>\<lambda>rv. invs' \<rbrace>"
+  "\<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')
@@ -1146,7 +1184,7 @@ lemma switchToThread_invs_no_cicd':
   done
 
 lemma switchToThread_invs[wp]:
-  "\<lbrace>invs' and st_tcb_at' runnable' t and tcb_in_cur_domain' t \<rbrace> switchToThread t \<lbrace>\<lambda>rv. invs' \<rbrace>"
+  "\<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 threadSet_timeslice_invs setCurThread_invs
              Arch_switchToThread_invs dmo_invs'
@@ -1239,61 +1277,6 @@ lemma tcb_at_typ_at':
   done
 
 
-lemma invs'_not_runnable_not_queued:
-  fixes s
-  assumes inv: "invs' s"
-      and st: "st_tcb_at' (Not \<circ> runnable') t s"
-  shows "obj_at' (Not \<circ> tcbQueued) t s"
-  apply (insert assms)
-  apply (rule valid_queues_not_runnable_not_queued)
-    apply (clarsimp simp add: invs'_def valid_state'_def)+
-  done
-
-lemma valid_queues_not_tcbQueued_not_ksQ:
-  fixes s
-  assumes   vq: "Invariants_H.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"
-    unfolding Invariants_H.valid_queues_def valid_queues_no_bitmap_def
-    apply clarify
-    apply (drule_tac x=d in spec)
-    apply (drule_tac x=p in spec)
-    apply (clarsimp)
-    apply (drule(1) bspec)
-    apply (erule obj_at'_weakenE)
-    apply (simp)
-    done
-  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 valid_state'_def)
-  apply (drule(1) valid_queues_not_tcbQueued_not_ksQ)
-  apply (clarsimp)
-  done
-
-lemma ct_not_ksQ:
-  "\<lbrakk> invs' s; ksSchedulerAction s = ResumeCurrentThread \<rbrakk>
-   \<Longrightarrow> \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)"
-  apply (clarsimp simp: invs'_def valid_state'_def ct_not_inQ_def)
-  apply (frule(1) valid_queues_not_tcbQueued_not_ksQ)
-  apply (fastforce)
-  done
-
 lemma setThreadState_rct:
   "\<lbrace>\<lambda>s. (runnable' st \<or> ksCurThread s \<noteq> t)
         \<and> ksSchedulerAction s = ResumeCurrentThread\<rbrace>
@@ -1366,21 +1349,24 @@ lemma bitmapQ_from_bitmap_lookup:
   done
 
 lemma lookupBitmapPriority_obj_at':
-  "\<lbrakk>ksReadyQueuesL1Bitmap s (ksCurDomain s) \<noteq> 0; valid_queues_no_bitmap s; valid_bitmapQ s;
-         bitmapQ_no_L1_orphans s\<rbrakk>
-        \<Longrightarrow> obj_at' (inQ (ksCurDomain s) (lookupBitmapPriority (ksCurDomain s) s) and runnable' \<circ> tcbState)
-             (hd (ksReadyQueues s (ksCurDomain s, lookupBitmapPriority (ksCurDomain s) s))) s"
+  "\<lbrakk>ksReadyQueuesL1Bitmap s d \<noteq> 0; valid_bitmapQ s; bitmapQ_no_L1_orphans s;
+    ksReadyQueues_asrt s; ready_qs_runnable s; pspace_aligned' s; pspace_distinct' s\<rbrakk>
+   \<Longrightarrow> obj_at' (inQ d (lookupBitmapPriority d s) and runnable' \<circ> tcbState)
+               (the (tcbQueueHead (ksReadyQueues s (d, lookupBitmapPriority d s)))) s"
   apply (drule (2) bitmapQ_from_bitmap_lookup)
   apply (simp add: valid_bitmapQ_bitmapQ_simp)
-  apply (case_tac "ksReadyQueues s (ksCurDomain s, lookupBitmapPriority (ksCurDomain s) s)", simp)
-  apply (clarsimp, rename_tac t ts)
-  apply (drule cons_set_intro)
-  apply (drule (2) valid_queues_no_bitmap_objD)
+  apply (clarsimp simp: ready_queue_relation_def ksReadyQueues_asrt_def tcbQueueEmpty_def)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x="lookupBitmapPriority d s" in spec)
+  apply clarsimp
+  apply (frule (3) obj_at'_tcbQueueHead_ksReadyQueues)
+  apply (fastforce simp: obj_at'_and ready_qs_runnable_def obj_at'_def st_tcb_at'_def inQ_def
+                         tcbQueueEmpty_def)
   done
 
 lemma bitmapL1_zero_ksReadyQueues:
   "\<lbrakk> valid_bitmapQ s ; bitmapQ_no_L1_orphans s \<rbrakk>
-   \<Longrightarrow> (ksReadyQueuesL1Bitmap s d = 0) = (\<forall>p. ksReadyQueues s (d,p) = [])"
+   \<Longrightarrow> (ksReadyQueuesL1Bitmap s d = 0) = (\<forall>p. tcbQueueEmpty (ksReadyQueues s (d, p)))"
   apply (cases "ksReadyQueuesL1Bitmap s d = 0")
    apply (force simp add: bitmapQ_def valid_bitmapQ_def)
   apply (fastforce dest: bitmapQ_from_bitmap_lookup simp: valid_bitmapQ_bitmapQ_simp)
@@ -1451,7 +1437,7 @@ lemma bitmapL1_highest_lookup:
   done
 
 lemma bitmapQ_ksReadyQueuesI:
-  "\<lbrakk> bitmapQ d p s ; valid_bitmapQ s \<rbrakk> \<Longrightarrow> ksReadyQueues s (d, p) \<noteq> []"
+  "\<lbrakk> bitmapQ d p s ; valid_bitmapQ s \<rbrakk> \<Longrightarrow> \<not> tcbQueueEmpty (ksReadyQueues s (d, p))"
   unfolding valid_bitmapQ_def by simp
 
 lemma getReadyQueuesL2Bitmap_inv[wp]:
@@ -1460,24 +1446,22 @@ lemma getReadyQueuesL2Bitmap_inv[wp]:
 
 lemma switchToThread_lookupBitmapPriority_wp:
   "\<lbrace>\<lambda>s. invs_no_cicd' s \<and> bitmapQ (ksCurDomain s) (lookupBitmapPriority (ksCurDomain s) s) s \<and>
-        t = hd (ksReadyQueues s (ksCurDomain s, lookupBitmapPriority (ksCurDomain s) s)) \<rbrace>
+        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 ; 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 elim: obj_at'_weaken simp: inQ_def tcb_in_cur_domain'_def st_tcb_at'_def)
-    done
-  thus ?thesis
-    by (wp switchToThread_invs_no_cicd') (fastforce dest: invs_no_cicd'_queues)
-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_no_cicd':
   "\<lbrace>invs_no_cicd'\<rbrace> switchToIdleThread \<lbrace>\<lambda>rv. invs'\<rbrace>"
@@ -1578,9 +1562,9 @@ lemma guarded_switch_to_corres:
                 and valid_vspace_objs and pspace_aligned and pspace_distinct
                 and valid_vs_lookup
                 and unique_table_refs o caps_of_state
-                and st_tcb_at runnable t and valid_etcbs and (\<lambda>s. sym_refs (state_hyp_refs_of s)))
-             (valid_arch_state' and valid_pspace' and Invariants_H.valid_queues
-                and st_tcb_at' runnable' t and cur_tcb' and (\<lambda>s. sym_refs (state_hyp_refs_of' s)))
+                and st_tcb_at runnable t and valid_etcbs and valid_queues and valid_idle and (\<lambda>s. sym_refs (state_hyp_refs_of s)))
+             (valid_arch_state' and valid_pspace' and sym_heap_sched_pointers
+              and (\<lambda>s. sym_refs (state_hyp_refs_of' s)))
              (guarded_switch_to t) (switchToThread t)"
   apply (simp add: guarded_switch_to_def)
   apply (rule corres_guard_imp)
@@ -1625,7 +1609,7 @@ lemma curDomain_corres: "corres (=) \<top> \<top> (gets cur_domain) (curDomain)"
 
 lemma curDomain_corres':
   "corres (=) \<top> (\<lambda>s. ksCurDomain s \<le> maxDomain)
-    (gets cur_domain) (if 1 < numDomains then curDomain else return 0)"
+    (gets cur_domain) (if Suc 0 < numDomains then curDomain else return 0)"
   apply (case_tac "1 < numDomains"; simp)
    apply (rule corres_guard_imp[OF curDomain_corres]; solves simp)
   (* if we have only one domain, then we are in it *)
@@ -1635,27 +1619,32 @@ lemma curDomain_corres':
 
 lemma lookupBitmapPriority_Max_eqI:
   "\<lbrakk> valid_bitmapQ s ; bitmapQ_no_L1_orphans s ; ksReadyQueuesL1Bitmap s d \<noteq> 0 \<rbrakk>
-   \<Longrightarrow> lookupBitmapPriority d s = (Max {prio. ksReadyQueues s (d, prio) \<noteq> []})"
+   \<Longrightarrow> lookupBitmapPriority d s = (Max {prio. \<not> tcbQueueEmpty (ksReadyQueues s (d, prio))})"
   apply (rule Max_eqI[simplified eq_commute]; simp)
    apply (fastforce simp: bitmapL1_highest_lookup valid_bitmapQ_bitmapQ_simp)
   apply (metis valid_bitmapQ_bitmapQ_simp bitmapQ_from_bitmap_lookup)
   done
 
 lemma corres_gets_queues_getReadyQueuesL1Bitmap:
-  "corres (\<lambda>qs l1. ((l1 = 0) = (\<forall>p. qs p = []))) \<top> valid_queues
+  "corres (\<lambda>qs l1. (l1 = 0) = (\<forall>p. qs p = [])) \<top> valid_bitmaps
     (gets (\<lambda>s. ready_queues s d)) (getReadyQueuesL1Bitmap d)"
-  unfolding state_relation_def valid_queues_def getReadyQueuesL1Bitmap_def
-  by (clarsimp simp: bitmapL1_zero_ksReadyQueues ready_queues_relation_def)
+  unfolding state_relation_def valid_bitmaps_def getReadyQueuesL1Bitmap_def
+  apply (clarsimp simp: ready_queues_relation_def ready_queue_relation_def Let_def)
+  apply (drule_tac x=d in spec)
+  apply (fastforce simp: bitmapL1_zero_ksReadyQueues list_queue_relation_def tcbQueueEmpty_def)
+  done
 
 lemma guarded_switch_to_chooseThread_fragment_corres:
   "corres dc
     (P and st_tcb_at runnable t and invs and valid_sched)
-    (P' and st_tcb_at' runnable' t and invs_no_cicd')
-          (guarded_switch_to t)
-          (do runnable \<leftarrow> isRunnable t;
-              y \<leftarrow> assert runnable;
-              ThreadDecls_H.switchToThread t
-           od)"
+    (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)
@@ -1670,35 +1659,50 @@ lemma guarded_switch_to_chooseThread_fragment_corres:
               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'
+   \<Longrightarrow> Max {prio. ready_queues s d prio \<noteq> []}
+       = Max {prio. \<not> tcbQueueEmpty (ksReadyQueues s' (d, prio))}"
+  apply (clarsimp simp: ready_queues_relation_def ready_queue_relation_def Let_def
+                        list_queue_relation_def tcbQueueEmpty_def)
+  apply (rule Max_eq_if)
+     apply fastforce
+    apply fastforce
+   apply (fastforce dest: heap_path_head)
+  apply clarsimp
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=b in spec)
+  apply force
+  done
+
 lemma bitmap_lookup_queue_is_max_non_empty:
-  "\<lbrakk> valid_queues s'; (s, s') \<in> state_relation; invs s;
+  "\<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 all_invs_but_ct_idle_or_in_cur_domain'_def 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 \<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 (simp add: valid_queues_no_bitmap_def)
-   apply (erule_tac x="ksCurDomain s" in allE)
-   apply (erule_tac x="lookupBitmapPriority (ksCurDomain s) s" in allE)
-   apply (clarsimp simp: st_tcb_at'_def)
-   apply (erule obj_at'_weaken)
-   apply simp
-   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>"
@@ -1710,52 +1714,72 @@ lemma invs_no_cicd_ksCurDomain_maxDomain':
   "invs_no_cicd' s \<Longrightarrow> ksCurDomain s \<le> maxDomain"
   unfolding invs_no_cicd'_def by simp
 
+crunches curDomain
+  for valid_bitmaps[wp]: valid_bitmaps
+
 lemma chooseThread_corres:
-  "corres dc (invs and valid_sched) (invs_no_cicd')
-     choose_thread chooseThread" (is "corres _ ?PREI ?PREH _ _")
+  "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
-  unfolding choose_thread_def chooseThread_def
-  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> 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 dest!: invs_no_cicd'_queues simp: bitmap_lookup_queue_is_max_non_empty)
-              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 (clarsimp simp: if_apply_def2)
-      apply (wp hoare_vcg_conj_lift hoare_vcg_imp_lift ksReadyQueuesL1Bitmap_return_wp)
-     apply (wpsimp wp: curDomain_or_return_0 simp: curDomain_def)+
-    apply (fastforce simp: invs_no_cicd'_def)
-   apply (clarsimp simp: valid_sched_def DetSchedInvs_AI.valid_queues_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 (simp add: invs_no_cicd_ksCurDomain_maxDomain')
-  apply (clarsimp dest!: invs_no_cicd'_queues)
-  apply (fastforce intro: ksReadyQueuesL1Bitmap_st_tcb_at')
-  done
+    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 (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 =
@@ -1844,7 +1868,7 @@ lemma isHighestPrio_corres:
   assumes "d' = d"
   assumes "p' = p"
   shows
-    "corres ((=)) \<top> valid_queues
+    "corres ((=)) \<top> valid_bitmaps
       (gets (is_highest_prio d p))
       (isHighestPrio d' p')"
   using assms
@@ -1854,18 +1878,16 @@ lemma isHighestPrio_corres:
     apply (rule corres_split[OF corres_gets_queues_getReadyQueuesL1Bitmap])
       apply (rule corres_if_r'[where P'="\<lambda>_. True",rotated])
        apply (rule_tac corres_symb_exec_r)
-              apply (rule_tac
-                       P="\<lambda>s. q = ready_queues s d
-                              " and
-                       P'="\<lambda>s. valid_queues s \<and>
-                               l1 = ksReadyQueuesL1Bitmap s d \<and>
-                               l1 \<noteq> 0 \<and> hprio = lookupBitmapPriority d s" and
-                       F="hprio = Max {prio. q prio \<noteq> []}" in corres_req)
-              apply (elim conjE)
-              apply (clarsimp simp: valid_queues_def)
-              apply (subst lookupBitmapPriority_Max_eqI; blast?)
-              apply (fastforce simp: ready_queues_relation_def dest!: state_relationD)
-             apply fastforce
+          apply (rule_tac P="\<lambda>s. q = ready_queues s d"
+                      and P'="\<lambda>s. valid_bitmaps s \<and> l1 = ksReadyQueuesL1Bitmap s d \<and>
+                                  l1 \<noteq> 0 \<and> hprio = lookupBitmapPriority d s"
+                      and F="hprio = Max {prio. q prio \<noteq> []}" in corres_req)
+           apply (elim conjE)
+           apply (clarsimp simp: valid_bitmaps_def)
+           apply (subst lookupBitmapPriority_Max_eqI; blast?)
+           apply (fastforce dest: state_relation_ready_queues_relation Max_prio_helper[where d=d]
+                            simp: tcbQueueEmpty_def)
+          apply fastforce
          apply (wpsimp simp: if_apply_def2 wp: hoare_drop_imps ksReadyQueuesL1Bitmap_return_wp)+
   done
 
@@ -1877,9 +1899,8 @@ crunch inv[wp]: schedule_switch_thread_fastfail P
 crunch inv[wp]: scheduleSwitchThreadFastfail P
 
 lemma setSchedulerAction_invs': (* not in wp set, clobbered by ssa_wp *)
-  "\<lbrace>\<lambda>s. invs' s \<rbrace> setSchedulerAction ChooseNewThread \<lbrace>\<lambda>_. invs' \<rbrace>"
+  "setSchedulerAction ChooseNewThread \<lbrace>invs' \<rbrace>"
   by (wpsimp simp: invs'_def cur_tcb'_def valid_state'_def valid_irq_node'_def ct_not_inQ_def
-                   valid_queues_def valid_queues_no_bitmap_def valid_queues'_def
                    ct_idle_or_in_cur_domain'_def)
 
 lemma scheduleChooseNewThread_corres:
@@ -1915,6 +1936,46 @@ lemma tcb_sched_action_sym_refs_state_hyp_refs_of[wp]:
   "tcb_sched_action a b \<lbrace>\<lambda>s. sym_refs (state_hyp_refs_of s)\<rbrace>"
   by (wpsimp simp: tcb_sched_action_def)
 
+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
+
+crunches 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)
+
+crunches 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]
@@ -1942,7 +2003,7 @@ lemma schedule_corres:
          apply (rule corres_split[OF thread_get_isRunnable_corres])
            apply (rule corres_split[OF corres_when])
                apply simp
-              apply (rule tcbSchedEnqueue_corres)
+              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)+
@@ -1951,7 +2012,7 @@ lemma schedule_corres:
                 rename_tac was_running wasRunning)
           apply (rule corres_split[OF corres_when])
               apply simp
-             apply (rule tcbSchedEnqueue_corres)
+             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[OF ethreadget_corres[where r="(=)"]])
@@ -1965,7 +2026,7 @@ lemma schedule_corres:
                     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])
+                         apply (rule corres_split[OF tcbSchedEnqueue_corres], simp)
                            apply (simp, fold dc_def)
                            apply (rule corres_split[OF setSchedulerAction_corres])
                               apply simp
@@ -1981,7 +2042,7 @@ lemma schedule_corres:
 
                         apply (rule corres_if, fastforce)
 
-                         apply (rule corres_split[OF tcbSchedAppend_corres])
+                         apply (rule corres_split[OF tcbSchedAppend_corres], simp)
                            apply (simp, fold dc_def)
                            apply (rule corres_split[OF setSchedulerAction_corres])
                               apply simp
@@ -2013,7 +2074,8 @@ lemma schedule_corres:
                     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)+
+                     del: gets_wp
+                  | strengthen valid_objs'_valid_tcbs' invs_valid_pspace')+
        apply (clarsimp simp: conj_ac if_apply_def2 cong: imp_cong conj_cong del: hoare_gets)
        apply (wp gets_wp)+
 
@@ -2036,14 +2098,13 @@ lemma schedule_corres:
                               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 invs_hyp_sym_refs)
-        apply (clarsimp simp add: pred_tcb_at_def obj_at_def is_tcb valid_idle_def)
+        apply (fastforce simp: 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)+
-     apply (simp add: valid_sched_def valid_blocked_def valid_blocked_except_def)
      done
 
   (* haskell final subgoal *)
@@ -2061,11 +2122,8 @@ proof -
     apply (simp add: setSchedulerAction_def)
     apply wp
     apply (clarsimp simp add: invs'_def valid_state'_def cur_tcb'_def
-                              Invariants_H.valid_queues_def
-                              state_refs_of'_def ps_clear_def
-                              valid_irq_node'_def valid_queues'_def
-                              tcb_in_cur_domain'_def ct_idle_or_in_cur_domain'_def
-                              bitmapQ_defs valid_queues_no_bitmap_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
@@ -2100,12 +2158,13 @@ lemma getDomainTime_wp[wp]: "\<lbrace>\<lambda>s. P (ksDomainTime s) s \<rbrace>
   by wp
 
 lemma switchToThread_ct_not_queued_2:
-  "\<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>")
+  "\<lbrace>invs_no_cicd' and tcb_at' t\<rbrace>
+   switchToThread t
+   \<lbrace>\<lambda>_ s. obj_at' (Not \<circ> tcbQueued) (ksCurThread s) s\<rbrace>"
   apply (simp add: Thread_H.switchToThread_def)
   apply (wp)
     apply (simp add: ARM_HYP_H.switchToThread_def setCurThread_def)
-    apply (wp tcbSchedDequeue_not_tcbQueued | simp )+
+    apply (wp tcbSchedDequeue_not_tcbQueued hoare_drop_imp | simp)+
   done
 
 lemma setCurThread_obj_at':
@@ -2119,11 +2178,12 @@ proof -
 qed
 
 lemma switchToIdleThread_ct_not_queued_no_cicd':
-  "\<lbrace> invs_no_cicd' \<rbrace> switchToIdleThread \<lbrace>\<lambda>rv s. obj_at' (Not \<circ> tcbQueued) (ksCurThread s) s \<rbrace>"
+  "\<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 (rule idle'_not_tcbQueued')
-  apply (simp add: invs_no_cicd'_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]:
@@ -2140,7 +2200,7 @@ lemma switchToThread_tcb_in_cur_domain':
    ThreadDecls_H.switchToThread thread
    \<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)
+  apply (wpsimp wp: tcbSchedDequeue_not_tcbQueued hoare_drop_imps)
   done
 
 lemma chooseThread_invs_no_cicd'_posts: (* generic version *)
@@ -2162,11 +2222,14 @@ proof -
     by (simp add: all_invs_but_ct_idle_or_in_cur_domain'_def maxDomain_def)
 
   show ?thesis
-    unfolding chooseThread_def Let_def curDomain_def
+    apply (clarsimp simp: chooseThread_def Let_def curDomain_def)
+    apply (rule hoare_seq_ext[OF _ stateAssert_sp])+
     apply (simp only: return_bind, simp)
-    apply (rule hoare_seq_ext[where B="\<lambda>rv s. invs_no_cicd' s \<and> rv = ksCurDomain s"])
+    apply (rule hoare_seq_ext[where B="\<lambda>rv s. invs_no_cicd' s \<and> rv = ksCurDomain s
+                                              \<and> ksReadyQueues_asrt s \<and> ready_qs_runnable s"])
      apply (rule_tac B="\<lambda>rv s. invs_no_cicd' s \<and> curdom = ksCurDomain s \<and>
-                               rv = ksReadyQueuesL1Bitmap s curdom" in hoare_seq_ext)
+                               rv = ksReadyQueuesL1Bitmap s curdom \<and>
+                               ksReadyQueues_asrt s \<and> ready_qs_runnable s" in hoare_seq_ext)
       apply (rename_tac l1)
       apply (case_tac "l1 = 0")
        (* switch to idle thread *)
@@ -2180,12 +2243,10 @@ proof -
       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
-      apply (clarsimp dest!: invs_no_cicd'_queues
-                      simp: valid_queues_def lookupBitmapPriority_def[symmetric])
-      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 (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
@@ -2224,11 +2285,14 @@ proof -
 
   (* FIXME this is almost identical to the chooseThread_invs_no_cicd'_posts proof, can generalise? *)
   show ?thesis
-    unfolding chooseThread_def Let_def curDomain_def
+    apply (clarsimp simp: chooseThread_def Let_def curDomain_def)
+    apply (rule hoare_seq_ext[OF _ stateAssert_sp])+
     apply (simp only: return_bind, simp)
-    apply (rule hoare_seq_ext[where B="\<lambda>rv s. invs_no_cicd' s \<and> rv = ksCurDomain s"])
+    apply (rule hoare_seq_ext[where B="\<lambda>rv s. invs_no_cicd' s \<and> rv = ksCurDomain s
+                                              \<and> ksReadyQueues_asrt s \<and> ready_qs_runnable s"])
      apply (rule_tac B="\<lambda>rv s. invs_no_cicd' s \<and> curdom = ksCurDomain s \<and>
-                               rv = ksReadyQueuesL1Bitmap s curdom" in hoare_seq_ext)
+                               rv = ksReadyQueuesL1Bitmap s curdom \<and>
+                               ksReadyQueues_asrt s \<and> ready_qs_runnable s" in hoare_seq_ext)
       apply (rename_tac l1)
       apply (case_tac "l1 = 0")
        (* switch to idle thread *)
@@ -2236,7 +2300,10 @@ proof -
       (* we have a thread to switch to *)
       apply (clarsimp simp: bitmap_fun_defs)
       apply (wp assert_inv)
-      apply (clarsimp dest!: invs_no_cicd'_queues simp: valid_queues_def)
+      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
@@ -2385,12 +2452,20 @@ lemma sbn_sch_act_sane:
   done
 
 lemma possibleSwitchTo_corres:
-  "corres dc (valid_etcbs and weak_valid_sched_action and cur_tcb and st_tcb_at runnable t)
-    (Invariants_H.valid_queues and valid_queues' and
-    (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and cur_tcb' and tcb_at' t and st_tcb_at' runnable' t and valid_objs')
-      (possible_switch_to t)
-      (possibleSwitchTo t)"
+  "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 (rule corres_split[OF curDomain_corres], simp)
@@ -2399,21 +2474,21 @@ lemma possibleSwitchTo_corres:
          apply (clarsimp simp: etcb_relation_def)
         apply (rule corres_split[OF getSchedulerAction_corres])
           apply (rule corres_if, simp)
-           apply (rule tcbSchedEnqueue_corres)
+           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)
-            apply (wp rescheduleRequired_valid_queues'_weak)+
+             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 (fastforce simp: valid_sched_def invs_def valid_state_def cur_tcb_def
+   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 (simp add: tcb_at_is_etcb_at)
+  apply (fastforce simp: tcb_at_is_etcb_at)
   done
 
 end
diff --git a/proof/refine/ARM_HYP/StateRelation.thy b/proof/refine/ARM_HYP/StateRelation.thy
index 0587b987ed..458995c779 100644
--- a/proof/refine/ARM_HYP/StateRelation.thy
+++ b/proof/refine/ARM_HYP/StateRelation.thy
@@ -20,6 +20,10 @@ where
 
 lemmas cte_map_def' = cte_map_def[simplified cte_level_bits_def, simplified]
 
+lemma cte_map_def2:
+  "cte_map \<equiv> \<lambda>(oref, cref). oref + (of_bl cref << cte_level_bits)"
+  by (simp add: cte_map_def word_shift_by_n)
+
 definition
   lookup_failure_map :: "ExceptionTypes_A.lookup_failure \<Rightarrow> Fault_H.lookup_failure"
 where
@@ -212,13 +216,20 @@ where
   \<and> tcb_bound_notification tcb = tcbBoundNotification tcb'
   \<and> tcb_mcpriority tcb = tcbMCP tcb'"
 
+\<comment> \<open>
+  A pair of objects @{term "(obj, obj')"} should satisfy the following relation when, under further
+  mild assumptions, a @{term corres_underlying} lemma for @{term "set_object obj"}
+  and @{term "setObject obj'"} can be stated: see setObject_other_corres in KHeap_R.
+
+  TCBs do not satisfy this relation because the tcbSchedPrev and tcbSchedNext fields of a TCB are
+  used to model the ready queues, and so an update to such a field would correspond to an update
+  to a ready queue (see ready_queues_relation below).\<close>
 definition
   other_obj_relation :: "Structures_A.kernel_object \<Rightarrow> Structures_H.kernel_object \<Rightarrow> bool"
 where
   "other_obj_relation obj obj' \<equiv>
   (case (obj, obj') of
-        (TCB tcb, KOTCB tcb') \<Rightarrow> tcb_relation tcb tcb'
-      | (Endpoint ep, KOEndpoint ep') \<Rightarrow> ep_relation ep ep'
+        (Endpoint ep, KOEndpoint ep') \<Rightarrow> ep_relation ep ep'
       | (Notification ntfn, KONotification ntfn') \<Rightarrow> ntfn_relation ntfn ntfn'
       | (ArchObj (ARM_A.ASIDPool pool), KOArch (KOASIDPool pool'))
              \<Rightarrow> asid_pool_relation pool pool'
@@ -301,6 +312,12 @@ where
 | "aobj_relation_cuts (ARM_A.VCPU v) x =
      {(x, other_obj_relation)}"
 
+definition tcb_relation_cut :: "Structures_A.kernel_object \<Rightarrow> kernel_object \<Rightarrow> bool" where
+  "tcb_relation_cut obj obj' \<equiv>
+   case (obj, obj') of
+       (TCB t, KOTCB t') \<Rightarrow> tcb_relation t t'
+     | _ \<Rightarrow> False"
+
 primrec
   obj_relation_cuts :: "Structures_A.kernel_object \<Rightarrow> word32 \<Rightarrow> obj_relation_cuts"
 where
@@ -308,7 +325,7 @@ where
      (if well_formed_cnode_n sz cs
       then {(cte_map (x, y), cte_relation y) | y. y \<in> dom cs}
       else {(x, \<bottom>\<bottom>)})"
-| "obj_relation_cuts (TCB tcb) x = {(x, other_obj_relation)}"
+| "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 (ArchObj ao) x = aobj_relation_cuts ao x"
@@ -319,6 +336,7 @@ 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>)}
+             | TCB tcb \<Rightarrow> {(x, tcb_relation_cut)}
              | ArchObj (PageTable pt) \<Rightarrow> (\<lambda>y. (x + (ucast y << pte_bits), pte_relation y))
                                            ` (UNIV :: (9 word) set)
              | ArchObj (PageDirectory pd) \<Rightarrow> (\<lambda>y. (x + (ucast y << pde_bits), pde_relation y))
@@ -333,6 +351,7 @@ lemma obj_relation_cuts_def3:
   "obj_relation_cuts ko x =
   (case (a_type ko) of
      ACapTable n \<Rightarrow> {(cte_map (x, y), cte_relation y) | y. length y = n}
+   | ATCB \<Rightarrow> {(x, tcb_relation_cut)}
    | AArch APageTable \<Rightarrow> (\<lambda>y. (x + (ucast y << pte_bits), pte_relation y))
                             ` (UNIV :: (9 word) set)
    | AArch APageDirectory \<Rightarrow> (\<lambda>y. (x + (ucast y << pde_bits), pde_relation y))
@@ -351,6 +370,7 @@ definition
  "is_other_obj_relation_type tp \<equiv>
   case tp of
      ACapTable n \<Rightarrow> False
+   | ATCB \<Rightarrow> False
    | AArch APageTable \<Rightarrow> False
    | AArch APageDirectory \<Rightarrow> False
    | AArch (AUserData _)   \<Rightarrow> False
@@ -362,6 +382,10 @@ 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_TCB:
+  "\<not> is_other_obj_relation_type ATCB"
+  by (simp add: is_other_obj_relation_type_def)
+
 lemma is_other_obj_relation_type_UserData:
   "\<not> is_other_obj_relation_type (AArch (AUserData sz))"
   unfolding is_other_obj_relation_type_def by simp
@@ -409,11 +433,55 @@ where
   "sched_act_relation choose_new_thread a' = (a' = ChooseNewThread)" |
   "sched_act_relation (switch_thread x) a' = (a' = SwitchToThread x)"
 
-definition
-  ready_queues_relation :: "(Deterministic_A.domain \<Rightarrow> Structures_A.priority \<Rightarrow> Deterministic_A.ready_queue)
-                         \<Rightarrow> (domain \<times> priority \<Rightarrow> KernelStateData_H.ready_queue) \<Rightarrow> bool"
-where
-  "ready_queues_relation qs qs' \<equiv> \<forall>d p. (qs d p = qs' (d, p))"
+definition queue_end_valid :: "obj_ref list \<Rightarrow> tcb_queue \<Rightarrow> bool" where
+  "queue_end_valid ts q \<equiv>
+     (ts = [] \<longrightarrow> tcbQueueEnd q = None) \<and> (ts \<noteq> [] \<longrightarrow> tcbQueueEnd q = Some (last ts))"
+
+definition prev_queue_head :: "tcb_queue \<Rightarrow> (obj_ref \<rightharpoonup> 'a) \<Rightarrow> bool" where
+  "prev_queue_head q prevs \<equiv> \<forall>head. tcbQueueHead q = Some head \<longrightarrow> prevs head = None"
+
+lemma prev_queue_head_heap_upd:
+  "\<lbrakk>prev_queue_head q prevs; Some r \<noteq> tcbQueueHead q\<rbrakk> \<Longrightarrow> prev_queue_head q (prevs(r := x))"
+  by (clarsimp simp: prev_queue_head_def)
+
+definition list_queue_relation ::
+  "obj_ref list \<Rightarrow> tcb_queue \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> bool"
+  where
+  "list_queue_relation ts q nexts prevs \<equiv>
+     heap_ls nexts (tcbQueueHead q) ts \<and> queue_end_valid ts q \<and> prev_queue_head q prevs"
+
+lemma list_queue_relation_nil:
+  "list_queue_relation ts q nexts prevs \<Longrightarrow> ts = [] \<longleftrightarrow> tcbQueueEmpty q"
+  by (fastforce dest: heap_path_head simp: tcbQueueEmpty_def list_queue_relation_def)
+
+definition ready_queue_relation ::
+  "Deterministic_A.domain \<Rightarrow> Structures_A.priority
+   \<Rightarrow> Deterministic_A.ready_queue \<Rightarrow> ready_queue
+   \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref)
+   \<Rightarrow> (obj_ref \<Rightarrow> bool) \<Rightarrow> bool"
+  where
+  "ready_queue_relation d p q q' nexts prevs flag \<equiv>
+     list_queue_relation q q' nexts prevs
+     \<and> (\<forall>t. flag t \<longleftrightarrow> t \<in> set q)
+     \<and> (d > maxDomain \<or> p > maxPriority \<longrightarrow> tcbQueueEmpty q')"
+
+definition ready_queues_relation_2 ::
+  "(Deterministic_A.domain \<Rightarrow> Structures_A.priority \<Rightarrow> Deterministic_A.ready_queue)
+   \<Rightarrow> (domain \<times> priority \<Rightarrow> ready_queue)
+   \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref)
+   \<Rightarrow> (domain \<Rightarrow> priority \<Rightarrow> obj_ref \<Rightarrow> bool) \<Rightarrow> bool"
+  where
+  "ready_queues_relation_2 qs qs' nexts prevs inQs \<equiv>
+     \<forall>d p. let q = qs d p; q' = qs' (d, p); flag = inQs d p in
+           ready_queue_relation d p q q' nexts prevs flag"
+
+abbreviation ready_queues_relation :: "det_state \<Rightarrow> kernel_state \<Rightarrow> bool" where
+  "ready_queues_relation s s' \<equiv>
+     ready_queues_relation_2
+      (ready_queues s) (ksReadyQueues s') (tcbSchedNexts_of s') (tcbSchedPrevs_of s')
+      (\<lambda>d p. inQ d p |< tcbs_of' s')"
+
+lemmas ready_queues_relation_def = ready_queues_relation_2_def
 
 definition
   ghost_relation :: "Structures_A.kheap \<Rightarrow> (word32 \<rightharpoonup> vmpage_size) \<Rightarrow> (word32 \<rightharpoonup> nat) \<Rightarrow> bool"
@@ -488,6 +556,8 @@ lemma obj_relation_cutsE:
      \<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>tcb tcb'. \<lbrakk> y = x; ko = TCB tcb; ko' = KOTCB tcb'; tcb_relation tcb tcb' \<rbrakk>
+               \<Longrightarrow> R;
      \<And>pt (z :: 9 word) pte'. \<lbrakk> ko = ArchObj (PageTable pt); y = x + (ucast z << pte_bits);
                               ko' = KOArch (KOPTE pte'); pte_relation_aligned z (pt z) pte' \<rbrakk>
               \<Longrightarrow> R;
@@ -498,13 +568,10 @@ lemma obj_relation_cutsE:
               y = x + n * 2 ^ pageBits; n < 2 ^ (pageBitsForSize sz - pageBits) \<rbrakk> \<Longrightarrow> R;
             \<lbrakk> y = x; other_obj_relation ko ko'; is_other_obj_relation_type (a_type ko) \<rbrakk> \<Longrightarrow> R
     \<rbrakk> \<Longrightarrow> R"
-  apply (simp add: obj_relation_cuts_def2 is_other_obj_relation_type_def
-                   a_type_def
-            split: Structures_A.kernel_object.split_asm if_split_asm
-                   ARM_A.arch_kernel_obj.split_asm)
-    apply ((clarsimp split: if_splits,
-                force simp: cte_relation_def pte_relation_def pde_relation_def)+)[5]
-  done
+  by (force simp: obj_relation_cuts_def2 is_other_obj_relation_type_def a_type_def
+                  cte_relation_def pte_relation_def pde_relation_def tcb_relation_cut_def
+            split: Structures_A.kernel_object.splits kernel_object.splits if_splits
+                   ARM_A.arch_kernel_obj.splits)
 
 lemma eq_trans_helper:
   "\<lbrakk> x = y; P y = Q \<rbrakk> \<Longrightarrow> P x = Q"
@@ -580,7 +647,7 @@ where
          pspace_relation (kheap s) (ksPSpace s')
        \<and> ekheap_relation (ekheap s) (ksPSpace s')
        \<and> sched_act_relation (scheduler_action s) (ksSchedulerAction s')
-       \<and> ready_queues_relation (ready_queues s) (ksReadyQueues s')
+       \<and> ready_queues_relation s 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')
@@ -602,6 +669,10 @@ lemma curthread_relation:
   "(a, b) \<in> state_relation \<Longrightarrow> ksCurThread b = cur_thread a"
   by (simp add: state_relation_def)
 
+lemma curdomain_relation[elim!]:
+  "(s, s') \<in> state_relation \<Longrightarrow> cur_domain s = ksCurDomain s'"
+  by (clarsimp simp: state_relation_def)
+
 lemma state_relation_pspace_relation[elim!]:
   "(s,s') \<in> state_relation \<Longrightarrow> pspace_relation (kheap s) (ksPSpace s')"
   by (simp add: state_relation_def)
@@ -610,12 +681,24 @@ lemma state_relation_ekheap_relation[elim!]:
   "(s,s') \<in> state_relation \<Longrightarrow> ekheap_relation (ekheap s) (ksPSpace s')"
   by (simp add: state_relation_def)
 
+lemma state_relation_sched_act_relation[elim!]:
+  "(s,s') \<in> state_relation \<Longrightarrow> sched_act_relation (scheduler_action s) (ksSchedulerAction s')"
+  by (clarsimp simp: state_relation_def)
+
+lemma state_relation_ready_queues_relation[elim!]:
+  "(s, s') \<in> state_relation \<Longrightarrow> ready_queues_relation s s'"
+  by (simp add: state_relation_def)
+
+lemma state_relation_idle_thread[elim!]:
+  "(s, s') \<in> state_relation \<Longrightarrow> idle_thread s = ksIdleThread s'"
+  by (clarsimp simp: state_relation_def)
+
 lemma state_relationD:
   assumes sr:  "(s, s') \<in> state_relation"
   shows "pspace_relation (kheap s) (ksPSpace s') \<and>
   ekheap_relation (ekheap s) (ksPSpace s') \<and>
   sched_act_relation (scheduler_action s) (ksSchedulerAction s') \<and>
-  ready_queues_relation (ready_queues s) (ksReadyQueues s') \<and>
+  ready_queues_relation s 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>
@@ -637,7 +720,7 @@ lemma state_relationE [elim?]:
   and rl: "\<lbrakk>pspace_relation (kheap s) (ksPSpace s');
   ekheap_relation (ekheap s) (ksPSpace s');
   sched_act_relation (scheduler_action s) (ksSchedulerAction s');
-  ready_queues_relation (ready_queues s) (ksReadyQueues s');
+  ready_queues_relation s 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');
diff --git a/proof/refine/ARM_HYP/Syscall_R.thy b/proof/refine/ARM_HYP/Syscall_R.thy
index d9cdbe89ee..d915fe2193 100644
--- a/proof/refine/ARM_HYP/Syscall_R.thy
+++ b/proof/refine/ARM_HYP/Syscall_R.thy
@@ -351,16 +351,14 @@ lemma threadSet_tcbDomain_update_sch_act_wf[wp]:
 
 lemma setDomain_corres:
   "corres dc
-     (valid_etcbs and valid_sched and tcb_at tptr)
-     (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)"
+     (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 corres_guard_imp)
     apply (rule corres_split[OF getCurThread_corres])
-      apply (rule corres_split[OF tcbSchedDequeue_corres])
+      apply (rule corres_split[OF tcbSchedDequeue_corres], simp)
         apply (rule corres_split)
            apply (rule ethread_set_corres; simp)
            apply (clarsimp simp: etcb_relation_def)
@@ -369,26 +367,38 @@ lemma setDomain_corres:
             apply (rule corres_split)
                apply clarsimp
                apply (rule corres_when[OF refl])
-               apply (rule tcbSchedEnqueue_corres)
+               apply (rule tcbSchedEnqueue_corres, simp)
               apply (rule corres_when[OF refl])
               apply (rule rescheduleRequired_corres)
-             apply ((wp hoare_drop_imps hoare_vcg_conj_lift | clarsimp| assumption)+)[5]
-        apply clarsimp
-        apply (rule_tac Q="\<lambda>_. valid_objs' and valid_queues' and valid_queues and
-          (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and tcb_at' tptr"
-          in hoare_strengthen_post[rotated])
-         apply (auto simp: invs'_def valid_state'_def sch_act_wf_weak st_tcb_at'_def o_def)[1]
-        apply (wp threadSet_valid_objs' threadSet_valid_queues'_no_state
-          threadSet_valid_queues_no_state
-          threadSet_pred_tcb_no_state | simp)+
-      apply (rule_tac Q = "\<lambda>r s. invs' s \<and> (\<forall>p. tptr \<notin> set (ksReadyQueues s p)) \<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)
-       apply (drule(1) bspec)
-       apply (clarsimp simp:tcb_cte_cases_def)
+             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 Tcb_R.tcbSchedDequeue_not_in_queue)+
+      apply (wp hoare_vcg_all_lift tcbSchedDequeue_not_queued)+
    apply clarsimp
    apply (frule tcb_at_is_etcb_at)
     apply simp+
@@ -457,7 +467,7 @@ lemma performInvocation_corres:
         apply (rule corres_split[OF setDomain_corres])
           apply (rule corres_trivial, simp)
          apply (wp)+
-       apply (clarsimp+)[2]
+       apply ((clarsimp simp: invs_psp_aligned invs_distinct)+)[2]
      \<comment> \<open>CNodes\<close>
      apply clarsimp
      apply (rule corres_guard_imp)
@@ -770,90 +780,71 @@ 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>rv. invs'\<rbrace>"
+   doReplyTransfer t' t slot grant
+   \<lbrace>\<lambda>_. invs'\<rbrace>"
   apply (simp add: doReplyTransfer_def liftM_def)
   apply (rule hoare_seq_ext [OF _ gts_sp'])
   apply (rule hoare_seq_ext [OF _ assert_sp])
   apply (rule hoare_seq_ext [OF _ getCTE_sp])
   apply (wp, wpc)
-        apply (wp)
+        apply wp
           apply (wp (once) sts_invs_minor'')
-          apply (simp)
+          apply simp
           apply (wp (once) sts_st_tcb')
-          apply (wp)[1]
-         apply (rule_tac Q="\<lambda>rv s. invs' s
-                                   \<and> t \<noteq> ksIdleThread s
-                                   \<and> st_tcb_at' awaiting_reply' t s"
+          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 (frule_tac t=t in invs'_not_runnable_not_queued)
-           apply (erule pred_tcb'_weakenE, case_tac st, clarsimp+)
+          apply clarsimp
           apply (rule conjI, erule pred_tcb'_weakenE, case_tac st, clarsimp+)
-          apply (rule conjI, rule impI, erule pred_tcb'_weakenE, case_tac st)
-                  apply (clarsimp | drule(1) obj_at_conj')+
           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 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 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])
+                               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 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>rv 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 (frule_tac t=t in invs'_not_runnable_not_queued)
-               apply (erule pred_tcb'_weakenE, case_tac st, clarsimp+)
+             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 (rule conjI, rule impI, erule pred_tcb'_weakenE, case_tac st)
-                      apply (clarsimp | drule(1) obj_at_conj')+
               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 clarsimp
               apply (erule_tac P="\<lambda>st. awaiting_reply' st \<and> activatable' st"
-                      in pred_tcb'_weakenE)
+                            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 clarsimp
             apply (rule conjI)
-             apply (clarsimp simp: invs'_def valid_state'_def valid_idle'_def)
-             apply (rule conjI)
-              apply clarsimp
-             apply (clarsimp simp: obj_at'_def idle_tcb'_def pred_tcb_at'_def)
+             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 (rule conjI)
              apply (clarsimp simp : invs'_def valid_state'_def valid_idle'_def pred_tcb_at'_def
                                     obj_at'_def idle_tcb'_def)
-            apply (rule conjI)
-             apply clarsimp
-             apply (frule invs'_not_runnable_not_queued)
-              apply (erule pred_tcb'_weakenE, clarsimp)
-             apply (frule (1) not_tcbQueued_not_ksQ)
-             apply simp
-            apply clarsimp
            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)
@@ -863,35 +854,9 @@ lemma ct_active_runnable' [simp]:
   "ct_active' s \<Longrightarrow> ct_in_state' runnable' s"
   by (fastforce simp: ct_in_state'_def elim!: pred_tcb'_weakenE)
 
-lemma valid_irq_node_tcbSchedEnqueue[wp]:
-  "\<lbrace>\<lambda>s. valid_irq_node' (irq_node' s) s \<rbrace> tcbSchedEnqueue ptr
-  \<lbrace>\<lambda>rv s'. valid_irq_node' (irq_node' s') s'\<rbrace>"
-  apply (rule hoare_pre)
-  apply (simp add:valid_irq_node'_def )
-  apply (wp unless_wp hoare_vcg_all_lift | wps)+
-  apply (simp add:tcbSchedEnqueue_def)
-  apply (wp unless_wp| simp)+
-  apply (simp add:valid_irq_node'_def)
-  done
-
-lemma rescheduleRequired_valid_queues_but_ct_domain:
-  "\<lbrace>\<lambda>s. Invariants_H.valid_queues s \<and> valid_objs' s
-     \<and> (\<forall>x. ksSchedulerAction s = SwitchToThread x \<longrightarrow> st_tcb_at' runnable' x s) \<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | wpc | simp)+
-  done
-
-lemma rescheduleRequired_valid_queues'_but_ct_domain:
-  "\<lbrace>\<lambda>s. valid_queues' s
-     \<and> (\<forall>x. ksSchedulerAction s = SwitchToThread x \<longrightarrow> st_tcb_at' runnable' x s)
-   \<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | wpc | simp | fastforce simp: valid_queues'_def)+
-  done
+crunches tcbSchedEnqueue
+  for valid_irq_node[wp]: "\<lambda>s. valid_irq_node' (irq_node' s) s"
+  (rule: valid_irq_node_lift)
 
 lemma tcbSchedEnqueue_valid_action:
   "\<lbrace>\<lambda>s. \<forall>x. ksSchedulerAction s = SwitchToThread x \<longrightarrow> st_tcb_at' runnable' x s\<rbrace>
@@ -902,10 +867,11 @@ lemma tcbSchedEnqueue_valid_action:
   done
 
 abbreviation (input) "all_invs_but_sch_extra \<equiv>
-    \<lambda>s. valid_pspace' s \<and> Invariants_H.valid_queues s \<and>
+    \<lambda>s. valid_pspace' s \<and>
     sym_refs (state_refs_of' s) \<and>
     sym_refs (state_hyp_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>
@@ -917,7 +883,6 @@ abbreviation (input) "all_invs_but_sch_extra \<equiv>
     valid_machine_state' s \<and>
     cur_tcb' s \<and>
     untyped_ranges_zero' s \<and>
-    valid_queues' 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)"
@@ -930,15 +895,13 @@ lemma rescheduleRequired_all_invs_but_extra:
   apply (rule hoare_pre)
   apply (wp add:rescheduleRequired_ct_not_inQ
     rescheduleRequired_sch_act'
-    rescheduleRequired_valid_queues_but_ct_domain
-    rescheduleRequired_valid_queues'_but_ct_domain
     valid_irq_node_lift valid_irq_handlers_lift''
     irqs_masked_lift cur_tcb_lift)
   apply auto
   done
 
 lemma threadSet_all_invs_but_sch_extra:
-  shows      "\<lbrace> tcb_at' t and (\<lambda>s. (\<forall>p. t \<notin> set (ksReadyQueues s p))) and
+  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
@@ -959,13 +922,11 @@ lemma threadSet_all_invs_but_sch_extra:
      valid_irq_handlers_lift''
      threadSet_ctes_ofT
      threadSet_not_inQ
-     threadSet_valid_queues'_no_state
      threadSet_tcbDomain_update_ct_idle_or_in_cur_domain'
-     threadSet_valid_queues
      threadSet_valid_dom_schedule'
      threadSet_iflive'T
      threadSet_ifunsafe'T
-     untyped_ranges_zero_lift
+     untyped_ranges_zero_lift threadSet_sched_pointers threadSet_valid_sched_pointers
      | simp add:tcb_cte_cases_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)
@@ -993,9 +954,7 @@ lemma setDomain_invs':
       \<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 (erule st_tcb_ex_cap'')
        apply simp
-      apply (case_tac st,simp_all)[1]
      apply (rule hoare_strengthen_post[OF hoare_vcg_conj_lift])
        apply (rule threadSet_all_invs_but_sch_extra)
       prefer 2
@@ -1013,17 +972,14 @@ lemma setDomain_invs':
   done
 
 lemma performInv_invs'[wp]:
-  "\<lbrace>invs' and sch_act_simple
-          and (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))
-          and ct_active' and valid_invocation' i\<rbrace>
-     RetypeDecls_H.performInvocation block call i \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  "\<lbrace>invs' and sch_act_simple and ct_active' and valid_invocation' i\<rbrace>
+   RetypeDecls_H.performInvocation block call i
+   \<lbrace>\<lambda>_. invs'\<rbrace>"
   unfolding performInvocation_def
   apply (cases i)
-  apply ((clarsimp simp: simple_sane_strg sch_act_simple_def
-                         ct_not_ksQ sch_act_sane_def
-                  | wp tcbinv_invs' arch_performInvocation_invs'
-                       setDomain_invs'
-                  | rule conjI | erule active_ex_cap')+)
+  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]:
@@ -1211,14 +1167,17 @@ crunch valid_duplicates'[wp]: addToBitmap "\<lambda>s. vs_valid_duplicates' (ksP
 lemma tcbSchedEnqueue_valid_duplicates'[wp]:
  "\<lbrace>\<lambda>s. vs_valid_duplicates' (ksPSpace s)\<rbrace>
   tcbSchedEnqueue a \<lbrace>\<lambda>rv s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
-  by (simp add: tcbSchedEnqueue_def unless_def setQueue_def | wp | wpc)+
+  by (simp add: tcbSchedEnqueue_def tcbQueuePrepend_def unless_def setQueue_def | wp | wpc)+
 
 crunch valid_duplicates'[wp]: rescheduleRequired "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
   (wp: setObject_ksInterrupt updateObject_default_inv)
 
 crunch valid_duplicates'[wp]: setThreadState "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
 
-(*FIXME: move to Nondet_VCG.valid_validE_R *)
+crunches reply_from_kernel
+  for pspace_aligned[wp]: pspace_aligned
+  and pspace_distinct[wp]: pspace_distinct
+
 lemma handleInvocation_corres:
   "c \<longrightarrow> b \<Longrightarrow>
    corres (dc \<oplus> dc)
@@ -1265,13 +1224,9 @@ lemma handleInvocation_corres:
                       apply simp
                      apply (simp add: when_def)
                      apply (rule conjI, rule impI)
-                      apply (rule reply_from_kernel_tcb_at)
+                      apply (wp reply_from_kernel_tcb_at)
                      apply (rule impI, wp+)
-                 apply simp+
-                 apply (wp hoare_drop_imps)+
-                apply simp
-                apply wp
-               apply simp
+                     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"
@@ -1287,7 +1242,6 @@ lemma handleInvocation_corres:
                                       and (\<lambda>s. vs_valid_duplicates' (ksPSpace s))"
                          in hoare_post_imp)
                apply (clarsimp simp: ct_in_state'_def)
-               apply (frule(1) ct_not_ksQ)
                apply (clarsimp)
               apply (wp setThreadState_nonqueued_state_update
                         setThreadState_st_tcb setThreadState_rct)[1]
@@ -1297,7 +1251,8 @@ lemma handleInvocation_corres:
                     | rule hoare_vcg_E_elim)+
    apply (clarsimp simp: tcb_at_invs invs_valid_objs
                          valid_tcb_state_def ct_in_state_def
-                         simple_from_active invs_mdb)
+                         simple_from_active invs_mdb
+                         invs_distinct invs_psp_aligned)
    apply (clarsimp simp: msg_max_length_def word_bits_def)
    apply (erule st_tcb_ex_cap, clarsimp+)
    apply fastforce
@@ -1305,7 +1260,6 @@ lemma handleInvocation_corres:
   apply (frule tcb_at_invs')
   apply (clarsimp simp: invs'_def valid_state'_def
                         ct_in_state'_def ct_not_inQ_def)
-  apply (frule(1) valid_queues_not_tcbQueued_not_ksQ)
   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)
@@ -1361,10 +1315,7 @@ lemma hinv_invs'[wp]:
         apply wp+
        apply (wp sts_invs_minor' setThreadState_st_tcb setThreadState_rct
                  ct_in_state_thread_state_lift' sts_st_tcb_at'_cases
-        | clarsimp
-        | strengthen ct_not_ksQ[rule_format]
-        )+
-    apply (frule(1) ct_not_ksQ)
+        | clarsimp)+
     apply (simp add: conj_comms)
     apply (fastforce simp add: tcb_at_invs' ct_in_state'_def
                               simple_sane_strg
@@ -1513,7 +1464,6 @@ lemma handleRecv_isBlocking_corres':
                     and (\<lambda>s. ex_nonz_cap_to (cur_thread s) s))
               (invs' and ct_in_state' simple'
                      and sch_act_sane
-                     and (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))
                      and (\<lambda>s. ex_nonz_cap_to' (ksCurThread s) s))
                     (handle_recv isBlocking) (handleRecv isBlocking)"
   (is "corres dc (?pre1) (?pre2) (handle_recv _) (handleRecv _)")
@@ -1576,8 +1526,7 @@ lemma handleRecv_isBlocking_corres':
 
 lemma handleRecv_isBlocking_corres:
   "corres dc (einvs and ct_active)
-             (invs' and ct_active' and sch_act_sane and
-                    (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)))
+             (invs' and ct_active' and sch_act_sane)
             (handle_recv isBlocking) (handleRecv isBlocking)"
   apply (rule corres_guard_imp)
     apply (rule handleRecv_isBlocking_corres')
@@ -1592,42 +1541,27 @@ lemma lookupCap_refs[wp]:
   "\<lbrace>invs'\<rbrace> lookupCap t ref \<lbrace>\<lambda>rv s. \<forall>r\<in>zobj_refs' rv. ex_nonz_cap_to' r s\<rbrace>,-"
   by (simp add: lookupCap_def split_def | wp | simp add: o_def)+
 
-lemma deleteCallerCap_ksQ_ct':
-  "\<lbrace>invs' and ct_in_state' simple' and sch_act_sane and
-     (\<lambda>s. ksCurThread s \<notin> set (ksReadyQueues s p) \<and> thread = ksCurThread s)\<rbrace>
-      deleteCallerCap thread
-   \<lbrace>\<lambda>rv s. thread \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (rule_tac Q="\<lambda>rv s. thread = ksCurThread s \<and> ksCurThread s \<notin> set (ksReadyQueues s p)"
-            in hoare_strengthen_post)
-   apply (wp deleteCallerCap_ct_not_ksQ)
-    apply auto
-  done
-
 lemma hw_invs'[wp]:
   "\<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)
-          and (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))\<rbrace>
+          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
-                           deleteCallerCap_ksQ_ct'
                            hoare_lift_Pf2[OF deleteCallerCap_simple
                            deleteCallerCap_ct']
                       | wpc | simp)+)[1]
                apply simp
                apply (wp deleteCallerCap_nonz_cap hoare_vcg_all_lift
-                         deleteCallerCap_ksQ_ct'
                          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> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))
                              \<and> thread = ksCurThread s
                              \<and> ct_in_state' simple' s
                              \<and> ex_nonz_cap_to' thread s
@@ -1651,34 +1585,45 @@ lemma setSchedulerAction_obj_at'[wp]:
   by (wp, clarsimp elim!: obj_at'_pspaceI)
 
 lemma handleYield_corres:
-  "corres dc einvs (invs' and ct_active' and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)) handle_yield handleYield"
+  "corres dc
+     (einvs and ct_active)
+     (invs' and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread))
+     handle_yield handleYield"
   apply (clarsimp simp: handle_yield_def handleYield_def)
   apply (rule corres_guard_imp)
     apply (rule corres_split[OF getCurThread_corres])
       apply simp
-      apply (rule corres_split[OF tcbSchedDequeue_corres])
-        apply (rule corres_split[OF tcbSchedAppend_corres])
+      apply (rule corres_split[OF tcbSchedDequeue_corres], simp)
+        apply (rule corres_split[OF tcbSchedAppend_corres], simp)
           apply (rule rescheduleRequired_corres)
-         apply (wp weak_sch_act_wf_lift_linear tcbSchedDequeue_valid_queues | simp add: )+
-   apply (simp add: invs_def valid_sched_def valid_sched_action_def
-                cur_tcb_def tcb_at_is_etcb_at)
-  apply clarsimp
-  apply (frule ct_active_runnable')
-  apply (clarsimp simp: invs'_def valid_state'_def ct_in_state'_def sch_act_wf_weak cur_tcb'_def
+         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)
-  apply (erule(1) valid_objs_valid_tcbE[OF valid_pspace_valid_objs'])
-  apply (simp add:valid_tcb'_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 hy_invs':
   "\<lbrace>invs' and ct_active'\<rbrace> handleYield \<lbrace>\<lambda>r. invs' and ct_active'\<rbrace>"
   apply (simp add: handleYield_def)
-  apply (wp ct_in_state_thread_state_lift'
-            rescheduleRequired_all_invs_but_ct_not_inQ
-            tcbSchedAppend_invs_but_ct_not_inQ' | simp)+
-  apply (clarsimp simp add: 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
-                   )
+  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
 
@@ -1866,7 +1811,7 @@ 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 haskell_assert_wp doReplyTransfer_sane getCTE_wp'| wpc)+
+   apply (wp doReplyTransfer_sane getCTE_wp'| wpc)+
   apply (clarsimp simp: cte_wp_at_ctes_of)
   done
 
@@ -1882,74 +1827,6 @@ lemma handleReply_nonz_cap_to_ct:
 
 crunch ksQ[wp]: handleFaultReply "\<lambda>s. P (ksReadyQueues s p)"
 
-lemma doReplyTransfer_ct_not_ksQ:
-  "\<lbrace> invs' and sch_act_simple
-           and tcb_at' thread and tcb_at' word
-           and ct_in_state' simple'
-           and (\<lambda>s. ksCurThread s \<noteq> word)
-           and (\<lambda>s. \<forall>p. ksCurThread s \<notin> set(ksReadyQueues s p))\<rbrace>
-   doReplyTransfer thread word callerSlot g
-   \<lbrace>\<lambda>rv s. \<forall>p. ksCurThread s \<notin> set(ksReadyQueues s p)\<rbrace>"
-proof -
-  have astct: "\<And>t p.
-       \<lbrace>(\<lambda>s. ksCurThread s \<notin> set(ksReadyQueues s p) \<and> sch_act_sane s)
-             and (\<lambda>s. ksCurThread s \<noteq> t)\<rbrace>
-       possibleSwitchTo t \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set(ksReadyQueues s p)\<rbrace>"
-    apply (rule hoare_weaken_pre)
-     apply (wps possibleSwitchTo_ct')
-     apply (wp possibleSwitchTo_ksQ')
-    apply (clarsimp simp: sch_act_sane_def)
-    done
-  have stsct: "\<And>t st p.
-       \<lbrace>(\<lambda>s. ksCurThread s \<notin> set(ksReadyQueues s p)) and sch_act_simple\<rbrace>
-       setThreadState st t
-       \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set(ksReadyQueues s p)\<rbrace>"
-    apply (rule hoare_weaken_pre)
-     apply (wps setThreadState_ct')
-     apply (wp hoare_vcg_all_lift sts_ksQ)
-    apply (clarsimp)
-    done
-  show ?thesis
-    apply (simp add: doReplyTransfer_def)
-    apply (wp, wpc)
-            apply (wp astct stsct hoare_vcg_all_lift
-                      cteDeleteOne_ct_not_ksQ hoare_drop_imp
-                      hoare_lift_Pf2 [OF cteDeleteOne_sch_act_not cteDeleteOne_ct']
-                      hoare_lift_Pf2 [OF doIPCTransfer_pred_tcb_at' doIPCTransfer_ct']
-                      hoare_lift_Pf2 [OF doIPCTransfer_ksQ doIPCTransfer_ct']
-                      hoare_lift_Pf2 [OF threadSet_ksQ threadSet_ct]
-                      hoare_lift_Pf2 [OF handleFaultReply_ksQ handleFaultReply_ct']
-                   | simp add: ct_in_state'_def)+
-     apply (fastforce simp: sch_act_simple_def sch_act_sane_def ct_in_state'_def)+
-    done
-qed
-
-lemma handleReply_ct_not_ksQ:
-  "\<lbrace>invs' and sch_act_simple
-           and ct_in_state' simple'
-           and (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))\<rbrace>
-   handleReply
-   \<lbrace>\<lambda>rv s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: handleReply_def del: split_paired_All)
-  apply (subst haskell_assert_def)
-  apply (wp | wpc)+
-  apply (wp doReplyTransfer_ct_not_ksQ getThreadCallerSlot_inv)+
-    apply (rule_tac Q="\<lambda>cap.
-                              (\<lambda>s. \<forall>p. ksCurThread s \<notin> set(ksReadyQueues s p))
-                          and invs'
-                          and sch_act_simple
-                          and (\<lambda>s. thread = ksCurThread s)
-                          and tcb_at' thread
-                          and ct_in_state' simple'
-                          and cte_wp_at' (\<lambda>c. cteCap c = cap) callerSlot"
-             in hoare_post_imp)
-     apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def
-                           cte_wp_at_ctes_of valid_cap'_def
-                    dest!: ctes_of_valid')
-    apply (wp getSlotCap_cte_wp_at getThreadCallerSlot_inv)+
-  apply (clarsimp)
-  done
-
 crunch valid_etcbs[wp]: possible_switch_to  "valid_etcbs"
 crunch valid_etcbs[wp]: handle_recv "valid_etcbs"
   (wp: crunch_wps simp: crunch_simps)
@@ -1963,18 +1840,16 @@ lemma handleReply_handleRecv_corres:
     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 handleReply_ct_not_ksQ handle_reply_valid_sched)+
+               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 (frule(1) ct_not_ksQ)
   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)
              (invs' and sch_act_not thread
-                    and (\<lambda>s. \<forall>p. thread \<notin> set(ksReadyQueues s p))
                     and st_tcb_at' simple' thread and ex_nonz_cap_to' thread)
           (handle_hypervisor_fault thread fault)
           (handleHypervisorFault thread fault)"
@@ -2000,12 +1875,11 @@ lemma hvmf_invs_lift:
                  doMachineOp_bind getRestartPC_def getRegister_def)
 
 lemma hvmf_invs_etc:
-  "\<lbrace>invs' and sch_act_not t and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p)) and st_tcb_at' simple' t and
+  "\<lbrace>invs' and sch_act_not t and st_tcb_at' simple' t and
     ex_nonz_cap_to' t\<rbrace>
     handleVMFault t f
    \<lbrace>\<lambda>_ _. True\<rbrace>,
-   \<lbrace>\<lambda>_. invs' and sch_act_not t and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p)) and
-        st_tcb_at' simple' t and ex_nonz_cap_to' t\<rbrace>"
+   \<lbrace>\<lambda>_. invs' and sch_act_not t and st_tcb_at' simple' t and ex_nonz_cap_to' t\<rbrace>"
   apply (rule hvmf_invs_lift)
   apply (clarsimp simp: invs'_def valid_state'_def valid_machine_state'_def)
   done
@@ -2020,14 +1894,13 @@ lemma handleEvent_corres:
   (is "?handleEvent_corres")
 proof -
   have hw:
-    "\<And>isBlocking. corres dc (einvs and ct_running and (\<lambda>s. scheduler_action s = resume_cur_thread))
+    "\<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
-                     dest!: ct_not_ksQ)+
+                     elim!: st_tcb_weakenE pred_tcb'_weakenE)+
     done
     show ?thesis
       apply (case_tac event)
@@ -2053,7 +1926,6 @@ proof -
                            simp: ct_in_state_def)
          apply wp
          apply (clarsimp)
-         apply (frule(1) ct_not_ksQ)
          apply (auto simp: ct_in_state'_def sch_act_simple_def
                            sch_act_sane_def
                      elim: pred_tcb'_weakenE st_tcb_ex_cap'')[1]
@@ -2066,7 +1938,6 @@ proof -
                           simp: ct_in_state_def valid_fault_def)
         apply wp
         apply clarsimp
-        apply (frule(1) ct_not_ksQ)
         apply (auto simp: ct_in_state'_def sch_act_simple_def
                           sch_act_sane_def
                     elim: pred_tcb'_weakenE st_tcb_ex_cap'')[1]
@@ -2082,11 +1953,7 @@ proof -
                     doMachineOp_getActiveIRQ_IRQ_active'
                    | simp
                    | simp add: imp_conjR | wp (once) hoare_drop_imps)+
-       apply (clarsimp simp: invs'_def valid_state'_def ct_not_inQ_def valid_queues_def
-                             valid_queues_no_bitmap_def)
-       apply (erule allE)+
-       apply (erule conjE, drule (1) bspec)
-       apply (clarsimp simp: obj_at'_def inQ_def)
+       apply (clarsimp simp: invs'_def valid_state'_def ct_not_inQ_def valid_queues_def)
       apply (rule_tac corres_underlying_split)
          apply (rule corres_guard_imp, rule getCurThread_corres, simp+)
         apply (rule corres_split_catch)
@@ -2099,7 +1966,6 @@ proof -
        apply (fastforce elim!: st_tcb_ex_cap st_tcb_weakenE simp: ct_in_state_def)
       apply wp
       apply (clarsimp)
-      apply (frule(1) ct_not_ksQ)
       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)
@@ -2110,7 +1976,6 @@ proof -
                            simp: ct_in_state_def)
          apply wp
          apply (clarsimp)
-         apply (frule(1) ct_not_ksQ)
          apply (auto simp: ct_in_state'_def sch_act_simple_def
                            sch_act_sane_def
                      elim: pred_tcb'_weakenE st_tcb_ex_cap'')[1]
@@ -2136,9 +2001,10 @@ lemma hv_stuff'[wp]:
   by (wpsimp wp: getDFSR_inv getHSR_inv getHDFAR_inv getRestartPC_inv det_getRestartPC asUser_inv)
 
 lemma hh_invs'[wp]:
-  "\<lbrace>invs' and sch_act_not p and (\<lambda>s. \<forall>a b. p \<notin> set (ksReadyQueues s (a, b))) and
-    st_tcb_at' simple' p and ex_nonz_cap_to' p and (\<lambda>s. p \<noteq> ksIdleThread s)\<rbrace>
-  handleHypervisorFault p t \<lbrace>\<lambda>_. invs'\<rbrace>"
+  "\<lbrace>invs' and sch_act_not p and st_tcb_at' simple' p and ex_nonz_cap_to' p
+    and (\<lambda>s. p \<noteq> ksIdleThread s)\<rbrace>
+   handleHypervisorFault p t
+   \<lbrace>\<lambda>_. invs'\<rbrace>"
   apply (simp add: ARM_HYP_H.handleHypervisorFault_def)
   apply (cases t; wpsimp)
   done
@@ -2204,10 +2070,8 @@ proof -
         apply (rename_tac syscall)
         apply (case_tac syscall,
                (wp handleReply_sane handleReply_nonz_cap_to_ct handleReply_ksCurThread
-                   handleReply_ct_not_ksQ
                 | clarsimp simp: active_from_running' simple_from_running' simple_sane_strg simp del: split_paired_All
                 | rule conjI active_ex_cap'
-                | drule ct_not_ksQ[rotated]
                 | strengthen nidle)+)
         apply (rule hoare_strengthen_post,
                rule hoare_weaken_pre,
@@ -2220,7 +2084,6 @@ proof -
                  | 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'
-                 | drule ct_not_ksQ[rotated]
                  | wpc | wp (once) hoare_drop_imps hoare_vcg_all_lift)+
   done
 qed
diff --git a/proof/refine/ARM_HYP/TcbAcc_R.thy b/proof/refine/ARM_HYP/TcbAcc_R.thy
index b0cc124095..35f8262257 100644
--- a/proof/refine/ARM_HYP/TcbAcc_R.thy
+++ b/proof/refine/ARM_HYP/TcbAcc_R.thy
@@ -58,10 +58,8 @@ lemma getHighestPrio_inv[wp]:
   unfolding bitmap_fun_defs by simp
 
 lemma valid_bitmapQ_bitmapQ_simp:
-  "\<lbrakk> valid_bitmapQ s \<rbrakk> \<Longrightarrow>
-   bitmapQ d p s = (ksReadyQueues s (d, p) \<noteq> [])"
-   unfolding valid_bitmapQ_def
-   by simp
+  "valid_bitmapQ s \<Longrightarrow> bitmapQ d p s = (\<not> tcbQueueEmpty (ksReadyQueues s (d, p)))"
+  by (simp add: valid_bitmapQ_def)
 
 lemma prioToL1Index_l1IndexToPrio_or_id:
   "\<lbrakk> unat (w'::priority) < 2 ^ wordRadix ; w < size w' \<rbrakk>
@@ -84,20 +82,6 @@ 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 and runnable' \<circ> tcbState) t s)
-    \<and>  distinct (ksReadyQueues s (d, p))
-    \<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
-
 lemma st_tcb_at_coerce_abstract:
   assumes t: "st_tcb_at' P t c"
   assumes sr: "(a, c) \<in> state_relation"
@@ -107,11 +91,10 @@ lemma st_tcb_at_coerce_abstract:
                         projectKOs objBits_simps)
   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
-                        ARM_A.arch_kernel_obj.split_asm)+
-  apply fastforce
+  apply (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
+                          ARM_A.arch_kernel_obj.split_asm)+
   done
 
 lemma st_tcb_at_runnable_coerce_concrete:
@@ -128,24 +111,130 @@ lemma st_tcb_at_runnable_coerce_concrete:
   apply (case_tac "tcb_state tcb"; simp)
   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"
+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)
   done
 
-lemma valid_objs'_maxDomain:
-  "\<And>s t. \<lbrakk> valid_objs' s; tcb_at' t s \<rbrakk> \<Longrightarrow> obj_at' (\<lambda>tcb. tcbDomain tcb \<le> maxDomain) t s"
-  apply (erule (1) valid_objs_valid_tcbE)
-  apply (clarsimp simp: valid_tcb'_def)
+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
+  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 objBits_simps')
+  done
+
+definition valid_tcbs' :: "kernel_state \<Rightarrow> bool" where
+  "valid_tcbs' s' \<equiv> \<forall>ptr tcb. ksPSpace s' ptr = Some (KOTCB tcb) \<longrightarrow> valid_tcb' tcb s'"
+
+lemma valid_objs'_valid_tcbs'[elim!]:
+  "valid_objs' s \<Longrightarrow> valid_tcbs' s"
+  by (auto simp: valid_objs'_def valid_tcbs'_def valid_obj'_def split: kernel_object.splits)
+
+lemma invs'_valid_tcbs'[elim!]:
+  "invs' s \<Longrightarrow> valid_tcbs' s"
+  by (fastforce intro: valid_objs'_valid_tcbs')
+
+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 valid_tcb'_def projectKOs)
   done
 
-lemma valid_objs'_maxPriority:
-  "\<And>s t. \<lbrakk> valid_objs' s; tcb_at' t s \<rbrakk> \<Longrightarrow> obj_at' (\<lambda>tcb. tcbPriority tcb \<le> maxPriority) t s"
-  apply (erule (1) valid_objs_valid_tcbE)
-  apply (clarsimp simp: valid_tcb'_def)
+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 valid_tcb'_def projectKOs)
   done
 
+lemmas valid_objs'_maxPriority = valid_tcbs'_maxPriority[OF valid_objs'_valid_tcbs']
+
+lemma valid_tcbs'_obj_at':
+  assumes "valid_tcbs' 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"
+  using assms
+  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 (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"
+  "\<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
+                 opt_tcb_at'_def valid_arch_tcb'_def
+          split: option.splits thread_state.splits)
+
+lemma update_valid_tcbs'[simp]:
+  "\<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':
   assumes masks: "\<And>P. \<lbrace>\<lambda>s. P (irq_masks s)\<rbrace> f \<lbrace>\<lambda>_ s. P (irq_masks s)\<rbrace>"
   shows "\<lbrace>valid_irq_states'\<rbrace> doMachineOp f \<lbrace>\<lambda>rv. valid_irq_states'\<rbrace>"
@@ -243,56 +332,117 @@ lemma updateObject_tcb_inv:
   by simp (rule updateObject_default_inv)
 
 lemma setObject_update_TCB_corres':
-  assumes tcbs: "tcb_relation tcb tcb' \<Longrightarrow> tcb_relation tcbu tcbu'"
-  assumes tables: "\<forall>(getF, v) \<in> ran tcb_cap_cases. getF tcbu = getF tcb"
-  assumes tables': "\<forall>(getF, v) \<in> ran tcb_cte_cases. getF tcbu' = getF tcb'"
+  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"
+  assumes tables': "\<forall>(getF, v) \<in> ran tcb_cte_cases. getF new_tcb' = getF tcb'"
+  assumes sched_pointers: "tcbSchedPrev new_tcb' = tcbSchedPrev tcb'"
+                          "tcbSchedNext new_tcb' = tcbSchedNext tcb'"
+  assumes flag: "tcbQueued new_tcb' = tcbQueued tcb'"
   assumes r: "r () ()"
-  assumes exst: "exst_same tcb' tcbu'"
-  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' \<and> exst_same tcb' tcbu'" 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 exst)
-  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: projectKOs tcb_relation_cut_def exst)
+  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 project_inject 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 () (); exst_same tcb' tcbu'\<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 fastforce
-  apply (clarsimp simp: getObject_def in_monad split_def obj_at'_def
-                        loadObject_default_def projectKOs objBits_simps'
-                        in_magnitude_check)
+    apply (erule (7) setObject_update_TCB_corres')
+   apply (clarsimp simp: getObject_def in_monad split_def obj_at'_def
+                         loadObject_default_def objBits_simps' in_magnitude_check projectKOs)+
   done
 
 lemma getObject_TCB_corres:
-  "corres tcb_relation (tcb_at t) (tcb_at' t)
+  "corres tcb_relation (tcb_at t and pspace_aligned and pspace_distinct) \<top>
           (gets_the (get_tcb t)) (getObject t)"
+  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 (rule corres_gets_the)
     apply (rule corres_get_tcb)
@@ -302,7 +452,8 @@ 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)"
+  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
@@ -324,7 +475,8 @@ lemma ball_tcb_cte_casesI:
   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. P (Thread a b c d e f g h i j k l m n p q) \<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:
@@ -333,18 +485,24 @@ 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"
+  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)
-                        (tcb_at' t)
-                    (thread_set f t) (threadSet f' t)"
+  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 (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+
@@ -374,9 +532,12 @@ lemma threadSet_corres_noopT:
                          tcb_relation tcb (fn tcb')"
   assumes y: "\<forall>tcb. \<forall>(getF, setF) \<in> ran tcb_cte_cases.
                  getF (fn tcb) = getF tcb"
+  assumes s: "\<forall>tcb'. tcbSchedPrev (fn tcb') = tcbSchedPrev tcb'"
+             "\<forall>tcb'. tcbSchedNext (fn tcb') = tcbSchedNext tcb'"
+  assumes f: "\<And>tcb'. tcbQueued (fn tcb') = tcbQueued tcb'"
   assumes e: "\<And>tcb'. exst_same tcb' (fn tcb')"
-  shows      "corres dc \<top> (tcb_at' t)
-                           (return v) (threadSet fn t)"
+  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)
@@ -392,16 +553,15 @@ proof -
        defer
        apply (subst bind_return [symmetric],
               rule corres_underlying_split [OF threadset_corresT])
-             apply (simp add: x)
-            apply simp
-           apply (rule y)
+                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 wpsimp+
-      apply (erule pspace_relation_tcb_at[rotated])
-      apply clarsimp
-     apply simp
-    apply simp
     done
 qed
 
@@ -415,14 +575,20 @@ 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>"
+  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 P (tcb_at' t and P')
+  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)+
@@ -659,7 +825,12 @@ lemma threadSet_valid_pspace'T_P:
   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 p: "\<forall>tcb. (P \<longrightarrow> Q'' (tcbSchedPrev tcb)) \<longrightarrow>
+                      (\<forall>s. opt_tcb_at' (tcbSchedPrev tcb) s
+                              \<longrightarrow> opt_tcb_at' (tcbSchedPrev (F tcb)) s)"
+  assumes n: "\<forall>tcb. (P \<longrightarrow> Q''' (tcbSchedNext tcb)) \<longrightarrow>
+                      (\<forall>s. opt_tcb_at' (tcbSchedNext tcb) s
+                              \<longrightarrow> opt_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"
@@ -667,9 +838,11 @@ lemma threadSet_valid_pspace'T_P:
   assumes w': "\<forall>tcb. tcbMCP tcb \<le> maxPriority \<longrightarrow> tcbMCP (F tcb) \<le> maxPriority"
   assumes v': "\<forall>tcb s. valid_arch_tcb' (tcbArch tcb) s \<longrightarrow> valid_arch_tcb' (tcbArch (F tcb)) s"
   shows
-  "\<lbrace>valid_pspace' and (\<lambda>s. P \<longrightarrow> st_tcb_at' Q t s \<and> bound_tcb_at' Q' t s)\<rbrace>
-     threadSet F t
-   \<lbrace>\<lambda>rv. valid_pspace'\<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>_. valid_pspace'\<rbrace>"
   apply (simp add: valid_pspace'_def threadSet_def)
   apply (rule hoare_pre,
          wp setObject_tcb_valid_objs getObject_tcb_wp)
@@ -677,7 +850,7 @@ lemma threadSet_valid_pspace'T_P:
   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 v w' v')
+                            split_paired_Ball y u w v w' v' p n)
   done
 
 lemmas threadSet_valid_pspace'T =
@@ -761,6 +934,10 @@ lemma threadSet_iflive'T:
               \<and> tcbState (F tcb) \<noteq> Inactive
               \<and> tcbState (F tcb) \<noteq> IdleThreadState
               \<and> ko_at' tcb t s) \<longrightarrow> ex_nonz_cap_to' t s)
+      \<and> ((\<exists>tcb. tcbSchedNext tcb = None \<and> tcbSchedNext (F tcb) \<noteq> None
+              \<and> ko_at' tcb t s) \<longrightarrow> ex_nonz_cap_to' t s)
+      \<and> ((\<exists>tcb. tcbSchedPrev tcb = None \<and> tcbSchedPrev (F tcb) \<noteq> None
+              \<and> ko_at' tcb t s) \<longrightarrow> ex_nonz_cap_to' t s)
       \<and> ((\<exists>tcb. \<not> tcbQueued tcb \<and> tcbQueued (F tcb)
               \<and> ko_at' tcb t s) \<longrightarrow> ex_nonz_cap_to' t s)
       \<and>((\<exists>tcb. \<not> bound (atcbVCPUPtr (tcbArch tcb)) \<and> bound (atcbVCPUPtr (tcbArch (F tcb)))
@@ -816,6 +993,12 @@ lemmas threadSet_ctes_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)
+  \<Longrightarrow> threadSet f tptr \<lbrace>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 objBits_simps')
+
 lemma threadSet_idle'T:
   assumes x: "\<forall>tcb. \<forall>(getF, setF) \<in> ran tcb_cte_cases. getF (F tcb) = getF tcb"
   shows
@@ -854,30 +1037,6 @@ lemma set_tcb_bitmapQ_no_L2_orphans[wp]:
   apply (wp hoare_Ball_helper hoare_vcg_all_lift updateObject_default_inv | simp add: bitmapQ_def)+
   done
 
-lemma threadSet_valid_queues_no_bitmap:
-  "\<lbrace> valid_queues_no_bitmap and
-    (\<lambda>s. \<forall>d p. (\<exists>tcb. (inQ d p tcb \<and> runnable' (tcbState tcb)) \<and>
-                     \<not>(inQ d p (f tcb) \<and> runnable' (tcbState (f tcb))))
-                \<longrightarrow> obj_at' (\<lambda>tcb. (inQ d p tcb \<and> runnable' (tcbState tcb)) \<and>
-                                 \<not>(inQ d p (f tcb) \<and> runnable' (tcbState (f tcb)))) t s
-                \<longrightarrow> t \<notin> set (ksReadyQueues s (d, p))
-    )\<rbrace>
-     threadSet f t
-   \<lbrace>\<lambda>rv. valid_queues_no_bitmap \<rbrace>"
-  apply (simp add: threadSet_def)
-  apply wp
-   apply (simp add: Invariants_H.valid_queues_no_bitmap_def' pred_tcb_at'_def)
-
-   apply (wp setObject_queues_unchanged_tcb
-             hoare_Ball_helper
-             hoare_vcg_all_lift
-             setObject_tcb_strongest)[1]
-  apply (wp getObject_tcb_wp)
-  apply (clarsimp simp: valid_queues_no_bitmap_def' pred_tcb_at'_def)
-  apply (clarsimp simp: obj_at'_def projectKOs)
-  apply (fastforce)
-  done
-
 lemma threadSet_valid_bitmapQ[wp]:
   "\<lbrace> valid_bitmapQ \<rbrace> threadSet f t \<lbrace> \<lambda>rv. valid_bitmapQ \<rbrace>"
   unfolding bitmapQ_defs threadSet_def
@@ -896,73 +1055,6 @@ lemma threadSet_valid_bitmapQ_no_L2_orphans[wp]:
   by (clarsimp simp: setObject_def split_def)
      (wp | simp add: updateObject_default_def)+
 
-lemma threadSet_valid_queues:
-  "\<lbrace>Invariants_H.valid_queues and
-    (\<lambda>s. \<forall>d p. (\<exists>tcb. (inQ d p tcb \<and> runnable' (tcbState tcb)) \<and>
-                     \<not>(inQ d p (f tcb) \<and> runnable' (tcbState (f tcb))))
-                \<longrightarrow> obj_at' (\<lambda>tcb. (inQ d p tcb \<and> runnable' (tcbState tcb)) \<and>
-                                 \<not>(inQ d p (f tcb) \<and> runnable' (tcbState (f tcb)))) t s
-                \<longrightarrow> t \<notin> set (ksReadyQueues s (d, p))
-    )\<rbrace>
-     threadSet f t
-   \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  unfolding valid_queues_def
-  by (wp threadSet_valid_queues_no_bitmap;simp)
-
-definition
-  addToQs :: "(Structures_H.tcb \<Rightarrow> Structures_H.tcb)
-                       \<Rightarrow> word32 \<Rightarrow> (domain \<times> priority \<Rightarrow> word32 list)
-                       \<Rightarrow> (domain \<times> priority \<Rightarrow> word32 list)"
-where
- "addToQs F t \<equiv> \<lambda>qs (qdom, prio). if (\<forall>ko. \<not> inQ qdom prio (F ko))
-                             then t # qs (qdom, prio)
-                             else qs (qdom, prio)"
-
-lemma addToQs_set_def:
-  "(t' \<in> set (addToQs F t qs (qdom, prio))) = (t' \<in> set (qs (qdom, prio))
-      \<or> (t' = t \<and> (\<forall>ko. \<not> inQ qdom prio (F ko))))"
-  by (auto simp add: addToQs_def)
-
-lemma threadSet_valid_queues_addToQs:
-  "\<lbrace>\<lambda>s. (\<forall>ko qdom prio. ko_at' ko t s \<and> inQ qdom prio (F ko) \<and> \<not> inQ qdom prio ko
-            \<longrightarrow> t \<in> set (ksReadyQueues s (qdom, prio)))
-             \<and> valid_queues' (ksReadyQueues_update (addToQs F t) s)\<rbrace>
-     threadSet F t
-   \<lbrace>\<lambda>rv. 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_set_def
-             split del: if_split cong: if_cong)
-  apply (fastforce simp: projectKOs split: if_split_asm)
-  done
-
-lemma threadSet_valid_queues_Qf:
-  "\<lbrace>\<lambda>s. (\<forall>ko qdom prio. ko_at' ko t s \<and> inQ qdom prio (F ko) \<and> \<not> inQ qdom prio ko
-            \<longrightarrow> t \<in> set (ksReadyQueues s (qdom, prio)))
-             \<and> valid_queues' (ksReadyQueues_update Qf s)
-             \<and> (\<forall>prio. set (Qf (ksReadyQueues s) prio)
-                        \<subseteq> set (addToQs F t (ksReadyQueues s) prio))\<rbrace>
-     threadSet F t
-   \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (wp threadSet_valid_queues_addToQs)
-  apply (clarsimp simp: valid_queues'_def subset_iff)
-  done
-
-lemma addToQs_subset:
-  "set (qs p) \<subseteq> set (addToQs F t qs p)"
-by (clarsimp simp: addToQs_def split_def)
-
-lemmas threadSet_valid_queues'
-  = threadSet_valid_queues_Qf
-       [where Qf=id, simplified ksReadyQueues_update_id
-                                id_apply addToQs_subset simp_thms]
-
 lemma threadSet_cur:
   "\<lbrace>\<lambda>s. cur_tcb' s\<rbrace> threadSet f t \<lbrace>\<lambda>rv s. cur_tcb' s\<rbrace>"
   apply (simp add: threadSet_def cur_tcb'_def)
@@ -978,7 +1070,7 @@ lemma modifyReadyQueuesL1Bitmap_obj_at[wp]:
 
 crunches setThreadState, setBoundNotification
   for valid_arch' [wp]: valid_arch_state'
-  (simp: unless_def crunch_simps)
+  (simp: unless_def crunch_simps wp: crunch_wps)
 
 crunch ksInterrupt'[wp]: threadSet "\<lambda>s. P (ksInterruptState s)"
   (wp: setObject_ksInterrupt updateObject_default_inv)
@@ -1240,60 +1332,103 @@ lemma threadSet_valid_dom_schedule':
   unfolding threadSet_def
   by (wp setObject_ksDomSchedule_inv hoare_Ball_helper)
 
-lemma threadSet_invs_trivialT:
-  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 \<and> tcbDomain (F tcb) = tcbDomain tcb"
-  assumes w: "\<forall>tcb. is_aligned (tcbIPCBuffer tcb) msg_align_bits \<longrightarrow> is_aligned (tcbIPCBuffer (F tcb)) msg_align_bits"
-  assumes a: "\<forall>tcb. tcbBoundNotification (F tcb) = tcbBoundNotification tcb"
-  assumes w: "\<forall>tcb. is_aligned (tcbIPCBuffer tcb) msg_align_bits \<longrightarrow> is_aligned (tcbIPCBuffer (F tcb)) msg_align_bits"
-  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 r: "\<forall>tcb. atcbVCPUPtr (tcbArch (F tcb)) = atcbVCPUPtr (tcbArch tcb)"
-  shows
-  "\<lbrace>\<lambda>s. invs' s \<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. \<not> tcbQueued tcb \<and> tcbQueued (F tcb)) \<longrightarrow> ex_nonz_cap_to' t s \<and> t \<noteq> ksCurThread s) \<and>
-       (\<forall>tcb. tcbQueued (F tcb) \<and> ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> tcbQueued tcb \<or> t \<noteq> ksCurThread s)\<rbrace>
-   threadSet F t
-   \<lbrace>\<lambda>rv. invs'\<rbrace>"
-proof -
-  from z have domains: "\<And>tcb. tcbDomain (F tcb) = tcbDomain tcb" by blast
-  note threadSet_sch_actT_P[where P=False, simplified]
-  have y: "\<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 valid_state'_def split del: if_split)
-    apply (rule hoare_pre)
-     apply (wp x w v u b
-              threadSet_valid_pspace'T
-              threadSet_sch_actT_P[where P=False, simplified]
-              threadSet_valid_queues
-              threadSet_state_refs_of'T[where f'=id]
-              threadSet_state_hyp_refs_of'
-              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_cur
-              untyped_ranges_zero_lift
-           |clarsimp simp: y z a r domains cteCaps_of_def valid_arch_tcb'_def|rule refl)+
-   apply (clarsimp simp: obj_at'_def projectKOs pred_tcb_at'_def)
-   apply (clarsimp simp: cur_tcb'_def valid_irq_node'_def valid_queues'_def o_def)
-  apply (fastforce simp: domains ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def z a)
+lemma threadSet_wp:
+  "\<lbrace>\<lambda>s. \<forall>tcb. ko_at' tcb t s \<longrightarrow> P (s\<lparr>ksPSpace := (ksPSpace s)(t \<mapsto> injectKO (f tcb))\<rparr>)\<rbrace>
+   threadSet f t
+   \<lbrace>\<lambda>_. P\<rbrace>"
+  unfolding threadSet_def setObject_def
+  apply (wpsimp wp: getObject_tcb_wp simp: updateObject_default_def)
+  apply (auto simp: obj_at'_def split: if_splits)
+  apply (erule rsubst[where P=P])
+  apply (clarsimp simp: fun_upd_def)
+  apply (prop_tac "\<forall>ptr. psMap (ksPSpace s) ptr = ksPSpace s ptr")
+   apply fastforce
+  apply metis
+  done
+
+lemma threadSet_sched_pointers:
+  "\<lbrakk>\<And>tcb. tcbSchedNext (F tcb) = tcbSchedNext tcb; \<And>tcb. tcbSchedPrev (F tcb) = tcbSchedPrev tcb\<rbrakk>
+   \<Longrightarrow> threadSet F tcbPtr \<lbrace>\<lambda>s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)\<rbrace>"
+  apply (wpsimp wp: threadSet_wp getObject_tcb_wp)
+  apply (fastforce simp: opt_map_def obj_at'_def projectKOs elim: rsubst2[where P=P])
   done
-qed
+
+lemma threadSet_valid_sched_pointers:
+  "\<lbrakk>\<And>tcb. tcbSchedNext (F tcb) = tcbSchedNext tcb; \<And>tcb. tcbSchedPrev (F tcb) = tcbSchedPrev tcb;
+    \<And>tcb. tcbQueued (F tcb) = tcbQueued tcb\<rbrakk>
+   \<Longrightarrow> threadSet F tcbPtr \<lbrace>valid_sched_pointers\<rbrace>"
+  unfolding valid_sched_pointers_def
+  apply (wpsimp wp: threadSet_wp getObject_tcb_wp)
+  by (fastforce simp: opt_pred_def opt_map_def obj_at'_def projectKOs split: option.splits if_splits)
+
+lemma threadSet_tcbSchedNexts_of:
+  "(\<And>tcb. tcbSchedNext (F tcb) = tcbSchedNext tcb) \<Longrightarrow>
+   threadSet F t \<lbrace>\<lambda>s. P (tcbSchedNexts_of s)\<rbrace>"
+  apply (wpsimp wp: threadSet_wp getObject_tcb_wp)
+  apply (erule rsubst[where P=P])
+  apply (fastforce simp: opt_map_def obj_at'_def projectKOs)
+  done
+
+lemma threadSet_tcbSchedPrevs_of:
+  "(\<And>tcb. tcbSchedPrev (F tcb) = tcbSchedPrev tcb) \<Longrightarrow>
+   threadSet F t \<lbrace>\<lambda>s. P (tcbSchedPrevs_of s)\<rbrace>"
+  apply (wpsimp wp: threadSet_wp getObject_tcb_wp)
+  apply (erule rsubst[where P=P])
+  apply (fastforce simp: opt_map_def obj_at'_def projectKOs)
+  done
+
+lemma threadSet_tcbQueued:
+  "(\<And>tcb. tcbQueued (F tcb) = tcbQueued tcb) \<Longrightarrow>
+   threadSet F t \<lbrace>\<lambda>s. P (tcbQueued |< tcbs_of' s)\<rbrace>"
+  apply (wpsimp wp: threadSet_wp getObject_tcb_wp)
+  apply (erule rsubst[where P=P])
+  apply (fastforce simp: opt_pred_def opt_map_def obj_at'_def projectKOs)
+  done
+
+crunches threadSet
+  for ksReadyQueues[wp]: "\<lambda>s. P (ksReadyQueues s)"
+  and ksReadyQueuesL1Bitmap[wp]: "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
+  and ksReadyQueuesL2Bitmap[wp]: "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
+
+lemma threadSet_invs_trivialT:
+  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. is_aligned (tcbIPCBuffer tcb) msg_align_bits
+           \<longrightarrow> is_aligned (tcbIPCBuffer (F tcb)) msg_align_bits"
+    "\<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. tcbMCP tcb \<le> maxPriority \<longrightarrow> tcbMCP (F tcb) \<le> maxPriority"
+    "\<forall>tcb. atcbVCPUPtr (tcbArch (F tcb)) = atcbVCPUPtr (tcbArch tcb)"
+  shows "threadSet F t \<lbrace>invs'\<rbrace>"
+  apply (simp add: invs'_def valid_state'_def split del: if_split)
+  apply (wp threadSet_valid_pspace'T
+            threadSet_sch_actT_P[where P=False, simplified]
+            threadSet_state_refs_of'T[where f'=id]
+            threadSet_state_hyp_refs_of'
+            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_cur
+            untyped_ranges_zero_lift
+            sym_heap_sched_pointers_lift threadSet_valid_sched_pointers
+            threadSet_tcbQueued
+            threadSet_tcbSchedPrevs_of threadSet_tcbSchedNexts_of valid_bitmaps_lift
+         | clarsimp simp: assms cteCaps_of_def valid_arch_tcb'_def | rule refl)+
+  apply (clarsimp simp: o_def)
+  by (auto simp: assms obj_at'_def)
 
 lemmas threadSet_invs_trivial =
     threadSet_invs_trivialT [OF all_tcbI all_tcbI all_tcbI all_tcbI, OF ball_tcb_cte_casesI]
@@ -1338,11 +1473,74 @@ lemma threadSet_valid_objs':
   apply (clarsimp elim!: obj_at'_weakenE)
   done
 
+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']
+
+lemma setObject_valid_tcbs':
+  assumes preserve_valid_tcb': "\<And>s s' ko ko' x n tcb tcb'.
+            \<lbrakk> (ko', s') \<in> fst (updateObject val ko ptr x n s); P s;
+              lookupAround2 ptr (ksPSpace s) = (Some (x, ko), n);
+              projectKO_opt ko = Some tcb; projectKO_opt ko' = Some tcb';
+              valid_tcb' tcb s \<rbrakk> \<Longrightarrow> valid_tcb' tcb' s"
+  shows "\<lbrace>valid_tcbs' and P\<rbrace> setObject ptr val \<lbrace>\<lambda>rv. valid_tcbs'\<rbrace>"
+  unfolding valid_tcbs'_def
+  apply (clarsimp simp: valid_def)
+  apply (rename_tac s s' ptr' tcb)
+  apply (prop_tac "\<forall>tcb'. valid_tcb' tcb s \<longrightarrow> valid_tcb' tcb s'")
+   apply clarsimp
+   apply (erule (1) use_valid[OF _ setObject_valid_tcb'])
+  apply (drule spec, erule mp)
+  apply (clarsimp simp: setObject_def in_monad split_def lookupAround2_char1)
+  apply (rename_tac s ptr' new_tcb' ptr'' old_tcb_ko' s' f)
+  apply (case_tac "ptr'' = ptr'"; clarsimp)
+  apply (prop_tac "\<exists>old_tcb' :: tcb. projectKO_opt old_tcb_ko' = Some old_tcb'")
+   apply (frule updateObject_type)
+   apply (case_tac old_tcb_ko'; clarsimp simp: project_inject)
+  apply (erule exE)
+  apply (rule preserve_valid_tcb', assumption+)
+     apply (simp add: prod_eqI lookupAround2_char1)
+    apply force
+   apply (clarsimp simp: project_inject)
+  apply (clarsimp simp: project_inject)
+  done
+
+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 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>_. valid_tcb' tcb\<rbrace>"
+  apply (simp add: threadSet_def)
+  apply (wpsimp wp: setObject_valid_tcb')
+  done
+
+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>_. valid_tcbs'\<rbrace>"
+  apply (simp add: threadSet_def)
+  apply (rule hoare_seq_ext[OF _ getObject_tcb_sp])
+  apply (wpsimp wp: setObject_tcb_valid_tcbs')
+  apply (clarsimp simp: obj_at'_def projectKOs valid_tcbs'_def)
+  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 valid_arch_tcb'_def tcb_cte_cases_def objBits_simps'
+                    atcbContextSet_def)
+  done
+
 lemma asUser_corres':
   assumes y: "corres_underlying Id False True r \<top> \<top> f g"
-  shows      "corres r (tcb_at t)
-                       (tcb_at' t)
-                       (as_user t f) (asUser t g)"
+  shows "corres r (tcb_at t and pspace_aligned and pspace_distinct) \<top> (as_user t f) (asUser t g)"
   proof -
   note arch_tcb_context_get_def[simp]
   note atcbContextGet_def[simp]
@@ -1375,6 +1573,8 @@ lemma asUser_corres':
     using y
     by (fastforce simp: corres_underlying_def select_f_def split_def Id_def)
   show ?thesis
+  apply (rule_tac Q'="tcb_at' t" in corres_cross_add_guard)
+   apply (fastforce intro!: tcb_at_cross)
   apply (simp add: as_user_def asUser_def)
   apply (rule corres_guard_imp)
     apply (rule_tac r'="\<lambda>tcb con. (arch_tcb_context_get o tcb_arch) tcb = con"
@@ -1426,7 +1626,7 @@ proof -
 qed
 
 lemma asUser_getRegister_corres:
- "corres (=) (tcb_at t) (tcb_at' t)
+ "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
         (as_user t (getRegister r)) (asUser t (getRegister r))"
   apply (rule asUser_corres')
   apply (clarsimp simp: getRegister_def)
@@ -1475,14 +1675,6 @@ lemma asUser_valid_pspace'[wp]:
              | simp add: atcbContextSet_def valid_arch_tcb'_def)+
   done
 
-lemma asUser_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> asUser t m \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: asUser_def split_def)
-  apply (wp hoare_drop_imps | simp)+
-
-  apply (wp threadSet_valid_queues hoare_drop_imps | simp)+
-  done
-
 lemma asUser_ifunsafe'[wp]:
   "\<lbrace>if_unsafe_then_cap'\<rbrace> asUser t m \<lbrace>\<lambda>rv. if_unsafe_then_cap'\<rbrace>"
   apply (simp add: asUser_def split_def)
@@ -1584,17 +1776,15 @@ lemma no_fail_asUser [wp]:
   done
 
 lemma asUser_setRegister_corres:
-  "corres dc (tcb_at t)
-             (tcb_at' t)
-             (as_user t (setRegister r v))
-             (asUser t (setRegister r v))"
+  "corres dc (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+   (as_user t (setRegister r v)) (asUser t (setRegister r v))"
   apply (simp add: setRegister_def)
   apply (rule asUser_corres')
   apply (rule corres_modify'; simp)
   done
 
 lemma getThreadState_corres:
-  "corres thread_state_relation (tcb_at t) (tcb_at' t)
+  "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)
@@ -1625,7 +1815,7 @@ lemma gts_inv'[wp]: "\<lbrace>P\<rbrace> getThreadState t \<lbrace>\<lambda>rv.
   by (simp add: getThreadState_def) wp
 
 lemma getBoundNotification_corres:
-  "corres (=) (tcb_at t) (tcb_at' t)
+  "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
           (get_bound_notification t) (getBoundNotification t)"
   apply (simp add: get_bound_notification_def getBoundNotification_def)
   apply (rule threadGet_corres)
@@ -1698,25 +1888,6 @@ lemma setQueue_nosch[wp]:
 lemma gq_wp[wp]: "\<lbrace>\<lambda>s. Q (ksReadyQueues s (d, p)) s\<rbrace> getQueue d p \<lbrace>Q\<rbrace>"
   by (simp add: getQueue_def, wp)
 
-lemma get_tcb_corres:
-  "corres tcb_relation (tcb_at t) (tcb_at' t) (gets_the (get_tcb t)) (getObject t)"
-  apply (rule corres_no_failI)
-   apply wp
-  apply (clarsimp simp add: gets_def
-                            get_def return_def bind_def get_tcb_def
-                            gets_the_def assert_opt_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
-                     split: option.split_asm)
-  apply (clarsimp simp add: return_def in_magnitude_check objBits_simps
-                            state_relation_def
-                     split: kernel_object.split_asm)
-  apply (frule(1) pspace_relation_absD)
-  apply (clarsimp simp add: other_obj_relation_def)
-  done
-
 lemma no_fail_getQueue [wp]:
   "no_fail \<top> (getQueue d p)"
   by (simp add: getQueue_def)
@@ -1798,19 +1969,22 @@ lemma ethreadget_corres:
   apply (simp add: x)
   done
 
-lemma setQueue_corres:
-  "corres dc \<top> \<top> (set_tcb_queue d p q) (setQueue d p q)"
-  apply (rule corres_no_failI)
-   apply wp
-  apply (clarsimp simp: setQueue_def in_monad set_tcb_queue_def return_def simpler_modify_def)
-  apply (fastforce simp: state_relation_def ready_queues_relation_def)
-  done
-
-
-lemma getQueue_corres: "corres (=) \<top> \<top> (get_tcb_queue qdom prio) (getQueue qdom prio)"
-  apply (clarsimp simp add: getQueue_def state_relation_def ready_queues_relation_def get_tcb_queue_def gets_def)
-  apply (fold gets_def)
-  apply simp
+lemma getQueue_corres:
+  "corres (\<lambda>ls q. (ls = [] \<longleftrightarrow> tcbQueueEmpty q) \<and> (ls \<noteq> [] \<longrightarrow> tcbQueueHead q = Some (hd ls))
+                  \<and> queue_end_valid ls q)
+     \<top> \<top> (get_tcb_queue qdom prio) (getQueue qdom prio)"
+  apply (clarsimp simp: get_tcb_queue_def getQueue_def tcbQueueEmpty_def)
+  apply (rule corres_bind_return2)
+  apply (rule corres_symb_exec_l[OF _ _ gets_sp])
+    apply (rule corres_symb_exec_r[OF _ gets_sp])
+      apply clarsimp
+      apply (drule state_relation_ready_queues_relation)
+      apply (clarsimp simp: ready_queues_relation_def ready_queue_relation_def Let_def
+                            list_queue_relation_def)
+      apply (drule_tac x=qdom in spec)
+      apply (drule_tac x=prio in spec)
+      apply (fastforce dest: heap_path_head)
+     apply wpsimp+
   done
 
 lemma no_fail_return:
@@ -1825,8 +1999,8 @@ lemma addToBitmap_noop_corres:
      (wp | simp add: state_relation_def | rule no_fail_pre)+
 
 lemma addToBitmap_if_null_noop_corres: (* used this way in Haskell code *)
-  "corres dc \<top> \<top> (return ()) (if null queue then addToBitmap d p else return ())"
-  by (cases "null queue", simp_all add: addToBitmap_noop_corres)
+  "corres dc \<top> \<top> (return ()) (if tcbQueueEmpty queue then addToBitmap d p else return ())"
+  by (cases "tcbQueueHead queue", simp_all add: addToBitmap_noop_corres)
 
 lemma removeFromBitmap_corres_noop:
   "corres dc \<top> \<top> (return ()) (removeFromBitmap tdom prioa)"
@@ -1843,54 +2017,701 @@ crunch typ_at'[wp]: removeFromBitmap "\<lambda>s. P (typ_at' T p s)"
 lemmas addToBitmap_typ_ats [wp] = typ_at_lifts [OF addToBitmap_typ_at']
 lemmas removeFromBitmap_typ_ats [wp] = typ_at_lifts [OF removeFromBitmap_typ_at']
 
+lemma ekheap_relation_tcb_domain_priority:
+  "\<lbrakk>ekheap_relation (ekheap s) (ksPSpace s'); ekheap s t = Some (tcb);
+    ksPSpace s' t = Some (KOTCB tcb')\<rbrakk>
+   \<Longrightarrow> tcbDomain tcb' = tcb_domain tcb \<and> tcbPriority tcb' = tcb_priority tcb"
+  apply (clarsimp simp: ekheap_relation_def)
+  apply (drule_tac x=t in bspec, blast)
+  apply (clarsimp simp: other_obj_relation_def etcb_relation_def)
+  done
+
+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
+
+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: obj_at_def obj_at'_def tcb_relation_cut_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
+
+lemma tcbQueued_update_pspace_relation[wp]:
+  fixes s :: det_state
+  shows "threadSet (tcbQueued_update f) tcbPtr \<lbrace>\<lambda>s'. pspace_relation (kheap s) (ksPSpace s')\<rbrace>"
+  by (wpsimp wp: threadSet_pspace_relation simp: tcb_relation_def)
+
+lemma tcbQueued_update_ekheap_relation[wp]:
+  fixes s :: det_state
+  shows
+    "\<lbrace>\<lambda>s'. ekheap_relation (ekheap s) (ksPSpace s') \<and> pspace_relation (kheap s) (ksPSpace s')
+           \<and> valid_etcbs s\<rbrace>
+     threadSet (tcbQueued_update f) tcbPtr
+     \<lbrace>\<lambda>_ s'. ekheap_relation (ekheap s) (ksPSpace s')\<rbrace>"
+  by (wpsimp wp: threadSet_ekheap_relation simp: etcb_relation_def)
+
+lemma tcbQueueRemove_pspace_relation[wp]:
+  fixes s :: det_state
+  shows "tcbQueueRemove queue tcbPtr \<lbrace>\<lambda>s'. pspace_relation (kheap s) (ksPSpace s')\<rbrace>"
+  unfolding tcbQueueRemove_def
+  by (wpsimp wp: threadSet_pspace_relation hoare_drop_imps simp: tcb_relation_def)
+
+lemma tcbQueueRemove_ekheap_relation[wp]:
+  fixes s :: det_state
+  shows
+    "\<lbrace>\<lambda>s'. ekheap_relation (ekheap s) (ksPSpace s') \<and> pspace_relation (kheap s) (ksPSpace s')
+           \<and> valid_etcbs s\<rbrace>
+     tcbQueueRemove queue tcbPtr
+     \<lbrace>\<lambda>_ s'. ekheap_relation (ekheap s) (ksPSpace s')\<rbrace>"
+  unfolding tcbQueueRemove_def
+  by (wpsimp wp: threadSet_ekheap_relation threadSet_pspace_relation hoare_drop_imps
+           simp: tcb_relation_def etcb_relation_def)
+
+lemma threadSet_ghost_relation[wp]:
+  "threadSet f tcbPtr \<lbrace>\<lambda>s'. ghost_relation (kheap s) (gsUserPages s') (gsCNodes s')\<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 projectKOs)
+  done
+
+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)
+
+crunches 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)
+
+crunches 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
+
+crunches 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)
+
+crunches 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 projectKOs[simp]
+  supply fun_upd_apply[simp del]
+  apply (clarsimp simp: ready_queues_relation_def ready_queue_relation_def Let_def)
+  apply (wpsimp wp: threadSet_wp)
+  apply (clarsimp simp: list_queue_relation_def obj_at'_def)
+  apply (rename_tac tcb' d p)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply (clarsimp simp: 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 split: option.splits)
+  done
+
+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>
+   isRunnable tcb_ptr
+   \<lbrace>\<lambda>rv s. \<exists>tcb'. ko_at' tcb' tcb_ptr s
+                  \<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_def)
+  apply (fastforce simp: obj_at'_def split: Structures_H.thread_state.splits)
+  done
+
+crunch (no_fail) no_fail[wp]: isRunnable
+
+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)
+
+crunches 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 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 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_queues_relation_def ready_queue_relation_def Let_def)
+
+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_queues_relation_def ready_queue_relation_def Let_def
+                         inQ_def opt_pred_def
+                  split: option.splits)
+  done
+
 lemma tcbSchedEnqueue_corres:
-  "corres dc (is_etcb_at t) (tcb_at' t and Invariants_H.valid_queues and valid_queues')
-             (tcb_sched_action (tcb_sched_enqueue) t) (tcbSchedEnqueue t)"
-proof -
-  have ready_queues_helper:
-    "\<And>t tcb a b. \<lbrakk> ekheap a t = Some tcb;  obj_at' tcbQueued t b  ;  valid_queues' b  ;
-                   ekheap_relation (ekheap a) (ksPSpace b) \<rbrakk>
-                 \<Longrightarrow> t \<in> set (ksReadyQueues b (tcb_domain tcb, tcb_priority tcb))"
-  unfolding valid_queues'_def
-  by (fastforce dest: ekheap_relation_absD simp: obj_at'_def inQ_def etcb_relation_def projectKO_eq projectKO_tcb)
-
-  show ?thesis unfolding tcbSchedEnqueue_def tcb_sched_action_def
-    apply (rule corres_symb_exec_r [OF _ _ threadGet_inv,
-             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 (rule no_fail_pre, wp, blast)
-    apply (case_tac queued; simp_all)
-     apply (rule corres_no_failI; simp add: no_fail_return)
-     apply (clarsimp simp: in_monad ethread_get_def gets_the_def bind_assoc
-                           assert_opt_def exec_gets is_etcb_at_def get_etcb_def get_tcb_queue_def
-                           set_tcb_queue_def simpler_modify_def ready_queues_relation_def
-                           state_relation_def tcb_sched_enqueue_def)
-     apply (rule ready_queues_helper; auto)
-    apply (clarsimp simp: when_def)
-    apply (rule stronger_corres_guard_imp)
-      apply (rule corres_split[where r'="(=)"])
-         apply (rule ethreadget_corres)
-         apply (simp add: etcb_relation_def)
-        apply (rule corres_split[where r'="(=)"])
-           apply (rule ethreadget_corres)
-           apply (simp add: etcb_relation_def)
-          apply (rule corres_split[where r'="(=)"])
-             apply simp
-             apply (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
-               apply (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 exst_same_def)
-               apply (wp getObject_tcb_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
+  "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]
+         projectKOs[simp]
+  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)
+   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)?)
+
+  \<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)
+
+  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)
+
+  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)
+  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)
+    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 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 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)
+  apply (frule valid_tcbs'_maxPriority[where t=tcbPtr], simp add: obj_at'_def)
+  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)
+  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
+               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 fun_upd_apply split: if_splits)
+   apply (clarsimp simp: fun_upd_apply 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
+           split: if_splits option.splits)
 
 definition
   weak_sch_act_wf :: "scheduler_action \<Rightarrow> kernel_state \<Rightarrow> bool"
@@ -1917,7 +2738,10 @@ lemma getSchedulerAction_corres:
   done
 
 lemma rescheduleRequired_corres:
-  "corres dc (weak_valid_sched_action and valid_etcbs) (Invariants_H.valid_queues and valid_queues' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s))
+  "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)
@@ -1928,15 +2752,14 @@ lemma rescheduleRequired_corres:
          apply (case_tac action)
            apply simp
           apply simp
-          apply (rule tcbSchedEnqueue_corres)
+          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
+   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 simp
-  apply (clarsimp simp: weak_sch_act_wf_def pred_tcb_at' split: scheduler_action.splits)
+  apply (clarsimp split: scheduler_action.splits)
   done
 
 lemma rescheduleRequired_corres_simple:
@@ -2004,20 +2827,18 @@ lemmas addToBitmap_weak_sch_act_wf[wp]
   = weak_sch_act_wf_lift[OF addToBitmap_nosch]
 
 crunch st_tcb_at'[wp]: removeFromBitmap "st_tcb_at' P t"
-crunch pred_tcb_at'[wp]: removeFromBitmap "pred_tcb_at' proj P t"
+crunch pred_tcb_at'[wp]: removeFromBitmap "\<lambda>s. Q (pred_tcb_at' proj P t s)"
 
 crunch not_st_tcb_at'[wp]: removeFromBitmap "\<lambda>s. \<not> (st_tcb_at' P' t) s"
-crunch not_pred_tcb_at'[wp]: removeFromBitmap "\<lambda>s. \<not> (pred_tcb_at' proj P' t) s"
 
 crunch st_tcb_at'[wp]: addToBitmap "st_tcb_at' P' t"
-crunch pred_tcb_at'[wp]: addToBitmap "pred_tcb_at' proj P' t"
+crunch pred_tcb_at'[wp]: addToBitmap "\<lambda>s. Q (pred_tcb_at' proj P t s)"
 
 crunch not_st_tcb_at'[wp]: addToBitmap "\<lambda>s. \<not> (st_tcb_at' P' t) s"
-crunch not_pred_tcb_at'[wp]: addToBitmap "\<lambda>s. \<not> (pred_tcb_at' proj P' t) s"
 
-crunch obj_at'[wp]: removeFromBitmap "obj_at' P t"
+crunch obj_at'[wp]: removeFromBitmap "\<lambda>s. Q (obj_at' P t s)"
 
-crunch obj_at'[wp]: addToBitmap "obj_at' P t"
+crunch obj_at'[wp]: addToBitmap "\<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>"
@@ -2034,9 +2855,11 @@ lemma addToBitmap_tcb_in_cur_domain'[wp]:
   done
 
 lemma tcbSchedDequeue_weak_sch_act_wf[wp]:
-  "\<lbrace> \<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s \<rbrace> tcbSchedDequeue a \<lbrace> \<lambda>_ s. weak_sch_act_wf (ksSchedulerAction s) s \<rbrace>"
-  apply (simp add: tcbSchedDequeue_def)
-  apply (wp threadSet_weak_sch_act_wf removeFromBitmap_weak_sch_act_wf | simp add: crunch_simps)+
+  "tcbSchedDequeue tcbPtr \<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
+  apply (simp add: tcbSchedDequeue_def tcbQueueRemove_def)
+  apply (wp threadSet_weak_sch_act_wf getObject_tcb_wp removeFromBitmap_weak_sch_act_wf
+         | simp add: crunch_simps threadGet_def)+
+  apply (clarsimp simp: obj_at'_def)
   done
 
 lemma dequeue_nothing_eq[simp]:
@@ -2052,44 +2875,344 @@ lemma gets_the_exec: "f s \<noteq> None \<Longrightarrow>  (do x \<leftarrow> ge
                    return_def assert_opt_def)
   done
 
+lemma tcbQueueRemove_no_fail:
+  "no_fail (\<lambda>s. tcb_at' tcbPtr s
+                \<and> (\<exists>ts. list_queue_relation ts queue (tcbSchedNexts_of s) (tcbSchedPrevs_of s)
+                        \<and> tcbPtr \<in> set ts)
+                \<and> sym_heap_sched_pointers s \<and> valid_objs' s)
+           (tcbQueueRemove queue tcbPtr)"
+  supply projectKOs[simp]
+  unfolding tcbQueueRemove_def
+  apply (wpsimp wp: getObject_tcb_wp)
+  apply normalise_obj_at'
+  apply (frule (1) ko_at_valid_objs')
+   apply fastforce
+  apply (clarsimp simp: list_queue_relation_def)
+  apply (prop_tac "tcbQueueHead queue \<noteq> Some tcbPtr \<longrightarrow> tcbSchedPrevs_of s tcbPtr \<noteq> None")
+   apply (rule impI)
+   apply (frule not_head_prev_not_None[where p=tcbPtr])
+      apply (fastforce simp: inQ_def opt_pred_def opt_map_def obj_at'_def)
+     apply (fastforce dest: heap_path_head)
+    apply fastforce
+   apply (fastforce simp: opt_map_def obj_at'_def valid_tcb'_def valid_bound_tcb'_def)
+  by (fastforce dest!: not_last_next_not_None[where p=tcbPtr]
+                 simp: queue_end_valid_def opt_map_def obj_at'_def valid_obj'_def valid_tcb'_def)
+
+crunch (no_fail) no_fail[wp]: removeFromBitmap
+
+crunches removeFromBitmap
+  for ready_queues_relation[wp]: "ready_queues_relation s"
+  and list_queue_relation[wp]:
+   "\<lambda>s'. list_queue_relation ts (P (ksReadyQueues s'))
+                             (tcbSchedNexts_of s') (tcbSchedPrevs_of s')"
+  (simp: bitmap_fun_defs ready_queues_relation_def)
+
+\<comment> \<open>
+  A direct analogue of tcbQueueRemove, used in tcb_sched_dequeue' below, so that within the proof of
+  tcbQueueRemove_corres, we may reason in terms of the list operations used within this function
+  rather than @{term filter}.\<close>
+definition tcb_queue_remove :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
+  "tcb_queue_remove a ls \<equiv>
+     if ls = [a]
+     then []
+     else if a = hd ls
+          then tl ls
+          else if a = last ls
+               then butlast ls
+               else list_remove ls a"
+
+definition tcb_sched_dequeue' :: "obj_ref \<Rightarrow> unit det_ext_monad" where
+  "tcb_sched_dequeue' tcb_ptr \<equiv> do
+     d \<leftarrow> ethread_get tcb_domain tcb_ptr;
+     prio \<leftarrow> ethread_get tcb_priority tcb_ptr;
+     queue \<leftarrow> get_tcb_queue d prio;
+     when (tcb_ptr \<in> set queue) $ set_tcb_queue d prio (tcb_queue_remove tcb_ptr queue)
+   od"
+
+lemma filter_tcb_queue_remove:
+  "\<lbrakk>a \<in> set ls; distinct ls \<rbrakk> \<Longrightarrow> filter ((\<noteq>) a) ls = tcb_queue_remove a ls"
+  apply (clarsimp simp: tcb_queue_remove_def)
+  apply (intro conjI impI)
+     apply (fastforce elim: filter_hd_equals_tl)
+    apply (fastforce elim: filter_last_equals_butlast)
+   apply (fastforce elim: filter_hd_equals_tl)
+  apply (frule split_list)
+  apply (clarsimp simp: list_remove_middle_distinct)
+  apply (subst filter_True | clarsimp simp: list_remove_none)+
+  done
+
+lemma tcb_sched_dequeue_monadic_rewrite:
+  "monadic_rewrite False True (is_etcb_at t and (\<lambda>s. \<forall>d p. distinct (ready_queues s d p)))
+     (tcb_sched_action tcb_sched_dequeue t) (tcb_sched_dequeue' t)"
+  supply if_split[split del]
+  apply (clarsimp simp: tcb_sched_dequeue'_def tcb_sched_dequeue_def tcb_sched_action_def
+                        set_tcb_queue_def)
+  apply (rule monadic_rewrite_bind_tail)+
+     apply (clarsimp simp: when_def)
+     apply (rule monadic_rewrite_if_r)
+      apply (rule_tac P="\<lambda>_. distinct queue" in monadic_rewrite_guard_arg_cong)
+      apply (frule (1) filter_tcb_queue_remove)
+      apply (metis (mono_tags, lifting) filter_cong)
+     apply (rule monadic_rewrite_modify_noop)
+    apply (wpsimp wp: thread_get_wp)+
+  apply (clarsimp simp: etcb_at_def split: option.splits)
+  apply (prop_tac "(\<lambda>d' p. if d' = tcb_domain x2 \<and> p = tcb_priority x2
+                           then filter (\<lambda>x. x \<noteq> t) (ready_queues s (tcb_domain x2) (tcb_priority x2))
+                           else ready_queues s d' p)
+                   = ready_queues s")
+   apply (subst filter_True)
+    apply fastforce
+   apply (clarsimp intro!: ext split: if_splits)
+  apply fastforce
+  done
+
+crunches removeFromBitmap
+  for ksReadyQueues[wp]: "\<lambda>s. P (ksReadyQueues s)"
+
+lemma list_queue_relation_neighbour_in_set:
+  "\<lbrakk>list_queue_relation ls q hp hp'; sym_heap hp hp'; p \<in> set ls\<rbrakk>
+   \<Longrightarrow> \<forall>nbr. (hp p = Some nbr \<longrightarrow> nbr \<in> set ls) \<and> (hp' p = Some nbr \<longrightarrow> nbr \<in> set ls)"
+  apply (rule heap_ls_neighbour_in_set)
+     apply (fastforce simp: list_queue_relation_def)
+    apply fastforce
+   apply (clarsimp simp: list_queue_relation_def prev_queue_head_def)
+  apply fastforce
+  done
+
+lemma in_queue_not_head_or_not_tail_length_gt_1:
+  "\<lbrakk>tcbPtr \<in> set ls; tcbQueueHead q \<noteq> Some tcbPtr \<or> tcbQueueEnd q \<noteq> Some tcbPtr;
+    list_queue_relation ls q nexts prevs\<rbrakk>
+   \<Longrightarrow> Suc 0 < length ls"
+  apply (clarsimp simp: list_queue_relation_def)
+  apply (cases ls; fastforce simp: queue_end_valid_def)
+  done
+
 lemma tcbSchedDequeue_corres:
-  "corres dc (is_etcb_at t) (tcb_at' t and Invariants_H.valid_queues)
-             (tcb_sched_action tcb_sched_dequeue t) (tcbSchedDequeue t)"
-  apply (simp only: tcbSchedDequeue_def tcb_sched_action_def)
-  apply (rule corres_symb_exec_r[OF _ _ threadGet_inv, where Q'="\<lambda>rv. tcb_at' t and Invariants_H.valid_queues and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"])
-    defer
-    apply (wp threadGet_obj_at', simp, simp)
-   apply (rule no_fail_pre, wp, simp)
-  apply (case_tac queued)
-   defer
-   apply (simp add: when_def)
-   apply (rule corres_no_failI)
-    apply (wp)
-   apply (clarsimp simp: in_monad ethread_get_def set_tcb_queue_def is_etcb_at_def state_relation_def)
-   apply (subgoal_tac "t \<notin> set (ready_queues a (tcb_domain y) (tcb_priority y))")
-    prefer 2
-    subgoal by (force simp: tcb_sched_dequeue_def Invariants_H.valid_queues_def valid_queues_no_bitmap_def
-                            ready_queues_relation_def obj_at'_def inQ_def projectKO_eq project_inject)
-   apply (subst gets_the_exec)
-    apply (simp add: get_etcb_def)
-   apply (subst gets_the_exec)
-    apply (simp add: get_etcb_def)
-   apply (simp add: exec_gets simpler_modify_def get_etcb_def ready_queues_relation_def cong: if_cong get_tcb_queue_def)
-  apply (simp add: when_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[where r'="(=)"])
-       apply (rule ethreadget_corres, simp add: etcb_relation_def)
-      apply (rule corres_split[where r'="(=)"])
-         apply (rule ethreadget_corres, simp add: etcb_relation_def)
-        apply (rule corres_split[where r'="(=)"])
-           apply (simp, rule getQueue_corres)
-          apply (rule corres_split_noop_rhs2)
-             apply (simp add: tcb_sched_dequeue_def)
-             apply (rule setQueue_corres)
-            apply (rule corres_split_noop_rhs)
-              apply (clarsimp, rule removeFromBitmap_corres_noop)
-             apply (rule threadSet_corres_noop; simp_all add: tcb_relation_def exst_same_def)
-            apply (wp | simp)+
+  "tcb_ptr = tcbPtr \<Longrightarrow>
+   corres dc
+     (in_correct_ready_q and ready_qs_distinct and valid_etcbs and tcb_at tcb_ptr
+      and pspace_aligned and pspace_distinct)
+     (sym_heap_sched_pointers and valid_objs')
+     (tcb_sched_action tcb_sched_dequeue tcb_ptr) (tcbSchedDequeue tcbPtr)"
+  supply heap_path_append[simp del] fun_upd_apply[simp del] distinct_append[simp del]
+         list_remove_append[simp del]
+         projectKOs[simp]
+  apply (rule_tac Q'="tcb_at' tcbPtr" in corres_cross_add_guard)
+   apply (fastforce intro!: tcb_at_cross simp: obj_at_def is_tcb_def)
+  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 monadic_rewrite_corres_l[where P=P and Q=P for P, simplified])
+   apply (rule monadic_rewrite_guard_imp[OF tcb_sched_dequeue_monadic_rewrite])
+   apply (fastforce dest: tcb_at_is_etcb_at simp: in_correct_ready_q_def ready_qs_distinct_def)
+  apply (clarsimp simp: tcb_sched_dequeue'_def get_tcb_queue_def tcbSchedDequeue_def  getQueue_def
+                        unless_def when_def)
+  apply (rule corres_symb_exec_l[OF _ _ ethread_get_sp]; wpsimp?)
+  apply (rename_tac dom)
+  apply (rule corres_symb_exec_l[OF _ _ ethread_get_sp]; wpsimp?)
+  apply (rename_tac prio)
+  apply (rule corres_symb_exec_l[OF _ _ gets_sp]; (solves wpsimp)?)
+  apply (rule corres_stateAssert_ignore)
+   apply (fastforce intro: ksReadyQueues_asrt_cross)
+  apply (rule corres_symb_exec_r[OF _ threadGet_sp]; (solves wpsimp)?)
+  apply (rule corres_if_strong'; fastforce?)
+    apply (frule state_relation_ready_queues_relation)
+    apply (frule in_ready_q_tcbQueued_eq[where t=tcbPtr])
+    apply (fastforce simp: obj_at'_def opt_pred_def opt_map_def obj_at_def is_tcb_def
+                           in_correct_ready_q_def etcb_at_def is_etcb_at_def)
+  apply (rule corres_symb_exec_r[OF _ threadGet_sp]; wpsimp?)
+  apply (rule corres_symb_exec_r[OF _ threadGet_sp]; wpsimp?)
+  apply (rule corres_symb_exec_r[OF _ gets_sp]; wpsimp?)
+  apply (rule corres_from_valid_det)
+    apply (fastforce intro: det_wp_modify det_wp_pre simp: set_tcb_queue_def)
+   apply (wpsimp wp: tcbQueueRemove_no_fail)
+   apply (fastforce dest: state_relation_ready_queues_relation
+                    simp: ex_abs_underlying_def ready_queues_relation_def ready_queue_relation_def
+                          Let_def inQ_def opt_pred_def opt_map_def obj_at'_def)
+  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 tcbQueueRemove_def
+         split_del: if_split)
+  apply (frule (1) tcb_at_is_etcb_at)
+  apply (clarsimp simp: obj_at_def is_etcb_at_def etcb_at_def)
+  apply normalise_obj_at'
+  apply (rename_tac s d p s' tcb' tcb etcb)
+  apply (frule_tac t=tcbPtr in ekheap_relation_tcb_domain_priority)
+    apply (force simp: obj_at_def)
+   apply (force simp: obj_at'_def)
+
+  apply (case_tac "d \<noteq> tcb_domain etcb \<or> p \<noteq> tcb_priority etcb")
+   apply clarsimp
+   apply (cut_tac p=tcbPtr and ls="ready_queues s (tcb_domain etcb) (tcb_priority etcb)"
+               in list_queue_relation_neighbour_in_set)
+      apply (fastforce dest!: spec)
+     apply fastforce
+    apply fastforce
+   apply (cut_tac xs="ready_queues s d p" in heap_path_head')
+    apply (force dest!: spec simp: ready_queues_relation_def Let_def list_queue_relation_def)
+   apply (cut_tac d=d and d'="tcb_domain etcb" and p=p and p'="tcb_priority etcb"
+               in ready_queues_disjoint)
+      apply force
+     apply fastforce
+    apply fastforce
+   apply (cut_tac ts="ready_queues s d p" in list_queue_relation_nil)
+    apply fast
+   apply (clarsimp simp: tcbQueueEmpty_def)
+   apply (prop_tac "Some tcbPtr \<noteq> tcbQueueHead (ksReadyQueues s' (d, p))")
+    apply (metis hd_in_set not_emptyI option.sel option.simps(2))
+   apply (prop_tac "tcbPtr \<notin> set (ready_queues s d p)")
+    apply blast
+   apply (clarsimp simp: list_queue_relation_def)
+   apply (intro conjI; clarsimp)
+
+    \<comment> \<open>the ready queue is the singleton consisting of tcbPtr\<close>
+    apply (intro conjI)
+         apply (force intro!: heap_path_heap_upd_not_in simp: fun_upd_apply)
+        apply (clarsimp simp: queue_end_valid_def fun_upd_apply)
+       apply (force simp: prev_queue_head_heap_upd fun_upd_apply)
+      apply (clarsimp simp: inQ_def in_opt_pred fun_upd_apply)
+     apply (clarsimp simp: fun_upd_apply)
+    apply (clarsimp simp: fun_upd_apply)
+
+   apply (clarsimp simp: etcb_at_def obj_at'_def)
+   apply (intro conjI; clarsimp)
+
+    \<comment> \<open>tcbPtr is the head of the ready queue\<close>
+    apply (intro conjI)
+         apply (intro heap_path_heap_upd_not_in)
+           apply (force simp: fun_upd_apply)
+          apply (force simp: not_emptyI opt_map_red)
+         apply assumption
+        apply (clarsimp simp: queue_end_valid_def fun_upd_apply)
+       apply (clarsimp simp: prev_queue_head_def fun_upd_apply)
+      apply (clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply split: option.splits)
+     apply (clarsimp simp: fun_upd_apply)
+    apply (clarsimp simp: fun_upd_apply)
+   apply (intro conjI; clarsimp)
+
+    \<comment> \<open>tcbPtr is the end of the ready queue\<close>
+    apply (intro conjI)
+         apply (intro heap_path_heap_upd_not_in)
+           apply (simp add: fun_upd_apply split: if_splits)
+          apply (force simp: not_emptyI opt_map_red)
+         apply (clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply split: option.splits)
+        apply (clarsimp simp: queue_end_valid_def fun_upd_apply)
+       apply (force simp: prev_queue_head_def fun_upd_apply opt_map_red opt_map_upd_triv)
+      apply (clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply split: option.splits)
+     apply (clarsimp simp: fun_upd_apply)
+    apply (clarsimp simp: fun_upd_apply)
+
+   \<comment> \<open>tcbPtr is in the middle of the ready queue\<close>
+   apply (intro conjI)
+     apply (intro heap_path_heap_upd_not_in)
+        apply (simp add: fun_upd_apply)
+       apply (force simp: not_emptyI opt_map_red)
+      apply (force simp: not_emptyI opt_map_red)
+     apply fastforce
+    apply (clarsimp simp: opt_map_red opt_map_upd_triv)
+    apply (intro prev_queue_head_heap_upd)
+      apply (force dest!: spec)
+     apply (metis hd_in_set not_emptyI option.sel option.simps(2))
+    apply fastforce
+   subgoal
+     by (clarsimp simp: inQ_def opt_map_def opt_pred_def fun_upd_apply
+                 split: if_splits option.splits)
+
+  \<comment> \<open>d = tcb_domain tcb \<and> p = tcb_priority tcb\<close>
+  apply clarsimp
+  apply (drule_tac x="tcb_domain etcb" in spec)
+  apply (drule_tac x="tcb_priority etcb" in spec)
+  apply (clarsimp simp: list_queue_relation_def)
+  apply (frule heap_path_head')
+  apply (frule heap_ls_distinct)
+  apply (intro conjI; clarsimp simp: tcbQueueEmpty_def)
+
+   \<comment> \<open>the ready queue is the singleton consisting of tcbPtr\<close>
+   apply (intro conjI)
+      apply (simp add: fun_upd_apply tcb_queue_remove_def queue_end_valid_def heap_ls_unique
+                       heap_path_last_end)
+     apply (simp add: fun_upd_apply tcb_queue_remove_def queue_end_valid_def heap_ls_unique
+                      heap_path_last_end)
+    apply (simp add: fun_upd_apply prev_queue_head_def)
+   apply (case_tac "ready_queues s (tcb_domain etcb) (tcb_priority etcb)";
+          clarsimp simp: tcb_queue_remove_def inQ_def opt_pred_def fun_upd_apply)
+  apply (intro conjI; clarsimp)
+
+   \<comment> \<open>tcbPtr is the head of the ready queue\<close>
+   apply (frule set_list_mem_nonempty)
+   apply (frule in_queue_not_head_or_not_tail_length_gt_1)
+     apply fastforce
+    apply (fastforce simp: list_queue_relation_def)
+   apply (frule list_not_head)
+   apply (clarsimp simp: tcb_queue_remove_def)
+   apply (frule length_tail_nonempty)
+   apply (frule (2) heap_ls_next_of_hd)
+   apply (clarsimp simp: obj_at'_def)
+   apply (intro conjI impI allI)
+      apply (drule (1) heap_ls_remove_head_not_singleton)
+      apply (clarsimp simp: opt_map_red opt_map_upd_triv fun_upd_apply)
+     apply (clarsimp simp: queue_end_valid_def fun_upd_apply last_tl)
+    apply (clarsimp simp: prev_queue_head_def fun_upd_apply)
+   apply (case_tac "ready_queues s (tcb_domain etcb) (tcb_priority etcb)";
+          clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply split: option.splits)
+  apply (intro conjI; clarsimp)
+
+   \<comment> \<open>tcbPtr is the end of the ready queue\<close>
+   apply (frule set_list_mem_nonempty)
+   apply (frule in_queue_not_head_or_not_tail_length_gt_1)
+     apply fast
+    apply (force dest!: spec simp: list_queue_relation_def)
+   apply (clarsimp simp: queue_end_valid_def)
+   apply (frule list_not_last)
+   apply (clarsimp simp: tcb_queue_remove_def)
+   apply (frule length_gt_1_imp_butlast_nonempty)
+   apply (frule (3) heap_ls_prev_of_last)
+   apply (clarsimp simp: obj_at'_def)
+   apply (intro conjI impI; clarsimp?)
+      apply (drule (1) heap_ls_remove_last_not_singleton)
+      apply (force elim!: rsubst3[where P=heap_ls] simp: opt_map_def fun_upd_apply)
+     apply (clarsimp simp: opt_map_def fun_upd_apply)
+    apply (clarsimp simp: prev_queue_head_def fun_upd_apply opt_map_def)
+   apply (clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply split: option.splits)
+   apply (meson distinct_in_butlast_not_last in_set_butlastD last_in_set not_last_in_set_butlast)
+
+  \<comment> \<open>tcbPtr is in the middle of the ready queue\<close>
+  apply (clarsimp simp: obj_at'_def)
+  apply (frule set_list_mem_nonempty)
+  apply (frule split_list)
+  apply clarsimp
+  apply (rename_tac xs ys)
+  apply (prop_tac "xs \<noteq> [] \<and> ys \<noteq> []", fastforce simp: queue_end_valid_def)
+  apply clarsimp
+  apply (frule (2) ptr_in_middle_prev_next)
+   apply fastforce
+  apply (clarsimp simp: tcb_queue_remove_def)
+  apply (prop_tac "tcbPtr \<noteq> last xs")
+   apply (clarsimp simp: distinct_append)
+  apply (prop_tac "tcbPtr \<noteq> hd ys")
+   apply (fastforce dest: hd_in_set simp: distinct_append)
+  apply (prop_tac "last xs \<noteq> hd ys")
+   apply (metis distinct_decompose2 hd_Cons_tl last_in_set)
+  apply (prop_tac "list_remove (xs @ tcbPtr # ys) tcbPtr = xs @ ys")
+   apply (simp add: list_remove_middle_distinct del: list_remove_append)
+  apply (intro conjI impI allI; (solves \<open>clarsimp simp: distinct_append\<close>)?)
+     apply (fastforce elim!: rsubst3[where P=heap_ls]
+                      dest!: heap_ls_remove_middle hd_in_set last_in_set
+                       simp: distinct_append not_emptyI opt_map_def fun_upd_apply)
+    apply (clarsimp simp: queue_end_valid_def fun_upd_apply)
+   apply (case_tac xs;
+          fastforce simp: prev_queue_head_def opt_map_def fun_upd_apply distinct_append)
+  apply (clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply distinct_append
+                 split: option.splits)
   done
 
 lemma thread_get_test: "do cur_ts \<leftarrow> get_thread_state cur; g (test cur_ts) od =
@@ -2097,7 +3220,9 @@ lemma thread_get_test: "do cur_ts \<leftarrow> get_thread_state cur; g (test cur
   apply (simp add: get_thread_state_def thread_get_def)
   done
 
-lemma thread_get_isRunnable_corres: "corres (=) (tcb_at t) (tcb_at' t) (thread_get (\<lambda>tcb. runnable (tcb_state tcb)) t) (isRunnable t)"
+lemma thread_get_isRunnable_corres:
+  "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+              (thread_get (\<lambda>tcb. runnable (tcb_state tcb)) t) (isRunnable t)"
   apply (simp add:  isRunnable_def getThreadState_def threadGet_def
                    thread_get_def)
   apply (fold liftM_def)
@@ -2111,8 +3236,8 @@ lemma thread_get_isRunnable_corres: "corres (=) (tcb_at t) (tcb_at' t) (thread_g
 lemma setThreadState_corres:
   "thread_state_relation ts ts' \<Longrightarrow>
    corres dc
-          (tcb_at t)
-          (tcb_at' t)
+          (tcb_at t and pspace_aligned and pspace_distinct)
+          \<top>
           (set_thread_state t ts) (setThreadState ts' t)"
   (is "?tsr \<Longrightarrow> corres dc ?Pre ?Pre' ?sts ?sts'")
   apply (simp add: set_thread_state_def setThreadState_def)
@@ -2136,8 +3261,8 @@ lemma setThreadState_corres:
 
 lemma setBoundNotification_corres:
   "corres dc
-          (tcb_at t)
-          (tcb_at' t)
+          (tcb_at t and pspace_aligned and pspace_distinct)
+          \<top>
           (set_bound_notification t ntfn) (setBoundNotification ntfn t)"
   apply (simp add: set_bound_notification_def setBoundNotification_def)
   apply (subst thread_set_def[simplified, symmetric])
@@ -2147,29 +3272,84 @@ lemma setBoundNotification_corres:
 crunches rescheduleRequired, tcbSchedDequeue, setThreadState, setBoundNotification
   for tcb'[wp]: "tcb_at' addr"
 
+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
+
+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
+
+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)
+
+crunches addToBitmap
+  for valid_objs'[wp]: valid_objs'
+  (simp: unless_def crunch_simps wp: crunch_wps)
+
+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
+
 crunches rescheduleRequired, removeFromBitmap
   for valid_objs'[wp]: valid_objs'
   (simp: crunch_simps)
 
-lemma tcbSchedDequeue_valid_objs' [wp]: "\<lbrace> valid_objs' \<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>_. valid_objs' \<rbrace>"
-  unfolding tcbSchedDequeue_def
-  apply (wp threadSet_valid_objs')
-        apply (clarsimp simp add: valid_tcb'_def tcb_cte_cases_def)
-        apply wp
-       apply (simp add: if_apply_def2)
-       apply (wp hoare_drop_imps)
-       apply (wp | simp cong: if_cong add: valid_tcb'_def tcb_cte_cases_def if_apply_def2)+
+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]
+
+lemma tcbQueueRemove_valid_objs'[wp]:
+  "tcbQueueRemove queue tcbPtr \<lbrace>valid_objs'\<rbrace>"
+  unfolding tcbQueueRemove_def
+  apply (wpsimp wp: getObject_tcb_wp)
+  apply normalise_obj_at'
+  apply (fastforce dest!: tcb_ko_at_valid_objs_valid_tcb'
+                    simp: valid_tcb'_def valid_bound_tcb'_def obj_at'_def)
   done
 
+lemma tcbSchedDequeue_valid_objs'[wp]:
+  "tcbSchedDequeue t \<lbrace>valid_objs'\<rbrace>"
+  unfolding tcbSchedDequeue_def setQueue_def
+  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>"
-  apply (simp add: setThreadState_def setQueue_def isRunnable_def isStopped_def)
-  apply (wp threadSet_valid_objs')
-     apply (simp add: valid_tcb'_def tcb_cte_cases_def)
-     apply (wp threadSet_valid_objs' | simp)+
-  apply (clarsimp simp: valid_tcb'_def tcb_cte_cases_def)
+  "\<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')
+   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':
@@ -2255,18 +3435,6 @@ lemma setQueue_valid_bitmapQ_except[wp]:
   unfolding setQueue_def bitmapQ_defs
   by (wp, clarsimp simp: bitmapQ_def)
 
-lemma setQueue_valid_bitmapQ: (* enqueue only *)
-  "\<lbrace> valid_bitmapQ and (\<lambda>s. (ksReadyQueues s (d, p) = []) = (ts = [])) \<rbrace>
-  setQueue d p ts
-  \<lbrace>\<lambda>_. valid_bitmapQ \<rbrace>"
-  unfolding setQueue_def bitmapQ_defs
-  by (wp, clarsimp simp: bitmapQ_def)
-
-lemma setQueue_valid_queues':
-  "\<lbrace>valid_queues' and (\<lambda>s. \<forall>t. obj_at' (inQ d p) t s \<longrightarrow> t \<in> set ts)\<rbrace>
-    setQueue d p ts \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  by (wp | simp add: valid_queues'_def setQueue_def)+
-
 lemma setQueue_cur:
   "\<lbrace>\<lambda>s. cur_tcb' s\<rbrace> setQueue d p ts \<lbrace>\<lambda>rv s. cur_tcb' s\<rbrace>"
   unfolding setQueue_def cur_tcb'_def
@@ -2404,9 +3572,17 @@ lemma threadSet_queued_sch_act_wf[wp]:
   apply (wp tcb_in_cur_domain'_lift | simp add: obj_at'_def)+
   done
 
+lemma tcbSchedNext_update_pred_tcb_at'[wp]:
+  "threadSet (tcbSchedNext_update f) t \<lbrace>\<lambda>s. P (pred_tcb_at' proj P' t' s)\<rbrace>"
+  by (wp threadSet_pred_tcb_no_state crunch_wps | clarsimp simp: tcb_to_itcb'_def)+
+
+lemma tcbSchedPrev_update_pred_tcb_at'[wp]:
+  "threadSet (tcbSchedPrev_update f) t \<lbrace>\<lambda>s. P (pred_tcb_at' proj P' t' s)\<rbrace>"
+  by (wp threadSet_pred_tcb_no_state crunch_wps | clarsimp simp: tcb_to_itcb'_def)+
+
 lemma tcbSchedEnqueue_pred_tcb_at'[wp]:
   "\<lbrace>\<lambda>s. pred_tcb_at' proj P' t' s \<rbrace> tcbSchedEnqueue t \<lbrace>\<lambda>_ s. pred_tcb_at' proj P' t' s\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def when_def unless_def)
+  apply (simp add: tcbSchedEnqueue_def tcbQueuePrepend_def when_def unless_def)
   apply (wp threadSet_pred_tcb_no_state crunch_wps | clarsimp simp: tcb_to_itcb'_def)+
   done
 
@@ -2414,8 +3590,9 @@ lemma tcbSchedDequeue_sch_act_wf[wp]:
   "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>
     tcbSchedDequeue t
    \<lbrace>\<lambda>_ s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  unfolding tcbSchedDequeue_def
-  by (wp setQueue_sch_act | wp sch_act_wf_lift | simp add: if_apply_def2)+
+  unfolding tcbSchedDequeue_def tcbQueueRemove_def
+  by (wp setQueue_sch_act threadSet_tcbDomain_triv hoare_drop_imps
+      | wp sch_act_wf_lift | simp add: if_apply_def2)+
 
 crunch nosch: tcbSchedDequeue "\<lambda>s. P (ksSchedulerAction s)"
 
@@ -2511,21 +3688,22 @@ lemma tcbSchedEnqueue_sch_act[wp]:
   "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>
     tcbSchedEnqueue t
    \<lbrace>\<lambda>_ s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  by (simp add: tcbSchedEnqueue_def unless_def)
-     (wp setQueue_sch_act | wp sch_act_wf_lift  | clarsimp)+
+  by (simp add: tcbSchedEnqueue_def tcbQueuePrepend_def unless_def)
+     (wp setQueue_sch_act threadSet_tcbDomain_triv | wp sch_act_wf_lift  | clarsimp)+
 
 lemma tcbSchedEnqueue_weak_sch_act[wp]:
   "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
     tcbSchedEnqueue t
    \<lbrace>\<lambda>_ s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
+  apply (simp add: tcbSchedEnqueue_def tcbQueuePrepend_def unless_def)
   apply (wp setQueue_sch_act threadSet_weak_sch_act_wf | clarsimp)+
   done
 
-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>"
+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
+  apply (clarsimp simp: obj_at'_def)
   done
 
 lemma threadGet_const:
@@ -2535,6 +3713,11 @@ lemma threadGet_const:
   apply (clarsimp simp: obj_at'_def)
   done
 
+lemma archThreadGet_wp:
+  "\<lbrace>\<lambda>s. \<forall>tcb. ko_at' tcb t s \<longrightarrow> Q (f (tcbArch tcb)) s\<rbrace> archThreadGet f t \<lbrace>Q\<rbrace>"
+  unfolding archThreadGet_def
+  by (wpsimp wp: getObject_tcb_wp simp: obj_at'_def)
+
 schematic_goal l2BitmapSize_def': (* arch specific consequence *)
   "l2BitmapSize = numeral ?X"
   by (simp add: l2BitmapSize_def wordBits_def word_size numPriorities_def)
@@ -2572,14 +3755,6 @@ lemma addToBitmap_bitmapQ:
   by (wpsimp simp: bitmap_fun_defs bitmapQ_def prioToL1Index_bit_set prioL2Index_bit_set
              simp_del: bit_exp_iff)
 
-lemma addToBitmap_valid_queues_no_bitmap_except:
-" \<lbrace> valid_queues_no_bitmap_except t \<rbrace>
-     addToBitmap d p
-  \<lbrace>\<lambda>_. valid_queues_no_bitmap_except t \<rbrace>"
-  unfolding addToBitmap_def modifyReadyQueuesL1Bitmap_def modifyReadyQueuesL2Bitmap_def
-             getReadyQueuesL1Bitmap_def getReadyQueuesL2Bitmap_def valid_queues_no_bitmap_except_def
-  by (wp, clarsimp)
-
 crunch norq[wp]: addToBitmap "\<lambda>s. P (ksReadyQueues s)"
   (wp: updateObject_cte_inv hoare_drop_imps)
 crunch norq[wp]: removeFromBitmap "\<lambda>s. P (ksReadyQueues s)"
@@ -2611,9 +3786,8 @@ lemma prioToL1Index_complement_nth_w2p:
 
 lemma valid_bitmapQ_exceptE:
   "\<lbrakk> valid_bitmapQ_except d' p' s ; d \<noteq> d' \<or> p \<noteq> p' \<rbrakk>
-   \<Longrightarrow> bitmapQ d p s = (ksReadyQueues s (d, p) \<noteq> [])"
-   unfolding valid_bitmapQ_except_def
-   by blast
+   \<Longrightarrow> bitmapQ d p s = (\<not> tcbQueueEmpty (ksReadyQueues s (d, p)))"
+  by (fastforce simp: valid_bitmapQ_except_def)
 
 lemma invertL1Index_eq_cancelD:
   "\<lbrakk>  invertL1Index i = invertL1Index j ; i < l2BitmapSize ; j < l2BitmapSize \<rbrakk>
@@ -2727,22 +3901,15 @@ lemma addToBitmap_valid_bitmapQ_except:
   done
 
 lemma addToBitmap_valid_bitmapQ:
-" \<lbrace> valid_bitmapQ_except d p and bitmapQ_no_L2_orphans and
-    (\<lambda>s. ksReadyQueues s (d,p) \<noteq> []) \<rbrace>
-     addToBitmap d p
-  \<lbrace>\<lambda>_. valid_bitmapQ \<rbrace>"
-proof -
-  have "\<lbrace> valid_bitmapQ_except d p and bitmapQ_no_L2_orphans and
-            (\<lambda>s. ksReadyQueues s (d,p) \<noteq> []) \<rbrace>
-         addToBitmap d p
-         \<lbrace>\<lambda>_. valid_bitmapQ_except d p and
-              bitmapQ_no_L2_orphans and (\<lambda>s. bitmapQ d p s \<and> ksReadyQueues s (d,p) \<noteq> []) \<rbrace>"
-  by (wp addToBitmap_valid_queues_no_bitmap_except addToBitmap_valid_bitmapQ_except
-            addToBitmap_bitmapQ_no_L2_orphans addToBitmap_bitmapQ; simp)
-
-  thus ?thesis
-    by - (erule hoare_strengthen_post; fastforce elim: valid_bitmap_valid_bitmapQ_exceptE)
-qed
+  "\<lbrace>valid_bitmapQ_except d p and bitmapQ_no_L2_orphans
+    and (\<lambda>s. \<not> tcbQueueEmpty (ksReadyQueues s (d,p)))\<rbrace>
+   addToBitmap d p
+   \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
+  (is "\<lbrace>?pre\<rbrace> _ \<lbrace>_\<rbrace>")
+  apply (rule_tac Q="\<lambda>_ s. ?pre s \<and> bitmapQ d p s" in hoare_strengthen_post)
+   apply (wpsimp wp: addToBitmap_valid_bitmapQ_except addToBitmap_bitmapQ)
+  apply (fastforce elim: valid_bitmap_valid_bitmapQ_exceptE)
+  done
 
 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>"
@@ -2760,12 +3927,6 @@ lemma threadGet_const_tcb_at_imp_lift:
   apply (clarsimp simp: obj_at'_def)
   done
 
-lemma valid_queues_no_bitmap_objD:
-  "\<lbrakk> valid_queues_no_bitmap s; t \<in> set (ksReadyQueues s (d, p))\<rbrakk>
-   \<Longrightarrow> obj_at' (inQ d p and runnable' \<circ> tcbState) t s"
-   unfolding valid_queues_no_bitmap_def
-   by blast
-
 lemma setQueue_bitmapQ_no_L1_orphans[wp]:
   "\<lbrace> bitmapQ_no_L1_orphans \<rbrace>
        setQueue d p ts
@@ -2785,126 +3946,6 @@ lemma setQueue_sets_queue[wp]:
   unfolding setQueue_def
   by (wp, simp)
 
-lemma tcbSchedEnqueueOrAppend_valid_queues:
-  (* f is either (t#ts) or (ts @ [t]), so we define its properties generally *)
-  assumes f_set[simp]: "\<And>ts. t \<in> set (f ts)"
-  assumes f_set_insert[simp]: "\<And>ts. set (f ts) = insert t (set ts)"
-  assumes f_not_empty[simp]: "\<And>ts. f ts \<noteq> []"
-  assumes f_distinct: "\<And>ts. \<lbrakk> distinct ts ; t \<notin> set ts \<rbrakk> \<Longrightarrow> distinct (f ts)"
-  shows "\<lbrace>Invariants_H.valid_queues and st_tcb_at' runnable' t and valid_objs' \<rbrace>
-    do queued \<leftarrow> threadGet tcbQueued t;
-       unless queued $
-       do tdom \<leftarrow> threadGet tcbDomain t;
-          prio \<leftarrow> threadGet tcbPriority t;
-          queue \<leftarrow> getQueue tdom prio;
-          setQueue tdom prio $ f queue;
-          when (null queue) $ addToBitmap tdom prio;
-          threadSet (tcbQueued_update (\<lambda>_. True)) t
-       od
-    od
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-proof -
-
-  define could_run where "could_run ==
-    \<lambda>d p t. obj_at' (\<lambda>tcb. inQ d p (tcbQueued_update (\<lambda>_. True) tcb) \<and> runnable' (tcbState tcb)) t"
-
-  have addToBitmap_could_run:
-  "\<And>d p. \<lbrace>\<lambda>s. \<forall>d p. t \<in> set (ksReadyQueues s (d, p)) \<longrightarrow> could_run d p t s\<rbrace>
-         addToBitmap d p
-         \<lbrace>\<lambda>_ s. \<forall>d p. t \<in> set (ksReadyQueues s (d, p)) \<longrightarrow> could_run d p t s\<rbrace>"
-    unfolding bitmap_fun_defs
-    by (wp, clarsimp simp: could_run_def)
-
-  have setQueue_valid_queues_no_bitmap_except:
-    "\<And>d p ts.
-     \<lbrace> valid_queues_no_bitmap_except t and
-       (\<lambda>s. ksReadyQueues s (d, p) = ts \<and> p \<le> maxPriority \<and> d \<le> maxDomain \<and> t \<notin> set ts) \<rbrace>
-         setQueue d p (f ts)
-     \<lbrace>\<lambda>rv. valid_queues_no_bitmap_except t\<rbrace>"
-    unfolding setQueue_def valid_queues_no_bitmap_except_def null_def
-    by (wp, auto intro: f_distinct)
-
-  have threadSet_valid_queues_could_run:
-   "\<And>f. \<lbrace> valid_queues_no_bitmap_except t and
-          (\<lambda>s. \<forall>d p. t \<in> set (ksReadyQueues s (d,p)) \<longrightarrow> could_run d p t s) and
-          valid_bitmapQ and bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans \<rbrace>
-            threadSet (tcbQueued_update (\<lambda>_. True)) t
-         \<lbrace>\<lambda>rv. Invariants_H.valid_queues \<rbrace>"
-    unfolding threadSet_def could_run_def
-    apply (rule hoare_seq_ext[OF _ getObject_tcb_sp])
-    apply (rule hoare_pre)
-     apply (simp add: valid_queues_def valid_queues_no_bitmap_def)
-     apply (wp setObject_queues_unchanged_tcb hoare_Ball_helper hoare_vcg_all_lift
-               setObject_tcb_strongest)
-    apply (clarsimp simp: valid_queues_no_bitmap_except_def obj_at'_def)
-    done
-
-  have setQueue_could_run: "\<And>d p ts.
-    \<lbrace> valid_queues and (\<lambda>_. t \<in> set ts) and
-      (\<lambda>s. could_run d p t s) \<rbrace>
-    setQueue d p ts
-    \<lbrace>\<lambda>rv s. (\<forall>d p. t \<in> set (ksReadyQueues s (d, p)) \<longrightarrow> could_run d p t s)\<rbrace>"
-    unfolding setQueue_def valid_queues_def could_run_def
-    by wp (fastforce dest: valid_queues_no_bitmap_objD simp: obj_at'_def inQ_def)
-
-  note hoare_vcg_if_lift[wp] hoare_vcg_conj_lift[wp] hoare_vcg_const_imp_lift[wp]
-
-  show ?thesis
-  unfolding tcbSchedEnqueue_def null_def
-  apply (rule hoare_pre)
-   apply (rule hoare_seq_ext)
-    apply (simp add: unless_def)
-    apply (wp threadSet_valid_queues_could_run)
-        apply (wp addToBitmap_could_run addToBitmap_valid_bitmapQ
-                  addToBitmap_valid_queues_no_bitmap_except addToBitmap_bitmapQ_no_L2_orphans)+
-       apply (wp setQueue_valid_queues_no_bitmap_except setQueue_could_run
-                 setQueue_valid_bitmapQ_except setQueue_sets_queue setQueue_valid_bitmapQ)+
-      apply (wp threadGet_const_tcb_at_imp_lift | simp add: if_apply_def2)+
-  apply clarsimp
-  apply (frule pred_tcb_at')
-  apply (frule (1) valid_objs'_maxDomain)
-  apply (frule (1) valid_objs'_maxPriority)
-  apply (clarsimp simp: valid_queues_def st_tcb_at'_def obj_at'_def valid_queues_no_bitmap_exceptI)
-  apply (fastforce dest!: valid_queues_no_bitmap_objD simp: obj_at'_def inQ_def could_run_def)
-  done
-qed
-
-lemma tcbSchedEnqueue_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues
-    and st_tcb_at' runnable' t
-    and valid_objs' \<rbrace>
-     tcbSchedEnqueue t
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-   unfolding tcbSchedEnqueue_def
-   by (fastforce intro:  tcbSchedEnqueueOrAppend_valid_queues)
-
-lemma tcbSchedAppend_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues
-    and st_tcb_at' runnable' t
-    and valid_objs' \<rbrace>
-     tcbSchedAppend t
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-   unfolding tcbSchedAppend_def
-   by (fastforce intro:  tcbSchedEnqueueOrAppend_valid_queues)
-
-lemma rescheduleRequired_valid_queues[wp]:
-  "\<lbrace>\<lambda>s. Invariants_H.valid_queues s \<and> valid_objs' s \<and>
-        weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | wpc | simp)+
-  apply (fastforce simp: weak_sch_act_wf_def elim: valid_objs'_maxDomain valid_objs'_maxPriority)
-  done
-
-lemma rescheduleRequired_valid_queues_sch_act_simple:
-  "\<lbrace>Invariants_H.valid_queues and sch_act_simple\<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | wpc | simp | fastforce simp: Invariants_H.valid_queues_def sch_act_simple_def)+
-  done
-
 lemma rescheduleRequired_valid_bitmapQ_sch_act_simple:
   "\<lbrace> valid_bitmapQ and sch_act_simple\<rbrace>
     rescheduleRequired
@@ -2946,151 +3987,32 @@ lemma rescheduleRequired_bitmapQ_no_L2_orphans_sch_act_simple:
 
 lemma sts_valid_bitmapQ_sch_act_simple:
   "\<lbrace>valid_bitmapQ and sch_act_simple\<rbrace>
-    setThreadState st t
-   \<lbrace>\<lambda>_. valid_bitmapQ \<rbrace>"
+   setThreadState st t
+   \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
   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 Invariants_H.valid_queues_def inQ_def)+
+   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>"
+  "\<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 Invariants_H.valid_queues_def inQ_def)+
+   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>"
+  "\<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)
   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 Invariants_H.valid_queues_def inQ_def)+
-  done
-
-lemma sts_valid_queues:
-  "\<lbrace>\<lambda>s. Invariants_H.valid_queues s \<and>
-    ((\<exists>p. t \<in> set(ksReadyQueues s p)) \<longrightarrow> runnable' st)\<rbrace>
-   setThreadState st t \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: setThreadState_def)
-  apply (wp rescheduleRequired_valid_queues_sch_act_simple
-            threadSet_valid_queues [THEN hoare_strengthen_post])
-   apply (clarsimp simp: sch_act_simple_def Invariants_H.valid_queues_def inQ_def)+
-  done
-
-lemma sbn_valid_queues:
-  "\<lbrace>\<lambda>s. Invariants_H.valid_queues s\<rbrace>
-   setBoundNotification ntfn t \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: setBoundNotification_def)
-  apply (wp threadSet_valid_queues [THEN hoare_strengthen_post])
-   apply (clarsimp simp: sch_act_simple_def Invariants_H.valid_queues_def inQ_def)+
-  done
-
-
-
-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]:
-  "\<lbrace>valid_queues' and st_tcb_at' runnable' t \<rbrace>
-    tcbSchedEnqueue t
-   \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def)
-  apply (rule hoare_pre)
-   apply (rule_tac B="\<lambda>rv. valid_queues' and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"
-           in hoare_seq_ext)
-    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_def)+
-     apply (clarsimp simp: obj_at'_def inQ_def projectKOs valid_queues'_def)
-    apply (wp getObject_tcb_wp | simp add: threadGet_def)+
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-lemma rescheduleRequired_valid_queues'_weak[wp]:
-  "\<lbrace>\<lambda>s. valid_queues' s \<and> weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply wpsimp
-  apply (clarsimp simp: weak_sch_act_wf_def)
-  done
-
-lemma rescheduleRequired_valid_queues'_sch_act_simple:
-  "\<lbrace>valid_queues' and sch_act_simple\<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | wpc | simp | fastforce simp: valid_queues'_def sch_act_simple_def)+
-  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)
-  apply (wp rescheduleRequired_valid_queues'_sch_act_simple)
-  apply (rule_tac Q="\<lambda>_. valid_queues'" in hoare_post_imp)
-   apply (clarsimp simp: sch_act_simple_def)
-  apply (wp threadSet_valid_queues')
-  apply (fastforce simp: inQ_def obj_at'_def pred_tcb_at'_def)
-  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 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)
-  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)
-  apply (wp threadSet_valid_objs' | clarsimp simp: valid_tcb'_tcbState_update)+
-  done
-
-lemma rescheduleRequired_ksQ:
-  "\<lbrace>\<lambda>s. sch_act_simple s \<and> P (ksReadyQueues s p)\<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_ s. P (ksReadyQueues s p)\<rbrace>"
-  including no_pre
-  apply (simp add: rescheduleRequired_def sch_act_simple_def)
-  apply (rule_tac B="\<lambda>rv s. (rv = ResumeCurrentThread \<or> rv = ChooseNewThread)
-                            \<and> P (ksReadyQueues s p)" in hoare_seq_ext)
-   apply wpsimp
-   apply (case_tac x; simp)
-  apply wp
+   apply (clarsimp simp: sch_act_simple_def inQ_def)+
   done
 
 lemma setSchedulerAction_ksQ[wp]:
@@ -3105,17 +4027,6 @@ lemma sbn_ksQ:
   "\<lbrace>\<lambda>s. P (ksReadyQueues s p)\<rbrace> setBoundNotification ntfn t \<lbrace>\<lambda>rv s. P (ksReadyQueues s p)\<rbrace>"
   by (simp add: setBoundNotification_def, wp)
 
-lemma sts_ksQ:
-  "\<lbrace>\<lambda>s. sch_act_simple s \<and> P (ksReadyQueues s p)\<rbrace>
-    setThreadState st t
-   \<lbrace>\<lambda>_ s. P (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: setThreadState_def)
-  apply (wp rescheduleRequired_ksQ)
-  apply (rule_tac Q="\<lambda>_ s. P (ksReadyQueues s p)" in hoare_post_imp)
-   apply (clarsimp simp: sch_act_simple_def)+
-  apply (wp, simp)
-  done
-
 lemma setQueue_ksQ[wp]:
   "\<lbrace>\<lambda>s. P ((ksReadyQueues s)((d, p) := q))\<rbrace>
      setQueue d p q
@@ -3123,22 +4034,6 @@ lemma setQueue_ksQ[wp]:
   by (simp add: setQueue_def fun_upd_def[symmetric]
            | wp)+
 
-lemma tcbSchedEnqueue_ksQ:
-  "\<lbrace>\<lambda>s. t' \<notin> set (ksReadyQueues s p) \<and> t' \<noteq> t \<rbrace>
-   tcbSchedEnqueue t \<lbrace>\<lambda>_ s. t' \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply (wpsimp wp: hoare_vcg_imp_lift threadGet_wp)
-  apply (drule obj_at_ko_at')
-  apply fastforce
-  done
-
-lemma rescheduleRequired_ksQ':
-  "\<lbrace>\<lambda>s. t \<notin> set (ksReadyQueues s p) \<and> sch_act_not t s \<rbrace>
-   rescheduleRequired \<lbrace>\<lambda>_ s. t \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wpsimp wp: tcbSchedEnqueue_ksQ)
-  done
-
 lemma threadSet_tcbState_st_tcb_at':
   "\<lbrace>\<lambda>s. P st \<rbrace> threadSet (tcbState_update (\<lambda>_. st)) t \<lbrace>\<lambda>_. st_tcb_at' P t\<rbrace>"
   apply (simp add: threadSet_def pred_tcb_at'_def)
@@ -3149,36 +4044,6 @@ lemma isRunnable_const:
   "\<lbrace>st_tcb_at' runnable' t\<rbrace> isRunnable t \<lbrace>\<lambda>runnable _. runnable \<rbrace>"
   by (rule isRunnable_wp)
 
-lemma sts_ksQ':
-  "\<lbrace>\<lambda>s. (runnable' st \<or> ksCurThread s \<noteq> t) \<and> P (ksReadyQueues s p)\<rbrace>
-   setThreadState st t
-   \<lbrace>\<lambda>_ s. P (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: setThreadState_def)
-  apply (rule hoare_pre_disj')
-   apply (rule hoare_seq_ext [OF _
-                 hoare_vcg_conj_lift
-                   [OF threadSet_tcbState_st_tcb_at' [where P=runnable']
-                       threadSet_ksQ]])
-   apply (rule hoare_seq_ext [OF _
-                 hoare_vcg_conj_lift [OF isRunnable_const isRunnable_inv]])
-   apply (clarsimp simp: when_def)
-   apply (case_tac x)
-    apply (clarsimp, wp)[1]
-   apply (clarsimp)
-  apply (rule hoare_seq_ext [OF _
-                hoare_vcg_conj_lift
-                  [OF threadSet_ct threadSet_ksQ]])
-  apply (rule hoare_seq_ext [OF _ isRunnable_inv])
-  apply (rule hoare_seq_ext [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 valid_ipc_buffer_ptr'D:
   assumes yv: "y < unat max_ipc_words"
   and    buf: "valid_ipc_buffer_ptr' a s"
@@ -3296,14 +4161,16 @@ lemmas msgRegisters_unfold
          unfolded toEnum_def enum_register, simplified]
 
 lemma getMRs_corres:
-  "corres (=) (tcb_at t)
-              (tcb_at' t and case_option \<top> valid_ipc_buffer_ptr' buf)
+  "corres (=) (tcb_at t and pspace_aligned and pspace_distinct)
+              (case_option \<top> valid_ipc_buffer_ptr' buf)
               (get_mrs t buf mi) (getMRs t buf (message_info_map mi))"
   proof -
   have S: "get = gets id"
     by (simp add: gets_def)
-  have T: "corres (\<lambda>con regs. regs = map con msg_registers) (tcb_at t) (tcb_at' t)
-     (thread_get (arch_tcb_get_registers o tcb_arch) t) (asUser t (mapM getRegister ARM_HYP_H.msgRegisters))"
+  have T: "corres (\<lambda>con regs. regs = map con msg_registers)
+             (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_HYP_H.msgRegisters))"
     unfolding arch_tcb_get_registers_def
     apply (subst thread_get_as_user)
     apply (rule asUser_corres')
@@ -3387,8 +4254,8 @@ lemma storeWordUser_valid_ipc_buffer_ptr' [wp]:
 lemma setMRs_corres:
   assumes m: "mrs' = mrs"
   shows
-  "corres (=) (tcb_at t and case_option \<top> in_user_frame buf)
-              (tcb_at' t and case_option \<top> valid_ipc_buffer_ptr' buf)
+  "corres (=) (tcb_at t and pspace_aligned and pspace_distinct and case_option \<top> in_user_frame buf)
+              (case_option \<top> valid_ipc_buffer_ptr' buf)
               (set_mrs t buf mrs) (setMRs t buf mrs')"
 proof -
   have setRegister_def2: "setRegister = (\<lambda>r v. modify (\<lambda>s. s ( r := v )))"
@@ -3448,14 +4315,12 @@ proof -
 qed
 
 lemma copyMRs_corres:
-  "corres (=) (tcb_at s and tcb_at r
-               and case_option \<top> in_user_frame sb
-               and case_option \<top> in_user_frame rb
-               and K (unat n \<le> msg_max_length))
-              (tcb_at' s and tcb_at' r
-               and case_option \<top> valid_ipc_buffer_ptr' sb
-               and case_option \<top> valid_ipc_buffer_ptr' rb)
-              (copy_mrs s sb r rb n) (copyMRs s sb r rb n)"
+  "corres (=)
+     (tcb_at s and tcb_at r and pspace_aligned and pspace_distinct
+      and case_option \<top> in_user_frame sb and case_option \<top> in_user_frame rb
+      and K (unat n \<le> msg_max_length))
+     (case_option \<top> valid_ipc_buffer_ptr' sb and case_option \<top> valid_ipc_buffer_ptr' rb)
+     (copy_mrs s sb r rb n) (copyMRs s sb r rb n)"
 proof -
   have U: "unat n \<le> msg_max_length \<Longrightarrow>
            map (toEnum :: nat \<Rightarrow> word32) [7 ..< Suc (unat n)] = map of_nat [7 ..< Suc (unat n)]"
@@ -3464,7 +4329,7 @@ proof -
   note R=R'[simplified]
 
   have as_user_bit:
-    "\<And>v :: word32. corres dc (tcb_at s and tcb_at r) (tcb_at' s and tcb_at' r)
+    "\<And>v :: word32. corres dc (tcb_at s and tcb_at r and pspace_aligned and pspace_distinct) \<top>
            (mapM
              (\<lambda>ra. do v \<leftarrow> as_user s (getRegister ra);
                       as_user r (setRegister ra v)
@@ -3607,10 +4472,12 @@ qed
 lemmas valid_ipc_buffer_cap_simps = valid_ipc_buffer_cap_def [split_simps cap.split arch_cap.split]
 
 lemma lookupIPCBuffer_corres':
-  "corres (=) (tcb_at t and valid_objs and pspace_aligned)
-               (tcb_at' t and valid_objs' and pspace_aligned'
-                and pspace_distinct' and no_0_obj')
-               (lookup_ipc_buffer w t) (lookupIPCBuffer w t)"
+  "corres (=)
+     (tcb_at t and valid_objs and pspace_aligned and pspace_distinct)
+     (valid_objs' and no_0_obj')
+     (lookup_ipc_buffer w t) (lookupIPCBuffer w t)"
+  apply (rule corres_cross_add_guard[where Q'="pspace_aligned' and pspace_distinct'"])
+   apply (fastforce simp: pspace_aligned_cross pspace_distinct_cross state_relation_def)
   apply (simp add: lookup_ipc_buffer_def ARM_HYP_H.lookupIPCBuffer_def)
   apply (rule corres_guard_imp)
     apply (rule corres_split_eqr[OF threadGet_corres])
@@ -3653,13 +4520,11 @@ lemma lookupIPCBuffer_corres':
   done
 
 lemma lookupIPCBuffer_corres:
-  "corres (=) (tcb_at t and invs)
-               (tcb_at' t and invs')
-               (lookup_ipc_buffer w t) (lookupIPCBuffer w t)"
+  "corres (=) (tcb_at t and invs) (valid_objs' and no_0_obj')
+     (lookup_ipc_buffer w t) (lookupIPCBuffer w t)"
   using lookupIPCBuffer_corres'
   by (rule corres_guard_imp, auto simp: invs'_def valid_state'_def)
 
-
 crunch inv[wp]: lookupIPCBuffer P
 
 crunch pred_tcb_at'[wp]: rescheduleRequired "pred_tcb_at' proj P t"
@@ -3719,7 +4584,7 @@ lemma ct_in_state'_set:
 
 crunches setQueue, rescheduleRequired, tcbSchedDequeue
   for idle'[wp]: "valid_idle'"
-  (simp: crunch_simps )
+  (simp: crunch_simps wp: crunch_wps)
 
 lemma sts_valid_idle'[wp]:
   "\<lbrace>valid_idle' and valid_pspace' and
@@ -3759,8 +4624,9 @@ lemma gbn_sp':
 
 lemma tcbSchedDequeue_tcbState_obj_at'[wp]:
   "\<lbrace>obj_at' (P \<circ> tcbState) t'\<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>rv. obj_at' (P \<circ> tcbState) t'\<rbrace>"
-  apply (simp add: tcbSchedDequeue_def)
-  apply (wp | simp add: o_def split del: if_split cong: if_cong)+
+  apply (simp add: tcbSchedDequeue_def tcbQueueRemove_def)
+  apply (wpsimp wp: getObject_tcb_wp simp: o_def threadGet_def)
+  apply (clarsimp simp: obj_at'_def)
   done
 
 crunch typ_at'[wp]: setQueue "\<lambda>s. P' (typ_at' P t s)"
@@ -3779,10 +4645,14 @@ lemma setQueue_pred_tcb_at[wp]:
 lemma tcbSchedDequeue_pred_tcb_at'[wp]:
   "\<lbrace>\<lambda>s. P' (pred_tcb_at' proj P t' s)\<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>_ s. P' (pred_tcb_at' proj P t' s)\<rbrace>"
   apply (rule_tac P=P' in P_bool_lift)
-   apply (simp add: tcbSchedDequeue_def)
-   apply (wp threadSet_pred_tcb_no_state | clarsimp simp: tcb_to_itcb'_def)+
-  apply (simp add: tcbSchedDequeue_def)
-  apply (wp threadSet_pred_tcb_no_state | clarsimp simp: tcb_to_itcb'_def)+
+   apply (simp add: tcbSchedDequeue_def tcbQueueRemove_def)
+   apply (wpsimp wp: threadSet_pred_tcb_no_state getObject_tcb_wp
+               simp: threadGet_def tcb_to_itcb'_def)
+   apply (clarsimp simp: obj_at'_def)
+  apply (simp add: tcbSchedDequeue_def tcbQueueRemove_def)
+  apply (wpsimp wp: threadSet_pred_tcb_no_state getObject_tcb_wp
+              simp: threadGet_def tcb_to_itcb'_def)
+  apply (clarsimp simp: obj_at'_def)
   done
 
 lemma sts_st_tcb':
@@ -3896,38 +4766,155 @@ crunch nonz_cap[wp]: addToBitmap "ex_nonz_cap_to' t"
 crunch iflive'[wp]: removeFromBitmap if_live_then_nonz_cap'
 crunch nonz_cap[wp]: removeFromBitmap "ex_nonz_cap_to' t"
 
-lemma tcbSchedEnqueue_iflive'[wp]:
-  "\<lbrace>if_live_then_nonz_cap' and ex_nonz_cap_to' tcb\<rbrace>
-    tcbSchedEnqueue tcb \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply (wp threadSet_iflive' hoare_drop_imps | simp add: crunch_simps)+
+crunches rescheduleRequired
+  for cap_to'[wp]: "ex_nonz_cap_to' p"
+
+lemma tcbQueued_update_tcb_cte_cases:
+  "(getF, setF) \<in> ran tcb_cte_cases \<Longrightarrow> getF (tcbQueued_update f tcb) = getF tcb"
+  unfolding tcb_cte_cases_def
+  by (case_tac tcb; fastforce simp: objBits_simps')
+
+lemma tcbSchedNext_update_tcb_cte_cases:
+  "(getF, setF) \<in> ran tcb_cte_cases \<Longrightarrow> getF (tcbSchedNext_update f tcb) = getF tcb"
+  unfolding tcb_cte_cases_def
+  by (case_tac tcb; fastforce simp: objBits_simps')
+
+lemma tcbSchedPrev_update_tcb_cte_cases:
+  "(getF, setF) \<in> ran tcb_cte_cases \<Longrightarrow> getF (tcbSchedPrev_update f tcb) = getF tcb"
+  unfolding tcb_cte_cases_def
+  by (case_tac tcb; fastforce simp: objBits_simps')
+
+lemma tcbSchedNext_update_ctes_of[wp]:
+  "threadSet (tcbSchedNext_update f) tptr \<lbrace>\<lambda>s. P (ctes_of s)\<rbrace>"
+  by (wpsimp wp: threadSet_ctes_ofT simp: tcbSchedNext_update_tcb_cte_cases)
+
+lemma tcbSchedPrev_update_ctes_of[wp]:
+  "threadSet (tcbSchedPrev_update f) tptr \<lbrace>\<lambda>s. P (ctes_of s)\<rbrace>"
+  by (wpsimp wp: threadSet_ctes_ofT simp: tcbSchedPrev_update_tcb_cte_cases)
+
+lemma tcbSchedNext_ex_nonz_cap_to'[wp]:
+  "threadSet (tcbSchedNext_update f) tptr \<lbrace>ex_nonz_cap_to' p\<rbrace>"
+  by (wpsimp wp: threadSet_cap_to simp: tcbSchedNext_update_tcb_cte_cases)
+
+lemma tcbSchedPrev_ex_nonz_cap_to'[wp]:
+  "threadSet (tcbSchedPrev_update f) tptr \<lbrace>ex_nonz_cap_to' p\<rbrace>"
+  by (wpsimp wp: threadSet_cap_to simp: tcbSchedPrev_update_tcb_cte_cases)
+
+lemma tcbSchedNext_update_iflive':
+  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s \<and> ex_nonz_cap_to' t s\<rbrace>
+   threadSet (tcbSchedNext_update f) t
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  by (wpsimp wp: threadSet_iflive'T simp: tcbSchedNext_update_tcb_cte_cases)
+
+lemma tcbSchedPrev_update_iflive':
+  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s \<and> ex_nonz_cap_to' t s\<rbrace>
+   threadSet (tcbSchedPrev_update f) t
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  by (wpsimp wp: threadSet_iflive'T simp: tcbSchedPrev_update_tcb_cte_cases)
+
+lemma tcbQueued_update_iflive'[wp]:
+  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s \<and> ex_nonz_cap_to' t s\<rbrace>
+   threadSet (tcbQueued_update f) t
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  by (wpsimp wp: threadSet_iflive'T simp: tcbQueued_update_tcb_cte_cases)
+
+lemma getTCB_wp:
+  "\<lbrace>\<lambda>s. \<forall>ko :: tcb. ko_at' ko p s \<longrightarrow> Q ko s\<rbrace> getObject p \<lbrace>Q\<rbrace>"
+  apply (wpsimp wp: getObject_tcb_wp)
+  apply (clarsimp simp: obj_at'_def)
   done
 
-lemma rescheduleRequired_iflive'[wp]:
-  "\<lbrace>if_live_then_nonz_cap'
-        and (\<lambda>s. \<forall>t. ksSchedulerAction s = SwitchToThread t
-                \<longrightarrow> st_tcb_at' runnable' t s)\<rbrace>
-      rescheduleRequired
-   \<lbrace>\<lambda>rv. if_live_then_nonz_cap'\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | wpc | simp)+
-  apply (clarsimp simp: pred_tcb_at'_def obj_at'_real_def)
-  apply (erule(1) if_live_then_nonz_capD')
-  apply (fastforce simp: projectKOs live'_def)
+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')
+  by (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 opt_tcb_at'_def live'_def)
+
+lemma tcbQueueRemove_ex_nonz_cap_to'[wp]:
+  "tcbQueueRemove q tcbPtr \<lbrace>ex_nonz_cap_to' tcbPtr'\<rbrace>"
+  unfolding tcbQueueRemove_def
+  by (wpsimp wp: threadSet_cap_to' hoare_drop_imps getTCB_wp)
+
+(* We could write this one as "\<forall>t. tcbQueueHead t \<longrightarrow> ..." instead, but we can't do the same in
+   tcbQueueAppend_if_live_then_nonz_cap', and it's nicer if the two lemmas are symmetric *)
+lemma tcbQueuePrepend_if_live_then_nonz_cap':
+  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s \<and> ex_nonz_cap_to' tcbPtr s
+        \<and> (\<not> tcbQueueEmpty q \<longrightarrow> ex_nonz_cap_to' (the (tcbQueueHead q)) s)\<rbrace>
+   tcbQueuePrepend q tcbPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  unfolding tcbQueuePrepend_def
+  by (wpsimp wp: tcbSchedPrev_update_iflive' tcbSchedNext_update_iflive'
+                 hoare_vcg_if_lift2 hoare_vcg_imp_lift')
+
+lemma tcbQueueAppend_if_live_then_nonz_cap':
+  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s \<and> ex_nonz_cap_to' tcbPtr s
+        \<and> (\<not> tcbQueueEmpty q \<longrightarrow> ex_nonz_cap_to' (the (tcbQueueEnd q)) s)\<rbrace>
+   tcbQueueAppend q tcbPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  unfolding tcbQueueAppend_def
+  by (wpsimp wp: tcbSchedPrev_update_iflive' tcbSchedNext_update_iflive')
+
+lemma tcbQueueInsert_if_live_then_nonz_cap':
+  "\<lbrace>if_live_then_nonz_cap' and ex_nonz_cap_to' tcbPtr and valid_objs' and sym_heap_sched_pointers\<rbrace>
+   tcbQueueInsert tcbPtr afterPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  supply projectKOs[simp]
+  unfolding tcbQueueInsert_def
+  apply (wpsimp wp: tcbSchedPrev_update_iflive' tcbSchedNext_update_iflive' getTCB_wp)
+  apply (intro conjI)
+   apply (erule if_live_then_nonz_capE')
+   apply (clarsimp simp: ko_wp_at'_def obj_at'_def live'_def)
+  apply (erule if_live_then_nonz_capE')
+  apply (frule_tac p'=afterPtr in sym_heapD2)
+   apply (fastforce simp: opt_map_def obj_at'_def)
+  apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+  apply (clarsimp simp: valid_tcb'_def ko_wp_at'_def obj_at'_def opt_map_def live'_def)
+  done
+
+lemma tcbSchedEnqueue_iflive'[wp]:
+  "\<lbrace>if_live_then_nonz_cap' and pspace_aligned' and pspace_distinct'\<rbrace>
+   tcbSchedEnqueue tcbPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  supply projectKOs[simp]
+  unfolding tcbSchedEnqueue_def
+  apply (wpsimp wp: tcbQueuePrepend_if_live_then_nonz_cap' threadGet_wp)
+  apply normalise_obj_at'
+  apply (rename_tac tcb)
+  apply (frule_tac p=tcbPtr in if_live_then_nonz_capE')
+   apply (fastforce simp: ko_wp_at'_def obj_at'_def live'_def)
+  apply clarsimp
+  apply (erule if_live_then_nonz_capE')
+  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 (fastforce dest!: obj_at'_tcbQueueHead_ksReadyQueues
+                    simp: ko_wp_at'_def inQ_def opt_pred_def opt_map_def obj_at'_def live'_def
+                   split: option.splits)
   done
 
+crunches rescheduleRequired
+  for iflive'[wp]: if_live_then_nonz_cap'
+
 lemma sts_iflive'[wp]:
   "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s
-      \<and> (st \<noteq> Inactive \<and> \<not> idle' st \<longrightarrow> ex_nonz_cap_to' t s)\<rbrace>
+        \<and> (st \<noteq> Inactive \<and> \<not> idle' st \<longrightarrow> ex_nonz_cap_to' t s)
+        \<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 setQueue_def)
-  apply (rule hoare_pre)
-   apply (wp | simp)+
-      apply (rule_tac Q="\<lambda>rv. if_live_then_nonz_cap'" in hoare_post_imp)
-       apply clarsimp
-      apply (wp threadSet_iflive' | simp)+
-   apply auto
+  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
   done
 
 lemma sbn_iflive'[wp]:
@@ -4046,6 +5033,19 @@ lemma setBoundNotification_vms'[wp]:
   apply (intro hoare_vcg_all_lift hoare_vcg_disj_lift; wp)
   done
 
+lemma threadSet_ct_not_inQ:
+  "(\<And>tcb. tcbQueued tcb = tcbQueued (F tcb))
+   \<Longrightarrow> threadSet F tcbPtr \<lbrace>\<lambda>s. P (ct_not_inQ s)\<rbrace>"
+  supply projectKOs[simp]
+  unfolding threadSet_def
+  apply (wpsimp wp: getTCB_wp simp: setObject_def updateObject_default_def)
+  apply (erule rsubst[where P=P])
+  by (fastforce simp: ct_not_inQ_def obj_at'_def objBits_simps ps_clear_def split: if_splits)
+
+crunches tcbQueuePrepend, tcbQueueAppend, tcbQueueInsert, tcbQueueRemove, addToBitmap
+  for ct_not_inQ[wp]: ct_not_inQ
+  (wp: threadSet_ct_not_inQ crunch_wps)
+
 lemma tcbSchedEnqueue_ct_not_inQ:
   "\<lbrace>ct_not_inQ and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t)\<rbrace>
     tcbSchedEnqueue t \<lbrace>\<lambda>_. ct_not_inQ\<rbrace>"
@@ -4069,12 +5069,7 @@ lemma tcbSchedEnqueue_ct_not_inQ:
       done
     show ?thesis
       apply (simp add: tcbSchedEnqueue_def unless_def null_def)
-      apply (wp ts sq hoare_convert_imp [OF addToBitmap_nosch addToBitmap_ct'])+
-           apply (rule_tac Q="\<lambda>_. ?PRE" in hoare_post_imp, clarsimp)
-           apply (wp sq hoare_convert_imp [OF setQueue_nosch setQueue_ct])+
-       apply (rule_tac Q="\<lambda>_. ?PRE" in hoare_post_imp, clarsimp)
-       apply wp
-      apply assumption
+      apply (wpsimp wp: ts sq hoare_vcg_imp_lift' getTCB_wp simp: threadGet_def)+
       done
   qed
 
@@ -4101,12 +5096,7 @@ lemma tcbSchedAppend_ct_not_inQ:
       done
     show ?thesis
       apply (simp add: tcbSchedAppend_def unless_def null_def)
-      apply (wp ts sq hoare_convert_imp [OF addToBitmap_nosch addToBitmap_ct'])+
-           apply (rule_tac Q="\<lambda>_. ?PRE" in hoare_post_imp, clarsimp)
-           apply (wp sq hoare_convert_imp [OF setQueue_nosch setQueue_ct])+
-       apply (rule_tac Q="\<lambda>_. ?PRE" in hoare_post_imp, clarsimp)
-       apply wp
-      apply assumption
+      apply (wpsimp wp: ts sq hoare_vcg_imp_lift' getTCB_wp simp: threadGet_def)+
       done
   qed
 
@@ -4135,12 +5125,10 @@ lemma rescheduleRequired_sa_cnt[wp]:
 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>"
-  (is "\<lbrace>?PRE\<rbrace> _ \<lbrace>_\<rbrace>")
   apply (simp add: possibleSwitchTo_def curDomain_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)
+         | (rule hoare_post_imp[OF _ rescheduleRequired_sa_cnt], fastforce))+
   done
 
 lemma threadSet_tcbState_update_ct_not_inQ[wp]:
@@ -4220,29 +5208,6 @@ lemma tcbSchedDequeue_ct_not_inQ[wp]:
       done
   qed
 
-lemma tcbSchedEnqueue_not_st:
-  "(\<And>tcb st qd. P (tcb\<lparr>tcbState := st, tcbQueued := qd\<rparr>) \<longleftrightarrow> P tcb)
-     \<Longrightarrow> \<lbrace>obj_at' P t'\<rbrace> tcbSchedEnqueue t \<lbrace>\<lambda>_. obj_at' P t'\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply (wp threadGet_wp | simp)+
-  apply (clarsimp simp: obj_at'_def)
-  apply (case_tac obja)
-  apply fastforce
-  done
-
-lemma setThreadState_not_st:
-  "(\<And>tcb st qd. P (tcb\<lparr>tcbState := st, tcbQueued := qd\<rparr>) \<longleftrightarrow> P tcb)
-     \<Longrightarrow> \<lbrace>obj_at' P t'\<rbrace> setThreadState st t \<lbrace>\<lambda>_. obj_at' P t'\<rbrace>"
-  apply (simp add: setThreadState_def rescheduleRequired_def)
-  apply (wp hoare_vcg_conj_lift tcbSchedEnqueue_not_st
-          | wpc
-          | rule hoare_drop_imps
-          | simp)+
-  apply (clarsimp simp: obj_at'_def)
-  apply (case_tac obj)
-  apply fastforce
-  done
-
 crunch ct_idle_or_in_cur_domain'[wp]: setQueue ct_idle_or_in_cur_domain'
   (simp: ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def)
 
@@ -4271,17 +5236,8 @@ lemma removeFromBitmap_ct_idle_or_in_cur_domain'[wp]:
            | clarsimp simp: updateObject_default_def in_monad setNotification_def)+
   done
 
-lemma tcbSchedEnqueue_ksCurDomain[wp]:
-  "\<lbrace> \<lambda>s. P (ksCurDomain s)\<rbrace> tcbSchedEnqueue tptr \<lbrace>\<lambda>_ s. P (ksCurDomain s)\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply wpsimp
-  done
-
-lemma tcbSchedEnqueue_ksDomSchedule[wp]:
-  "\<lbrace> \<lambda>s. P (ksDomSchedule s)\<rbrace> tcbSchedEnqueue tptr \<lbrace>\<lambda>_ s. P (ksDomSchedule s)\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply wpsimp
-  done
+crunches tcbQueuePrepend
+  for ct_idle_or_in_cur_domain'[wp]: ct_idle_or_in_cur_domain'
 
 lemma tcbSchedEnqueue_ct_idle_or_in_cur_domain'[wp]:
   "\<lbrace>ct_idle_or_in_cur_domain'\<rbrace> tcbSchedEnqueue tptr \<lbrace>\<lambda>_. ct_idle_or_in_cur_domain'\<rbrace>"
@@ -4359,12 +5315,385 @@ lemma sts_utr[wp]:
   apply (wp untyped_ranges_zero_lift)
   done
 
+lemma removeFromBitmap_bitmapQ:
+  "\<lbrace>\<top>\<rbrace> removeFromBitmap d p \<lbrace>\<lambda>_ s. \<not> bitmapQ d p s \<rbrace>"
+  unfolding bitmapQ_defs bitmap_fun_defs
+  by (wpsimp simp: bitmap_fun_defs)
+
+lemma removeFromBitmap_valid_bitmapQ[wp]:
+  "\<lbrace>valid_bitmapQ_except d p and bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans
+    and (\<lambda>s. tcbQueueEmpty (ksReadyQueues s (d,p)))\<rbrace>
+   removeFromBitmap d p
+   \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
+  (is "\<lbrace>?pre\<rbrace> _ \<lbrace>_\<rbrace>")
+  apply (rule_tac Q="\<lambda>_ s. ?pre s \<and> \<not> bitmapQ d p s" in hoare_strengthen_post)
+   apply (wpsimp wp: removeFromBitmap_valid_bitmapQ_except removeFromBitmap_bitmapQ)
+  apply (fastforce elim: valid_bitmap_valid_bitmapQ_exceptE)
+  done
+
+crunches tcbSchedDequeue
+  for bitmapQ_no_L1_orphans[wp]: bitmapQ_no_L1_orphans
+  and bitmapQ_no_L2_orphans[wp]: bitmapQ_no_L2_orphans
+  (wp: crunch_wps simp: crunch_simps)
+
+lemma setQueue_nonempty_valid_bitmapQ':
+  "\<lbrace>\<lambda>s. valid_bitmapQ s \<and> \<not> tcbQueueEmpty (ksReadyQueues s (d, p))\<rbrace>
+   setQueue d p queue
+   \<lbrace>\<lambda>_ s. \<not> tcbQueueEmpty queue \<longrightarrow> valid_bitmapQ s\<rbrace>"
+  apply (wpsimp simp: setQueue_def)
+  apply (fastforce simp: valid_bitmapQ_def bitmapQ_def)
+  done
+
+lemma threadSet_valid_bitmapQ_except[wp]:
+  "threadSet f tcbPtr \<lbrace>valid_bitmapQ_except d p\<rbrace>"
+  unfolding threadSet_def
+  apply (wpsimp wp: getTCB_wp simp: setObject_def updateObject_default_def)
+  apply (clarsimp simp: valid_bitmapQ_except_def bitmapQ_def)
+  done
+
+lemma threadSet_bitmapQ:
+  "threadSet F t \<lbrace>bitmapQ domain priority\<rbrace>"
+  unfolding threadSet_def
+  apply (wpsimp wp: getTCB_wp simp: setObject_def updateObject_default_def)
+  by (clarsimp simp: bitmapQ_def)
+
+crunches tcbQueueRemove, tcbQueuePrepend, tcbQueueAppend
+  for valid_bitmapQ_except[wp]: "valid_bitmapQ_except d p"
+  and valid_bitmapQ[wp]: valid_bitmapQ
+  and bitmapQ[wp]: "bitmapQ tdom prio"
+  (wp: crunch_wps)
+
+lemma tcbQueued_imp_queue_nonempty:
+  "\<lbrakk>list_queue_relation ts (ksReadyQueues s (tcbDomain tcb, tcbPriority tcb)) nexts prevs;
+    \<forall>t. t \<in> set ts \<longleftrightarrow> (inQ (tcbDomain tcb) (tcbPriority tcb) |< tcbs_of' s) t;
+    ko_at' tcb tcbPtr s; tcbQueued tcb\<rbrakk>
+   \<Longrightarrow> \<not> tcbQueueEmpty (ksReadyQueues s (tcbDomain tcb, tcbPriority tcb))"
+  supply projectKOs[simp]
+  apply (clarsimp simp: list_queue_relation_def tcbQueueEmpty_def)
+  apply (drule_tac x=tcbPtr in spec)
+  apply (fastforce dest: heap_path_head simp: inQ_def opt_map_def opt_pred_def obj_at'_def)
+  done
+
+lemma tcbSchedDequeue_valid_bitmapQ[wp]:
+  "\<lbrace>valid_bitmaps\<rbrace> tcbSchedDequeue tcbPtr \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
+  unfolding tcbSchedDequeue_def tcbQueueRemove_def
+  apply (wpsimp wp: setQueue_nonempty_valid_bitmapQ' hoare_vcg_conj_lift
+                    hoare_vcg_if_lift2 hoare_vcg_const_imp_lift threadGet_wp
+         | wp (once) hoare_drop_imps)+
+  by (fastforce dest!: tcbQueued_imp_queue_nonempty
+                 simp: ready_queue_relation_def ksReadyQueues_asrt_def obj_at'_def)
+
+lemma tcbSchedDequeue_valid_bitmaps[wp]:
+  "tcbSchedDequeue tcbPtr \<lbrace>valid_bitmaps\<rbrace>"
+  by (wpsimp simp: valid_bitmaps_def)
+
+lemma setQueue_valid_bitmapQ': (* enqueue only *)
+  "\<lbrace>valid_bitmapQ_except d p and bitmapQ d p and K (\<not> tcbQueueEmpty q)\<rbrace>
+   setQueue d p q
+   \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
+  unfolding setQueue_def bitmapQ_defs
+  by (wpsimp simp: bitmapQ_def)
+
+lemma tcbSchedEnqueue_valid_bitmapQ[wp]:
+  "\<lbrace>valid_bitmaps\<rbrace> tcbSchedEnqueue tcbPtr \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
+  supply if_split[split del]
+  unfolding tcbSchedEnqueue_def
+  apply (wpsimp simp: tcbQueuePrepend_def
+                  wp: setQueue_valid_bitmapQ' addToBitmap_valid_bitmapQ_except addToBitmap_bitmapQ
+                      threadGet_wp)
+  apply (fastforce simp: valid_bitmaps_def valid_bitmapQ_def tcbQueueEmpty_def split: if_splits)
+  done
+
+crunches tcbSchedEnqueue, tcbSchedAppend
+  for bitmapQ_no_L1_orphans[wp]: bitmapQ_no_L1_orphans
+  and bitmapQ_no_L2_orphans[wp]: bitmapQ_no_L2_orphans
+
+lemma tcbSchedEnqueue_valid_bitmaps[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>valid_bitmaps\<rbrace>"
+  unfolding valid_bitmaps_def
+  apply wpsimp
+  apply (clarsimp simp: valid_bitmaps_def)
+  done
+
+crunches rescheduleRequired, threadSet, setThreadState
+  for valid_bitmaps[wp]: valid_bitmaps
+  (rule: valid_bitmaps_lift)
+
+lemma tcbSchedEnqueue_valid_sched_pointers[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>valid_sched_pointers\<rbrace>"
+  supply projectKOs[simp]
+  apply (clarsimp simp: tcbSchedEnqueue_def getQueue_def unless_def)
+  \<comment> \<open>we step forwards until we can step over the addToBitmap in order to avoid state blow-up\<close>
+  apply (intro hoare_seq_ext[OF _ stateAssert_sp] hoare_seq_ext[OF _ isRunnable_inv]
+               hoare_seq_ext[OF _ assert_sp] hoare_seq_ext[OF _ threadGet_sp]
+               hoare_seq_ext[OF _ gets_sp]
+         | rule hoare_when_cases, fastforce)+
+  apply (forward_inv_step wp: hoare_vcg_ex_lift)
+  supply if_split[split del]
+  apply (wpsimp wp: getTCB_wp
+              simp: threadSet_def setObject_def updateObject_default_def tcbQueuePrepend_def
+                    setQueue_def)
+  apply (clarsimp simp: valid_sched_pointers_def)
+  apply (intro conjI impI)
+   apply (fastforce simp: opt_pred_def opt_map_def split: if_splits)
+  apply normalise_obj_at'
+  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: valid_sched_pointers_def list_queue_relation_def)
+  apply (case_tac "ts = []", fastforce simp: tcbQueueEmpty_def)
+  by (intro conjI impI;
+      force dest!: hd_in_set heap_path_head
+             simp: inQ_def opt_pred_def opt_map_def obj_at'_def split: if_splits)
+
+lemma tcbSchedAppend_valid_sched_pointers[wp]:
+  "tcbSchedAppend tcbPtr \<lbrace>valid_sched_pointers\<rbrace>"
+  supply projectKOs[simp]
+  apply (clarsimp simp: tcbSchedAppend_def getQueue_def unless_def)
+  \<comment> \<open>we step forwards until we can step over the addToBitmap in order to avoid state blow-up\<close>
+  apply (intro hoare_seq_ext[OF _ stateAssert_sp] hoare_seq_ext[OF _ isRunnable_inv]
+               hoare_seq_ext[OF _ assert_sp] hoare_seq_ext[OF _ threadGet_sp]
+               hoare_seq_ext[OF _ gets_sp]
+         | rule hoare_when_cases, fastforce)+
+  apply (forward_inv_step wp: hoare_vcg_ex_lift)
+  supply if_split[split del]
+  apply (wpsimp wp: getTCB_wp
+              simp: threadSet_def setObject_def updateObject_default_def tcbQueueAppend_def
+                    setQueue_def)
+  apply (clarsimp simp: valid_sched_pointers_def)
+  apply (intro conjI impI)
+   apply (fastforce simp: opt_pred_def opt_map_def split: if_splits)
+  apply normalise_obj_at'
+  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)
+  by (intro conjI impI;
+      clarsimp dest: last_in_set
+               simp: valid_sched_pointers_def opt_map_def list_queue_relation_def tcbQueueEmpty_def
+                     queue_end_valid_def inQ_def opt_pred_def obj_at'_def
+              split: if_splits option.splits;
+      fastforce)
+
+lemma tcbSchedDequeue_valid_sched_pointers[wp]:
+  "\<lbrace>valid_sched_pointers and sym_heap_sched_pointers\<rbrace>
+   tcbSchedDequeue tcbPtr
+   \<lbrace>\<lambda>_. valid_sched_pointers\<rbrace>"
+  supply if_split[split del] fun_upd_apply[simp del] projectKOs[simp]
+  apply (clarsimp simp: tcbSchedDequeue_def getQueue_def setQueue_def)
+  apply (wpsimp wp: threadSet_wp getTCB_wp threadGet_wp simp: tcbQueueRemove_def)
+  apply normalise_obj_at'
+  apply (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 split: if_splits)
+  apply (frule (1) list_queue_relation_neighbour_in_set[where p=tcbPtr])
+   apply (fastforce simp: inQ_def opt_pred_def opt_map_def obj_at'_def)
+  apply (clarsimp simp: list_queue_relation_def)
+  apply (intro conjI impI)
+     \<comment> \<open>the ready queue is the singleton consisting of tcbPtr\<close>
+     apply (clarsimp simp: valid_sched_pointers_def)
+     apply (case_tac "ptr = tcbPtr")
+      apply (force dest!: heap_ls_last_None
+                    simp: prev_queue_head_def queue_end_valid_def inQ_def opt_map_def obj_at'_def)
+     apply (simp add: fun_upd_def opt_pred_def)
+    \<comment> \<open>tcbPtr is the head of the ready queue\<close>
+    subgoal
+      by (auto dest!: heap_ls_last_None
+                simp: valid_sched_pointers_def fun_upd_apply prev_queue_head_def
+                      inQ_def opt_pred_def opt_map_def obj_at'_def
+               split: if_splits option.splits)
+   \<comment> \<open>tcbPtr is the end of the ready queue\<close>
+   subgoal
+     by (auto dest!: heap_ls_last_None
+               simp: valid_sched_pointers_def queue_end_valid_def inQ_def opt_pred_def
+                     opt_map_def fun_upd_apply obj_at'_def
+              split: if_splits option.splits)
+  \<comment> \<open>tcbPtr is in the middle of the ready queue\<close>
+  apply (intro conjI impI allI)
+  by (clarsimp simp: valid_sched_pointers_def inQ_def opt_pred_def opt_map_def fun_upd_apply obj_at'_def
+              split: if_splits option.splits;
+      auto)
+
+lemma tcbQueueRemove_sym_heap_sched_pointers:
+  "\<lbrace>\<lambda>s. sym_heap_sched_pointers s
+        \<and> (\<exists>ts. list_queue_relation ts q (tcbSchedNexts_of s) (tcbSchedPrevs_of s)
+                \<and> tcbPtr \<in> set ts)\<rbrace>
+   tcbQueueRemove q tcbPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  supply projectKOs[simp]
+  supply heap_path_append[simp del]
+  apply (clarsimp simp: tcbQueueRemove_def)
+  apply (wpsimp wp: threadSet_wp getTCB_wp)
+  apply (rename_tac tcb ts)
+
+  \<comment> \<open>tcbPtr is the head of q, which is not a singleton\<close>
+  apply (rule conjI)
+   apply clarsimp
+   apply (clarsimp simp: list_queue_relation_def Let_def)
+   apply (prop_tac "tcbSchedNext tcb \<noteq> Some tcbPtr")
+    apply (fastforce dest: heap_ls_no_loops[where p=tcbPtr] simp: opt_map_def obj_at'_def)
+   apply (fastforce intro: sym_heap_remove_only'
+                     simp: prev_queue_head_def opt_map_red opt_map_upd_triv obj_at'_def)
+
+  \<comment> \<open>tcbPtr is the end of q, which is not a singleton\<close>
+  apply (intro impI)
+  apply (rule conjI)
+   apply clarsimp
+   apply (prop_tac "tcbSchedPrev tcb \<noteq> Some tcbPtr")
+    apply (fastforce dest!: heap_ls_prev_no_loops[where p=tcbPtr]
+                      simp: list_queue_relation_def opt_map_def obj_at'_def)
+   apply (subst fun_upd_swap, fastforce)
+   apply (fastforce intro: sym_heap_remove_only simp: opt_map_red opt_map_upd_triv obj_at'_def)
+
+  \<comment> \<open>tcbPtr is in the middle of q\<close>
+  apply (intro conjI impI allI)
+  apply (frule (2) list_queue_relation_neighbour_in_set[where p=tcbPtr])
+  apply (frule split_list)
+  apply clarsimp
+  apply (rename_tac xs ys)
+  apply (prop_tac "xs \<noteq> [] \<and> ys \<noteq> []")
+   apply (fastforce simp: list_queue_relation_def queue_end_valid_def)
+  apply (clarsimp simp: list_queue_relation_def)
+  apply (frule (3) ptr_in_middle_prev_next)
+  apply (frule heap_ls_distinct)
+  apply (rename_tac afterPtr beforePtr xs ys)
+  apply (frule_tac before=beforePtr and middle=tcbPtr and after=afterPtr
+                in sym_heap_remove_middle_from_chain)
+      apply (fastforce dest: last_in_set simp: opt_map_def obj_at'_def)
+     apply (fastforce dest: hd_in_set simp: opt_map_def obj_at'_def)
+    apply (rule_tac hp="tcbSchedNexts_of s" in sym_heapD2)
+     apply fastforce
+    apply (fastforce simp: opt_map_def obj_at'_def)
+   apply (fastforce simp: opt_map_def obj_at'_def)
+  apply (fastforce simp: fun_upd_swap opt_map_red opt_map_upd_triv obj_at'_def split: if_splits)
+  done
+
+lemma tcbQueuePrepend_sym_heap_sched_pointers:
+  "\<lbrace>\<lambda>s. sym_heap_sched_pointers s
+        \<and> (\<exists>ts. list_queue_relation ts q (tcbSchedNexts_of s) (tcbSchedPrevs_of s)
+                \<and> tcbPtr \<notin> set ts)
+        \<and> tcbSchedNexts_of s tcbPtr = None \<and> tcbSchedPrevs_of s tcbPtr = None\<rbrace>
+   tcbQueuePrepend q tcbPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  supply projectKOs[simp]
+  supply if_split[split del]
+  apply (clarsimp simp: tcbQueuePrepend_def)
+  apply (wpsimp wp: threadSet_wp)
+  apply (prop_tac "tcbPtr \<noteq> the (tcbQueueHead q)")
+   apply (case_tac "ts = []";
+          fastforce dest: heap_path_head simp: list_queue_relation_def tcbQueueEmpty_def)
+  apply (drule_tac a=tcbPtr and b="the (tcbQueueHead q)" in sym_heap_connect)
+    apply assumption
+   apply (clarsimp simp: list_queue_relation_def prev_queue_head_def tcbQueueEmpty_def)
+  apply (fastforce simp: fun_upd_swap opt_map_red opt_map_upd_triv obj_at'_def tcbQueueEmpty_def)
+  done
+
+lemma tcbQueueInsert_sym_heap_sched_pointers:
+  "\<lbrace>\<lambda>s. sym_heap_sched_pointers s
+        \<and> tcbSchedNexts_of s tcbPtr = None \<and> tcbSchedPrevs_of s tcbPtr = None\<rbrace>
+   tcbQueueInsert tcbPtr afterPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  supply projectKOs[simp]
+  apply (clarsimp simp: tcbQueueInsert_def)
+  \<comment> \<open>forwards step in order to name beforePtr below\<close>
+  apply (rule hoare_seq_ext[OF _ getObject_tcb_sp])
+  apply (rule hoare_seq_ext[OF _ assert_sp])
+  apply (rule hoare_ex_pre_conj[simplified conj_commute], rename_tac beforePtr)
+  apply (rule hoare_seq_ext[OF _ assert_sp])
+  apply (wpsimp wp: threadSet_wp)
+  apply normalise_obj_at'
+  apply (prop_tac "tcbPtr \<noteq> afterPtr")
+   apply (clarsimp simp: list_queue_relation_def opt_map_red obj_at'_def)
+  apply (prop_tac "tcbPtr \<noteq> beforePtr")
+   apply (fastforce dest: sym_heap_None simp: opt_map_def obj_at'_def split: option.splits)
+  apply (prop_tac "tcbSchedNexts_of s beforePtr = Some afterPtr")
+   apply (fastforce intro: sym_heapD2 simp: opt_map_def obj_at'_def)
+  apply (fastforce dest: sym_heap_insert_into_middle_of_chain
+                   simp: fun_upd_swap opt_map_red opt_map_upd_triv obj_at'_def)
+  done
+
+lemma tcbQueueAppend_sym_heap_sched_pointers:
+  "\<lbrace>\<lambda>s. sym_heap_sched_pointers s
+        \<and> (\<exists>ts. list_queue_relation ts q (tcbSchedNexts_of s) (tcbSchedPrevs_of s)
+                \<and> tcbPtr \<notin> set ts)
+        \<and> tcbSchedNexts_of s tcbPtr = None \<and> tcbSchedPrevs_of s tcbPtr = None\<rbrace>
+   tcbQueueAppend q tcbPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  supply projectKOs[simp]
+  supply if_split[split del]
+  apply (clarsimp simp: tcbQueueAppend_def)
+  apply (wpsimp wp: threadSet_wp)
+  apply (clarsimp simp: tcbQueueEmpty_def list_queue_relation_def queue_end_valid_def obj_at'_def
+                 split: if_splits)
+   apply fastforce
+  apply (drule_tac a="last ts" and b=tcbPtr in sym_heap_connect)
+    apply (fastforce dest: heap_ls_last_None)
+   apply assumption
+  apply (simp add: opt_map_red tcbQueueEmpty_def)
+  apply (subst fun_upd_swap, simp)
+  apply (fastforce simp: opt_map_red opt_map_upd_triv)
+  done
+
+lemma tcbQueued_update_sym_heap_sched_pointers[wp]:
+  "threadSet (tcbQueued_update f) tcbPtr \<lbrace>sym_heap_sched_pointers\<rbrace>"
+  by (rule sym_heap_sched_pointers_lift;
+      wpsimp wp: threadSet_tcbSchedPrevs_of threadSet_tcbSchedNexts_of)
+
+lemma tcbSchedEnqueue_sym_heap_sched_pointers[wp]:
+  "\<lbrace>sym_heap_sched_pointers and valid_sched_pointers\<rbrace>
+   tcbSchedEnqueue tcbPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  supply projectKOs[simp]
+  unfolding tcbSchedEnqueue_def
+  apply (wpsimp wp: tcbQueuePrepend_sym_heap_sched_pointers threadGet_wp
+              simp: addToBitmap_def 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 (fastforce dest!: spec[where x=tcbPtr] inQ_implies_tcbQueueds_of
+                    simp: valid_sched_pointers_def opt_pred_def opt_map_def obj_at'_def)
+  done
+
+lemma tcbSchedAppend_sym_heap_sched_pointers[wp]:
+  "\<lbrace>sym_heap_sched_pointers and valid_sched_pointers\<rbrace>
+   tcbSchedAppend tcbPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  supply projectKOs[simp]
+  unfolding tcbSchedAppend_def
+  apply (wpsimp wp: tcbQueueAppend_sym_heap_sched_pointers threadGet_wp
+              simp: addToBitmap_def 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 (fastforce dest!: spec[where x=tcbPtr] inQ_implies_tcbQueueds_of
+                    simp: valid_sched_pointers_def opt_pred_def opt_map_def obj_at'_def)
+  done
+
+lemma tcbSchedDequeue_sym_heap_sched_pointers[wp]:
+  "\<lbrace>sym_heap_sched_pointers and valid_sched_pointers\<rbrace>
+   tcbSchedDequeue tcbPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  supply projectKOs[simp]
+  unfolding tcbSchedDequeue_def
+  apply (wpsimp wp: tcbQueueRemove_sym_heap_sched_pointers hoare_vcg_if_lift2 threadGet_wp
+              simp: bitmap_fun_defs)
+  apply (fastforce simp: ready_queue_relation_def ksReadyQueues_asrt_def inQ_def opt_pred_def
+                         opt_map_def obj_at'_def)
+  done
+
+crunches setThreadState
+  for valid_sched_pointers[wp]: valid_sched_pointers
+  and sym_heap_sched_pointers[wp]: sym_heap_sched_pointers
+  (simp: crunch_simps wp: crunch_wps threadSet_valid_sched_pointers threadSet_sched_pointers)
+
 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. (\<exists>p. t \<in> set(ksReadyQueues s p)) \<longrightarrow> runnable' st)
       and (\<lambda>s. runnable' st \<and> obj_at' tcbQueued t s \<longrightarrow> st_tcb_at' runnable' t s)
       and sch_act_simple
       and invs'\<rbrace>
@@ -4373,21 +5702,21 @@ lemma sts_invs_minor':
   including no_pre
   apply (simp add: invs'_def valid_state'_def)
   apply (rule hoare_pre)
-   apply (wp sts_valid_queues valid_irq_node_lift irqs_masked_lift
-              setThreadState_ct_not_inQ
+   apply (wp valid_irq_node_lift irqs_masked_lift
+             setThreadState_ct_not_inQ
             | simp add: cteCaps_of_def o_def)+
   apply (clarsimp simp: sch_act_simple_def)
   apply (intro conjI)
-     apply clarsimp
-    defer
-    apply (clarsimp dest!: st_tcb_at_state_refs_ofD'
-                    elim!: rsubst[where P=sym_refs]
-                   intro!: ext)
-   apply (clarsimp elim!: st_tcb_ex_cap'')
+       apply clarsimp
+      defer
+      apply (clarsimp dest!: st_tcb_at_state_refs_ofD'
+                      elim!: rsubst[where P=sym_refs]
+                     intro!: ext)
+      apply (clarsimp elim!: st_tcb_ex_cap'')
+    apply fastforce
+   apply fastforce
   apply (frule tcb_in_valid_state', clarsimp+)
-  apply (cases st, simp_all add: valid_tcb_state'_def
-                  split: Structures_H.thread_state.split_asm)
-  done
+  by (cases st; simp add: valid_tcb_state'_def split: Structures_H.thread_state.split_asm)
 
 lemma sts_cap_to'[wp]:
   "\<lbrace>ex_nonz_cap_to' p\<rbrace> setThreadState st t \<lbrace>\<lambda>rv. ex_nonz_cap_to' p\<rbrace>"
@@ -4432,12 +5761,59 @@ lemma threadSet_ct_running':
   apply wp
   done
 
+lemma tcbQueuePrepend_tcbPriority_obj_at'[wp]:
+  "tcbQueuePrepend queue tptr \<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
+  supply projectKOs[simp]
+  unfolding tcbQueuePrepend_def
+  apply (wpsimp wp: threadSet_wp)
+  by (auto simp: obj_at'_def objBits_simps ps_clear_def split: if_splits)
+
+lemma tcbQueuePrepend_tcbDomain_obj_at'[wp]:
+  "tcbQueuePrepend queue tptr \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  supply projectKOs[simp]
+  unfolding tcbQueuePrepend_def
+  apply (wpsimp wp: threadSet_wp)
+  by (auto simp: obj_at'_def objBits_simps ps_clear_def split: if_splits)
+
+lemma tcbSchedDequeue_tcbPriority[wp]:
+  "tcbSchedDequeue t \<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
+  unfolding tcbSchedDequeue_def tcbQueueRemove_def
+  by (wpsimp wp: hoare_when_weak_wp hoare_drop_imps)
+
+lemma tcbSchedDequeue_tcbDomain[wp]:
+  "tcbSchedDequeue t \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  unfolding tcbSchedDequeue_def tcbQueueRemove_def
+  by (wpsimp wp: hoare_when_weak_wp hoare_drop_imps)
+
+lemma tcbSchedEnqueue_tcbPriority_obj_at'[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
+  unfolding tcbSchedEnqueue_def setQueue_def
+  by wpsimp
+
+lemma tcbSchedEnqueue_tcbDomain_obj_at'[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  unfolding tcbSchedEnqueue_def setQueue_def
+  by wpsimp
+
+crunches rescheduleRequired
+  for tcbPriority_obj_at'[wp]: "obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'"
+  and tcbDomain_obj_at'[wp]: "obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'"
+
+lemma setThreadState_tcbPriority_obj_at'[wp]:
+  "setThreadState ts tptr \<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
+  supply projectKOs[simp]
+  unfolding setThreadState_def
+  apply (wpsimp wp: threadSet_wp)
+  apply (fastforce simp: obj_at'_def objBits_simps ps_clear_def)
+  done
+
 lemma setThreadState_tcb_in_cur_domain'[wp]:
   "\<lbrace>tcb_in_cur_domain' t'\<rbrace> setThreadState 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 setThreadState_not_st | simp)+
+  apply (simp add: setThreadState_def)
+  apply (wpsimp wp: threadSet_ct_idle_or_in_cur_domain' hoare_drop_imps)+
   done
 
 lemma asUser_global_refs':   "\<lbrace>valid_global_refs'\<rbrace> asUser t f \<lbrace>\<lambda>rv. valid_global_refs'\<rbrace>"
@@ -4583,10 +5959,13 @@ 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)
-            (set_eobject ptr etcb) (setObject ptr tcb')"
+  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
@@ -4607,20 +5986,34 @@ lemma set_eobject_corres':
    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 cte_relation_def tcb_relation_def projectKOs split: if_split_asm)+
+     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 (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 (clarsimp simp: projectKOs)
-  apply (insert e)
-  apply (clarsimp simp: other_obj_relation_def etcb_relation_def is_other_obj_relation_type split: Structures_A.kernel_object.splits Structures_H.kernel_object.splits ARM_A.arch_kernel_obj.splits)
+  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
 
 lemma set_eobject_corres:
@@ -4628,9 +6021,13 @@ lemma set_eobject_corres:
   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)
-                  (set_eobject add etcbu) (setObject add tcbu')"
+  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)
@@ -4657,24 +6054,27 @@ lemma set_eobject_corres:
 
 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)
-                    (ethread_set f t) (threadSet f' t)"
+  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+
+     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 simp
+  apply (clarsimp simp: obj_at'_def)
   done
 
 lemmas ethread_set_corres =
diff --git a/proof/refine/ARM_HYP/Tcb_R.thy b/proof/refine/ARM_HYP/Tcb_R.thy
index e8091f932d..80beb5be96 100644
--- a/proof/refine/ARM_HYP/Tcb_R.thy
+++ b/proof/refine/ARM_HYP/Tcb_R.thy
@@ -46,14 +46,14 @@ lemma activateThread_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)
+          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
+   apply (clarsimp simp: ct_in_state_def tcb_at_invs invs_distinct invs_psp_aligned
                   elim!: st_tcb_weakenE)
   apply (clarsimp simp: tcb_at_invs' ct_in_state'_def
                  elim!: pred_tcb'_weakenE)
@@ -197,13 +197,13 @@ lemma setupReplyMaster_weak_sch_act_wf[wp]:
   apply assumption
   done
 
-crunches setupReplyMaster
-  for valid_queues[wp]: "Invariants_H.valid_queues"
-  and valid_queues'[wp]: "valid_queues'"
+crunches 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) (invs' and tcb_at' t)
+  "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)
@@ -212,20 +212,22 @@ lemma restart_corres:
       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])
-             apply clarsimp
+          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_valid_queues sts_st_tcb'
-                    | clarsimp simp: valid_tcb_state'_def)+
-       apply (rule_tac Q="\<lambda>rv. valid_sched and cur_tcb" in hoare_strengthen_post)
-        apply wp
-       apply (simp add: valid_sched_def valid_sched_action_def)
-      apply (rule_tac Q="\<lambda>rv. invs' and tcb_at' t" in hoare_strengthen_post)
-       apply wp
-      apply (clarsimp simp: invs'_def valid_state'_def sch_act_wf_weak valid_pspace'_def)
-     apply wp+
-   apply (simp add: valid_sched_def invs_def tcb_at_is_etcb_at)
-  apply (clarsimp simp add: invs'_def valid_state'_def sch_act_wf_weak)
+              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
 
 lemma restart_invs':
@@ -304,12 +306,6 @@ crunch sch_act_simple [wp]: asUser "sch_act_simple"
 
 crunch invs'[wp]: getSanitiseRegisterInfo invs'
 
-lemma invs_valid_queues':
-  "invs' s \<longrightarrow> valid_queues' s"
-  by (clarsimp simp:invs'_def valid_state'_def)
-
-declare invs_valid_queues'[rule_format, elim!]
-
 lemma einvs_valid_etcbs: "einvs s \<longrightarrow> valid_etcbs s"
   by (clarsimp simp: valid_sched_def)
 
@@ -322,6 +318,11 @@ lemma asUser_postModifyRegisters_corres:
   apply (rule corres_stateAssert_assume)
    by simp+
 
+crunches restart
+  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 tcb_at dest and ex_nonz_cap_to dest)
         (invs' and sch_act_simple and tcb_at' dest and ex_nonz_cap_to' dest)
@@ -347,17 +348,21 @@ lemma invokeTCB_WriteRegisters_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_valid_queues' invs_queues invs_weak_sch_act_wf
-                 | 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 ((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 (wpsimp simp: getSanitiseRegisterInfo_def)+
+   apply fastforce
+  apply fastforce
   done
 
 crunch it[wp]: suspend "\<lambda>s. P (ksIdleThread s)"
@@ -382,6 +387,10 @@ lemma suspend_ResumeCurrentThread_imp_notct[wp]:
    \<lbrace>\<lambda>rv s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>"
   by (wpsimp simp: suspend_def)
 
+crunches restart, suspend
+  for cur_tcb'[wp]: cur_tcb'
+  (wp: crunch_wps threadSet_cur ignore: threadSet)
+
 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
@@ -409,7 +418,7 @@ proof -
         apply (rule corres_modify')
          apply simp
         apply simp
-       apply (simp | wp)+
+       apply (simp add: invs_distinct invs_psp_aligned | wp)+
     done
   have R: "\<And>src src' des des' xs ys. \<lbrakk> src = src'; des = des'; xs = ys \<rbrakk> \<Longrightarrow>
            corres dc (tcb_at src and tcb_at des and invs)
@@ -432,7 +441,7 @@ proof -
       apply (rule corres_split_eqr[OF asUser_getRestartPC_corres])
         apply (rule asUser_setNextPC_corres)
        apply wp+
-     apply simp+
+     apply (simp add: invs_distinct invs_psp_aligned)+
     done
   show ?thesis
     apply (simp add: invokeTCB_def performTransfer_def)
@@ -458,11 +467,11 @@ proof -
                     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)
+              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_state'_def invs_weak_sch_act_wf)
-             apply ((wp mapM_x_wp' hoare_weak_lift_imp | simp)+)[4]
+              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 add: 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
@@ -509,41 +518,10 @@ lemma copyreg_invs':
    \<lbrace>\<lambda>rv. invs'\<rbrace>"
   by (rule hoare_strengthen_post, rule copyreg_invs'', simp)
 
-lemma threadSet_valid_queues_no_state:
-  "\<lbrace>Invariants_H.valid_queues and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))\<rbrace>
-     threadSet f t \<lbrace>\<lambda>_. Invariants_H.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 setObject_queues_unchanged_tcb
-             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 isRunnable_corres:
-  "corres (\<lambda>ts runn. runnable ts = runn) (tcb_at t) (tcb_at' t)
-     (get_thread_state t) (isRunnable t)"
+  "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)
@@ -564,16 +542,6 @@ lemma tcbSchedDequeue_not_queued:
   apply (wp tg_sp' [where P=\<top>, simplified] | simp)+
   done
 
-lemma tcbSchedDequeue_not_in_queue:
-  "\<And>p. \<lbrace>Invariants_H.valid_queues and tcb_at' t and valid_objs'\<rbrace> tcbSchedDequeue t
-   \<lbrace>\<lambda>rv s. t \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (rule_tac Q="\<lambda>rv. Invariants_H.valid_queues and obj_at' (Not \<circ> tcbQueued) t"
-               in hoare_post_imp)
-   apply (fastforce simp: valid_queues_def valid_queues_no_bitmap_def obj_at'_def projectKOs inQ_def)
-  apply (wp tcbSchedDequeue_not_queued tcbSchedDequeue_valid_queues |
-         simp add: valid_objs'_maxDomain valid_objs'_maxPriority)+
-  done
-
 lemma threadSet_ct_in_state':
   "(\<And>tcb. tcbState (f tcb) = tcbState tcb) \<Longrightarrow>
   \<lbrace>ct_in_state' test\<rbrace> threadSet f t \<lbrace>\<lambda>rv. ct_in_state' test\<rbrace>"
@@ -609,22 +577,27 @@ lemma threadSet_valid_objs_tcbPriority_update:
     apply (fastforce  simp: obj_at'_def)+
   done
 
-lemma tcbSchedDequeue_ct_in_state':
-  "\<lbrace>ct_in_state' test\<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>rv. ct_in_state' test\<rbrace>"
+lemma tcbSchedDequeue_ct_in_state'[wp]:
+  "tcbSchedDequeue t \<lbrace>ct_in_state' test\<rbrace>"
   apply (simp add: ct_in_state'_def)
   apply (rule hoare_lift_Pf[where f=ksCurThread]; wpsimp)
   done
 
 crunch cur[wp]: tcbSchedDequeue cur_tcb'
 
+crunches tcbSchedDequeue
+  for st_tcb_at'[wp]: "\<lambda>s. P (st_tcb_at' st tcbPtr s)"
+
 lemma sp_corres2:
-  "corres dc (valid_etcbs and weak_valid_sched_action and cur_tcb)
-             (Invariants_H.valid_queues and valid_queues' and cur_tcb' and tcb_at' t
-              and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and valid_objs' and (\<lambda>_. x \<le> maxPriority))
-                  (set_priority t x) (setPriority t x)"
+  "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])
+    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])
@@ -633,56 +606,45 @@ lemma sp_corres2:
             apply (wp corres_if; clarsimp)
              apply (rule rescheduleRequired_corres)
             apply (rule possibleSwitchTo_corres)
-           apply wp
-          apply wp
-         apply clarsimp
-         apply (wp hoare_weak_lift_imp hoare_vcg_if_lift hoare_wp_combs gts_wp)
-        apply clarsimp
-        apply (wp hoare_vcg_if_lift hoare_weak_lift_imp hoare_wp_combs isRunnable_wp)
-       apply (wp  hoare_vcg_imp_lift' hoare_vcg_if_lift hoare_vcg_all_lift)
-      apply clarsimp
-      apply (wp hoare_drop_imps)
-       apply ((wp hoare_vcg_imp_lift' hoare_vcg_if_lift hoare_vcg_all_lift
-                  isRunnable_wp threadSet_pred_tcb_no_state threadSet_valid_queues_no_state
-                  threadSet_valid_queues'_no_state threadSet_valid_objs_tcbPriority_update
-                  threadSet_weak_sch_act_wf threadSet_ct_in_state'[simplified ct_in_state'_def]
-               | simp add: etcb_relation_def)+)[1]
-      apply ((wp hoare_vcg_imp_lift' hoare_vcg_if_lift hoare_vcg_all_lift
-                 isRunnable_wp threadSet_pred_tcb_no_state threadSet_valid_queues_no_state
-                 threadSet_valid_queues'_no_state threadSet_cur threadSet_valid_objs_tcbPriority_update
-                 threadSet_weak_sch_act_wf threadSet_ct_in_state'[simplified ct_in_state'_def]
-              | simp add: etcb_relation_def)+)[1]
-     apply ((wp hoare_vcg_imp_lift' hoare_vcg_if_lift hoare_vcg_all_lift
-                isRunnable_wp threadSet_pred_tcb_no_state threadSet_valid_queues_no_state
-                threadSet_cur threadSet_valid_queues'_no_state threadSet_valid_objs_tcbPriority_update
-                threadSet_weak_sch_act_wf threadSet_ct_in_state'[simplified ct_in_state'_def]
-             | simp add: etcb_relation_def)+)[1]
-    apply clarsimp
-    apply ((wp hoare_vcg_imp_lift' hoare_vcg_if_lift hoare_vcg_all_lift hoare_vcg_disj_lift
-               tcbSchedDequeue_not_in_queue
-               tcbSchedDequeue_valid_queues
-               tcbSchedDequeue_ct_in_state'[simplified ct_in_state'_def] | simp add: etcb_relation_def)+)[1]
-   apply clarsimp
+           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 (force simp: state_relation_def elim: valid_objs'_maxDomain valid_objs'_maxPriority)
+  apply clarsimp
   done
 
-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)
+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 (clarsimp simp: valid_sched_def valid_sched_action_def)
+   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 x) (setMCPriority t x)"
+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 exst_same_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>
@@ -694,100 +656,26 @@ 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)
-               (tcb_at' t)
+     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
-  apply (clarsimp simp add: threadset_corresT [OF _ x y e])
+  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]
 
-crunch sch_act[wp]: tcbSchedEnqueue "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
-  (simp: unless_def)
-
-crunch vq'[wp]: getCurThread valid_queues'
-
 lemma tcbSchedDequeue_sch_act_simple[wp]:
   "tcbSchedDequeue t \<lbrace>sch_act_simple\<rbrace>"
   by (wpsimp simp: sch_act_simple_def)
 
-lemma setP_vq[wp]:
-  "\<lbrace>\<lambda>s. Invariants_H.valid_queues s \<and> tcb_at' t s \<and> sch_act_wf (ksSchedulerAction s) s \<and> valid_objs' s \<and> p \<le> maxPriority\<rbrace>
-     setPriority t p
-   \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: setPriority_def)
-  apply (wpsimp )
-    apply (wp hoare_vcg_imp_lift')
-      unfolding st_tcb_at'_def
-      apply (strengthen not_obj_at'_strengthen)
-      apply (wp hoare_wp_combs)
-     apply (wp hoare_vcg_imp_lift')
-      apply (wp threadSet_valid_queues threadSet_valid_objs_tcbPriority_update)
-      apply(wp threadSet_weak_sch_act_wf)
-       apply clarsimp
-      apply clarsimp
-     apply (wp hoare_vcg_imp_lift')
-     apply (wp threadSet_valid_queues threadSet_valid_objs_tcbPriority_update threadSet_sch_act, clarsimp)
-    apply (wp add:threadSet_valid_queues comb:hoare_drop_imps )
-   apply (clarsimp simp: eq_commute[where a=t])
-   apply (wp add: threadSet_valid_queues threadSet_valid_objs_tcbPriority_update threadSet_weak_sch_act_wf
-                     hoare_vcg_imp_lift'[where P="\<lambda>_ s. ksCurThread s \<noteq> _"] hoare_drop_imps hoare_vcg_all_lift
-                     tcbSchedDequeue_not_in_queue tcbSchedEnqueue_valid_objs' tcbSchedDequeue_valid_queues
-           | clarsimp simp: valid_objs'_maxDomain valid_objs'_maxPriority)+
-  done
-
-lemma valid_queues_subsetE':
-  "\<lbrakk> valid_queues' s; ksPSpace s = ksPSpace s';
-     \<forall>x. set (ksReadyQueues s x) \<subseteq> set (ksReadyQueues s' x) \<rbrakk>
-   \<Longrightarrow> valid_queues' s'"
-  by (simp add: valid_queues'_def obj_at'_def
-                ps_clear_def subset_iff projectKOs)
-
-crunch vq'[wp]: getCurThread valid_queues'
-
-lemma setP_vq'[wp]:
-  "\<lbrace>\<lambda>s. valid_queues' s \<and> tcb_at' t s \<and> sch_act_wf (ksSchedulerAction s) s \<and> p \<le> maxPriority\<rbrace>
-     setPriority t p
-   \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (simp add: setPriority_def)
-  apply (wpsimp wp: threadSet_valid_queues' hoare_drop_imps
-                    threadSet_weak_sch_act_wf threadSet_sch_act)
-   apply (rule_tac Q="\<lambda>_ s. valid_queues' s \<and> obj_at' (Not \<circ> tcbQueued) t s \<and> sch_act_wf (ksSchedulerAction s) s
-                      \<and> weak_sch_act_wf (ksSchedulerAction s) s" in hoare_strengthen_post,
-    wp tcbSchedDequeue_valid_queues' tcbSchedDequeue_not_queued)
-   apply (clarsimp simp: inQ_def)
-   apply normalise_obj_at'
-  apply clarsimp
-  done
-
-lemma setQueue_invs_bits[wp]:
-  "\<lbrace>valid_pspace'\<rbrace> setQueue d p q \<lbrace>\<lambda>rv. valid_pspace'\<rbrace>"
-  "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace> setQueue d p q \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  "\<lbrace>\<lambda>s. sym_refs (state_refs_of' s)\<rbrace> setQueue d p q \<lbrace>\<lambda>rv s. sym_refs (state_refs_of' s)\<rbrace>"
-  "\<lbrace>\<lambda>s. sym_hyp_refs (state_refs_of' s)\<rbrace> setQueue d p q \<lbrace>\<lambda>rv s. sym_hyp_refs (state_refs_of' s)\<rbrace>"
-  "\<lbrace>if_live_then_nonz_cap'\<rbrace> setQueue d p q \<lbrace>\<lambda>rv. if_live_then_nonz_cap'\<rbrace>"
-  "\<lbrace>if_unsafe_then_cap'\<rbrace> setQueue d p q \<lbrace>\<lambda>rv. if_unsafe_then_cap'\<rbrace>"
-  "\<lbrace>cur_tcb'\<rbrace> setQueue d p q \<lbrace>\<lambda>rv. cur_tcb'\<rbrace>"
-  "\<lbrace>valid_global_refs'\<rbrace> setQueue d p q \<lbrace>\<lambda>rv. valid_global_refs'\<rbrace>"
-  "\<lbrace>valid_irq_handlers'\<rbrace> setQueue d p q \<lbrace>\<lambda>rv. valid_irq_handlers'\<rbrace>"
-   by (simp add: setQueue_def tcb_in_cur_domain'_def
-         | wp sch_act_wf_lift cur_tcb_lift
-         | fastforce)+
-
-lemma setQueue_ex_idle_cap[wp]:
-  "\<lbrace>\<lambda>s. ex_nonz_cap_to' (ksIdleThread s) s\<rbrace>
-   setQueue d p q
-   \<lbrace>\<lambda>rv s. ex_nonz_cap_to' (ksIdleThread s) s\<rbrace>"
-  by (simp add: setQueue_def, wp,
-      simp add: ex_nonz_cap_to'_def cte_wp_at_pspaceI)
-
 lemma tcbPriority_caps_safe:
   "\<forall>tcb. \<forall>x\<in>ran tcb_cte_cases. (\<lambda>(getF, setF). getF (tcbPriority_update f tcb) = getF tcb) x"
   by (rule all_tcbI, rule ball_tcb_cte_casesI, simp+)
@@ -796,22 +684,41 @@ lemma tcbPriority_Queued_caps_safe:
   "\<forall>tcb. \<forall>x\<in>ran tcb_cte_cases. (\<lambda>(getF, setF). getF (tcbPriority_update f (tcbQueued_update g tcb)) = getF tcb) x"
   by (rule all_tcbI, rule ball_tcb_cte_casesI, simp+)
 
+lemma tcbSchedNext_update_tcb_cte_cases:
+  "(a, b) \<in> ran tcb_cte_cases \<Longrightarrow> a (tcbPriority_update f tcb) = a tcb"
+  unfolding tcb_cte_cases_def
+  by (case_tac tcb; fastforce simp: objBits_simps')
+
+lemma threadSet_priority_invs':
+  "\<lbrace>invs' and tcb_at' t and K (p \<le> maxPriority)\<rbrace>
+   threadSet (tcbPriority_update (\<lambda>_. p)) t
+   \<lbrace>\<lambda>_. invs'\<rbrace>"
+  apply (rule hoare_gen_asm)
+  apply (simp add: invs'_def valid_state'_def split del: if_split)
+  apply (wp threadSet_valid_pspace'
+            threadSet_sch_actT_P[where P=False, simplified]
+            threadSet_state_refs_of'T[where f'=id]
+            threadSet_state_hyp_refs_of'
+            threadSet_iflive'T
+            threadSet_ifunsafe'T
+            threadSet_idle'T
+            valid_irq_node_lift
+            valid_irq_handlers_lift''
+            threadSet_ctes_ofT
+            threadSet_not_inQ
+            threadSet_ct_idle_or_in_cur_domain'
+            threadSet_cur
+            untyped_ranges_zero_lift
+            sym_heap_sched_pointers_lift threadSet_valid_sched_pointers
+            threadSet_tcbSchedPrevs_of threadSet_tcbSchedNexts_of
+         | clarsimp simp: cteCaps_of_def tcbSchedNext_update_tcb_cte_cases | rule refl)+
+  apply (clarsimp simp: o_def)
+  by (auto simp: obj_at'_def)
+
 lemma setP_invs':
   "\<lbrace>invs' and tcb_at' t and K (p \<le> maxPriority)\<rbrace> setPriority t p \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (rule hoare_gen_asm)
-  apply (simp add: setPriority_def)
-  apply (wp rescheduleRequired_all_invs_but_ct_not_inQ valid_irq_node_lift
-        | simp add: if_apply_def2)+
-    apply (rule hoare_strengthen_post, rule threadSet_invs_trivial, simp+)
-    apply (clarsimp simp: invs'_def valid_state'_def invs_valid_objs' elim!: st_tcb_ex_cap'')
-    apply auto[1]
-   apply (rule_tac Q="\<lambda>_. invs' and obj_at' (Not \<circ> tcbQueued) t
-                               and (\<lambda>s. \<forall>d p. t \<notin> set (ksReadyQueues s (d,p)))"
-           in hoare_post_imp)
-   apply (clarsimp dest: obj_at_ko_at' simp: obj_at'_def inQ_def)
-   apply (wp tcbSchedDequeue_not_queued)+
-  apply (clarsimp)+
-  done
+  unfolding setPriority_def
+  by (wpsimp wp: rescheduleRequired_invs' threadSet_priority_invs')
 
 crunches setPriority, setMCPriority
   for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
@@ -1105,11 +1012,6 @@ lemma setMCPriority_valid_objs'[wp]:
 crunch sch_act_simple[wp]: setMCPriority sch_act_simple
   (wp: ssa_sch_act_simple crunch_wps rule: sch_act_simple_lift simp: crunch_simps)
 
-(* For some reason, when this was embedded in a larger expression clarsimp wouldn't remove it. Adding it as a simp rule does *)
-lemma inQ_tc_corres_helper:
-  "(\<forall>d p. (\<exists>tcb. tcbQueued tcb \<and> tcbPriority tcb = p \<and> tcbDomain tcb = d \<and> (tcbQueued tcb \<longrightarrow> tcbDomain tcb \<noteq> d)) \<longrightarrow> a \<notin> set (ksReadyQueues s (d, p))) = True"
-  by clarsimp
-
 abbreviation "valid_option_prio \<equiv> case_option True (\<lambda>(p, auth). p \<le> maxPriority)"
 
 definition valid_tcb_invocation :: "tcbinvocation \<Rightarrow> bool" where
@@ -1117,107 +1019,95 @@ definition valid_tcb_invocation :: "tcbinvocation \<Rightarrow> bool" where
         ThreadControl _ _ _ mcp p _ _ _ \<Rightarrow> valid_option_prio p \<and> valid_option_prio mcp
       | _                           \<Rightarrow> True"
 
-lemma threadcontrol_corres_helper1:
+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 and valid_etcbs\<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 (wpsimp wp: set_object_wp)
+   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)
-  apply (erule_tac x=a in allE)+
-  apply (clarsimp simp: is_tcb_def)
   done
 
-lemma threadcontrol_corres_helper2:
-  "is_aligned a msg_align_bits \<Longrightarrow> \<lbrace>invs' and tcb_at' t\<rbrace>
-      threadSet (tcbIPCBuffer_update (\<lambda>_. a)) t
-           \<lbrace>\<lambda>x s. Invariants_H.valid_queues s \<and> valid_queues' s \<and> weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  by (wp threadSet_invs_trivial
-    | strengthen  invs_valid_queues' invs_queues invs_weak_sch_act_wf
-    | clarsimp simp: inQ_def )+
-
 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>x. weak_valid_sched_action and valid_etcbs \<rbrace>"
-  apply (rule hoare_pre)
-   apply (wp check_cap_inv | simp add:)+
-  by (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)
+  "\<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 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>x. Invariants_H.valid_queues and valid_queues' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)\<rbrace>"
-  apply (wp
-       | strengthen  invs_valid_queues' invs_queues invs_weak_sch_act_wf
-       | clarsimp simp: )+
+  \<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>_ 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 isArchObjectCap_def isNotificationCap_def isEndpointCap_def
-                     isReplyCap_def isIRQControlCap_def tcb_cnode_index_def cte_map_def cte_wp_at'_def
+      clarsimp simp: capBadge_def isCap_simps tcb_cnode_index_def cte_map_def cte_wp_at'_def
                      cte_level_bits_def)
 
+crunches cap_delete
+  for pspace_alinged[wp]: "pspace_aligned :: det_ext state \<Rightarrow> _"
+  and pspace_distinct[wp]: "pspace_distinct :: det_ext state \<Rightarrow> _"
+  (simp: crunch_simps preemption_point_def wp: crunch_wps OR_choiceE_weak_wp)
+
+lemmas check_cap_pspace_aligned[wp] = check_cap_inv[of pspace_aligned]
+lemmas check_cap_pspace_distinct[wp] = check_cap_inv[of pspace_distinct]
+
 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 \<and> tcbDomain (F tcb) = tcbDomain tcb"
-  assumes a: "\<forall>tcb. tcbBoundNotification (F tcb) = tcbBoundNotification 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 r: "\<forall>tcb. atcbVCPUPtr (tcbArch (F tcb)) = atcbVCPUPtr (tcbArch tcb)"
+  assumes
+    "\<forall>tcb. \<forall>(getF,setF) \<in> ran tcb_cte_cases. getF (F tcb) = getF tcb"
+    "\<forall>tcb. tcbState (F tcb) = tcbState tcb \<and> tcbDomain (F tcb) = tcbDomain 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 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"
+    "\<forall>tcb. atcbVCPUPtr (tcbArch (F tcb)) = atcbVCPUPtr (tcbArch tcb)"
   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. \<not> tcbQueued tcb \<and> tcbQueued (F tcb)) \<longrightarrow> ex_nonz_cap_to' t s \<and> t \<noteq> ksCurThread s)
-        \<and> (\<forall>tcb. tcbQueued (F tcb) \<and> ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> tcbQueued tcb \<or> t \<noteq> ksCurThread s)\<rbrace>
-        threadSet F t
-   \<lbrace>\<lambda>rv. invs'\<rbrace>"
-proof -
-  from z have domains: "\<And>tcb. tcbDomain (F tcb) = tcbDomain tcb" by blast
-  note threadSet_sch_actT_P[where P=False, simplified]
-  have y: "\<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 valid_state'_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_state_refs_of'T[where f'=id]
-              threadSet_state_hyp_refs_of'
-              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_cur
-              untyped_ranges_zero_lift
-            |clarsimp simp: y z a r domains cteCaps_of_def valid_arch_tcb'_def|rule refl)+
-   apply (clarsimp simp: obj_at'_def projectKOs pred_tcb_at'_def)
-   apply (clarsimp simp: cur_tcb'_def valid_irq_node'_def valid_queues'_def o_def)
-  by (fastforce simp: domains ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def z a)
-qed
+  "\<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_state_hyp_refs_of'
+             threadSet_idle'T
+             threadSet_not_inQ
+             threadSet_ct_idle_or_in_cur_domain'
+             threadSet_cur
+          | clarsimp simp: assms cteCaps_of_def valid_arch_tcb'_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>"
@@ -1228,10 +1118,6 @@ 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)
@@ -1245,6 +1131,16 @@ 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)
 
+crunches option_update_thread
+  for aligned[wp]: pspace_aligned
+  and distinct[wp]: pspace_distinct
+
+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'"
@@ -1287,8 +1183,8 @@ lemma transferCaps_corres:
     (invokeTCB (tcbinvocation.ThreadControl a sl' b' mcp_auth p_auth e' f' g'))"
 proof -
   have P: "\<And>t v. corres dc
-               (tcb_at t)
-               (tcb_at' t)
+               (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 ()
@@ -1298,8 +1194,8 @@ proof -
     apply (safe, case_tac tcb', simp add: tcb_relation_def split: option.split)
     done
   have R: "\<And>t v. corres dc
-               (tcb_at t)
-               (tcb_at' t)
+               (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)"
@@ -1312,7 +1208,7 @@ proof -
                    (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) (tcb_at' t)
+  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)
@@ -1436,10 +1332,20 @@ proof -
              apply (rule corres_split[OF getCurThread_corres], clarsimp)
                apply (rule corres_when[OF refl rescheduleRequired_corres])
               apply (wpsimp wp: gct_wp)+
-            apply (wp hoare_drop_imp)
-            apply (rule threadcontrol_corres_helper1[unfolded pred_conj_def])
-           apply (wp hoare_drop_imp)
-           apply (wp threadcontrol_corres_helper2 | wpc | simp)+
+            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
@@ -1467,10 +1373,10 @@ proof -
                    cap_delete_valid_cap cteDelete_deletes
                    cteDelete_invs'
                    | strengthen use_no_cap_to_obj_asid_strg
-                   | clarsimp simp: inQ_def inQ_tc_corres_helper)+
+                   | clarsimp simp: inQ_def)+
        apply (clarsimp simp: cte_wp_at_caps_of_state
                       dest!: is_cnode_or_valid_arch_cap_asid)
-       apply (clarsimp simp: emptyable_def)
+       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)
@@ -1542,40 +1448,25 @@ proof -
                  apply wp
                 apply wp
                apply (wpsimp wp: hoare_vcg_const_imp_lift_R hoare_vcg_const_imp_lift
-                                 hoare_vcg_all_lift_R hoare_vcg_all_lift as_user_invs cap_delete_deletes
-                                 thread_set_ipc_tcb_cap_valid thread_set_tcb_ipc_buffer_cap_cleared_invs
-                                 thread_set_cte_wp_at_trivial thread_set_valid_cap cap_delete_valid_cap
-                                 reschedule_preserves_valid_sched thread_set_not_state_valid_sched
+                                 hoare_vcg_all_lift_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]
-                           simp: ran_tcb_cap_cases)
+                                 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_drop_imps)
-              apply ((wpsimp wp: hoare_vcg_const_imp_lift hoare_vcg_imp_lift' hoare_vcg_all_lift
-                                       threadSet_cte_wp_at' threadSet_invs_trivialT2 cteDelete_invs'
-                                 simp: tcb_cte_cases_def), (fastforce+)[6])
-                   apply wpsimp
-                  apply (wpsimp wp: hoare_vcg_const_imp_lift hoare_drop_imps hoare_vcg_all_lift
-                                    threadSet_invs_trivialT2 threadSet_cte_wp_at'
-                              simp: tcb_cte_cases_def, (fastforce+)[6])
-                  apply wpsimp
-                  apply (wpsimp wp: hoare_vcg_const_imp_lift hoare_drop_imps hoare_vcg_all_lift
-                                    rescheduleRequired_invs' threadSet_cte_wp_at'
-                              simp: tcb_cte_cases_def)
-                 apply (wpsimp wp: hoare_vcg_const_imp_lift hoare_drop_imps hoare_vcg_all_lift
-                                   rescheduleRequired_invs' threadSet_invs_trivialT2 threadSet_cte_wp_at'
-                             simp: tcb_cte_cases_def, (fastforce+)[6])
-                  apply wpsimp
-                 apply (wpsimp wp: hoare_vcg_const_imp_lift hoare_drop_imps hoare_vcg_all_lift
-                                   rescheduleRequired_invs' threadSet_invs_trivialT2 threadSet_cte_wp_at'
-                             simp: tcb_cte_cases_def, (fastforce+)[6])
-                 apply wpsimp
-                 apply (wpsimp wp: hoare_vcg_const_imp_lift hoare_drop_imps hoare_vcg_all_lift
-                                   rescheduleRequired_invs' threadSet_cap_to' threadSet_invs_trivialT2
-                                   threadSet_cte_wp_at' hoare_drop_imps
-                               simp: tcb_cte_cases_def)
-                apply (clarsimp)
+               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_lift_R hoare_vcg_all_lift
                                    hoare_vcg_const_imp_lift_R hoare_vcg_const_imp_lift
                                    threadSet_valid_objs' thread_set_not_state_valid_sched
@@ -1588,9 +1479,9 @@ proof -
                         | strengthen tcb_cap_always_valid_strg
                                    tcb_at_invs
                                    use_no_cap_to_obj_asid_strg
-                        | (erule exE, clarsimp simp: word_bits_def))+)
+                        | (erule exE, clarsimp simp: word_bits_def) | wp (once) hoare_drop_imps)+)
                 apply (strengthen valid_tcb_ipc_buffer_update)
-                apply (strengthen invs_valid_objs')+
+                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
@@ -1630,6 +1521,7 @@ proof -
                            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
+                           invs_psp_aligned invs_distinct
                      cong: conj_cong imp_cong
                     split: option.split_asm)
     by (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def objBits_defs
@@ -1718,7 +1610,7 @@ lemma setSchedulerAction_invs'[wp]:
   apply (simp add: setSchedulerAction_def)
   apply wp
   apply (clarsimp simp add: invs'_def valid_state'_def valid_irq_node'_def
-                valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs cur_tcb'_def
+                valid_queues_def bitmapQ_defs cur_tcb'_def
                 ct_not_inQ_def)
   apply (simp add: ct_idle_or_in_cur_domain'_def)
   done
@@ -1849,8 +1741,8 @@ lemma invokeTCB_corres:
            apply (rule TcbAcc_R.rescheduleRequired_corres)
           apply (rule corres_trivial, simp)
          apply (wpsimp wp: hoare_drop_imp)+
-   apply (clarsimp simp: valid_sched_weak_strg einvs_valid_etcbs)
-  apply (clarsimp simp: Tcb_R.invs_valid_queues' Invariants_H.invs_queues)
+   apply (fastforce dest: valid_sched_valid_queues simp: valid_sched_weak_strg einvs_valid_etcbs)
+  apply fastforce
   done
 
 lemma tcbBoundNotification_caps_safe[simp]:
@@ -1865,6 +1757,10 @@ lemma valid_bound_ntfn_lift:
   apply (wp typ_at_lifts[OF P])+
   done
 
+crunches 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
@@ -1877,7 +1773,7 @@ lemma bindNotification_invs':
   apply (simp add: bindNotification_def invs'_def valid_state'_def)
   apply (rule hoare_seq_ext[OF _ get_ntfn_sp'])
   apply (rule hoare_pre)
-   apply (wp set_ntfn_valid_pspace' sbn_sch_act' sbn_valid_queues valid_irq_node_lift
+   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)+
@@ -2048,7 +1944,7 @@ lemma eq_ucast_word8[simp]:
   done
 
 lemma checkPrio_corres:
-  "corres (ser \<oplus> dc) (tcb_at auth) (tcb_at' auth)
+  "corres (ser \<oplus> dc) (tcb_at auth and pspace_aligned and pspace_distinct) \<top>
      (check_prio p auth) (checkPrio p auth)"
   apply (simp add: check_prio_def checkPrio_def)
   apply (rule corres_guard_imp)
@@ -2071,7 +1967,7 @@ lemma decodeSetPriority_corres:
   "\<lbrakk> cap_relation cap cap'; is_thread_cap cap;
      list_all2 (\<lambda>(c, sl) (c', sl'). cap_relation c c' \<and> sl' = cte_map sl) extras extras' \<rbrakk> \<Longrightarrow>
    corres (ser \<oplus> tcbinv_relation)
-       (cur_tcb and valid_etcbs and (\<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')"
@@ -2083,14 +1979,13 @@ lemma decodeSetPriority_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 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;
      list_all2 (\<lambda>(c, sl) (c', sl'). cap_relation c c' \<and> sl' = cte_map sl) extras extras' \<rbrakk> \<Longrightarrow>
    corres (ser \<oplus> tcbinv_relation)
-       (cur_tcb and valid_etcbs and (\<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_mcpriority args cap slot extras)
        (decodeSetMCPriority args cap' extras')"
@@ -2102,14 +1997,7 @@ lemma decodeSetMCPriority_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 simp: valid_cap_def valid_cap'_def)+
-  done
-
-lemma valid_objs'_maxPriority':
-  "\<And>s t. \<lbrakk> valid_objs' s; tcb_at' t s \<rbrakk> \<Longrightarrow> obj_at' (\<lambda>tcb. tcbMCP tcb \<le> maxPriority) t s"
-  apply (erule (1) valid_objs_valid_tcbE)
-  apply (clarsimp simp: valid_tcb'_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>"
@@ -2204,7 +2092,8 @@ lemma decodeSetSchedParams_corres:
   "\<lbrakk> cap_relation cap cap'; is_thread_cap cap;
      list_all2 (\<lambda>(c, sl) (c', sl'). cap_relation c c' \<and> sl' = cte_map sl) extras extras' \<rbrakk> \<Longrightarrow>
    corres (ser \<oplus> tcbinv_relation)
-       (cur_tcb and valid_etcbs and (\<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_sched_params args cap slot extras)
        (decodeSetSchedParams args cap' extras')"
@@ -2632,8 +2521,7 @@ notes if_cong[cong] shows
 
 lemma decodeUnbindNotification_corres:
   "corres (ser \<oplus> tcbinv_relation)
-      (tcb_at t)
-      (tcb_at' t)
+     (tcb_at t and pspace_aligned and pspace_distinct) \<top>
      (decode_unbind_notification (cap.ThreadCap t))
      (decodeUnbindNotification (capability.ThreadCap t))"
   apply (simp add: decode_unbind_notification_def decodeUnbindNotification_def)
@@ -2683,7 +2571,7 @@ lemma decodeTCBInvocation_corres:
              corres_guard_imp[OF decodeBindNotification_corres]
              corres_guard_imp[OF decodeUnbindNotification_corres]
              corres_guard_imp[OF decodeSetTLSBase_corres],
-         simp_all add: valid_cap_simps valid_cap_simps' invs_def valid_sched_def)
+         simp_all add: valid_cap_simps valid_cap_simps' invs_def valid_state_def valid_sched_def)
   apply (auto simp: list_all2_map1 list_all2_map2
              elim!: list_all2_mono)
   done
diff --git a/proof/refine/ARM_HYP/Untyped_R.thy b/proof/refine/ARM_HYP/Untyped_R.thy
index ce364fdf23..f5c0c6452b 100644
--- a/proof/refine/ARM_HYP/Untyped_R.thy
+++ b/proof/refine/ARM_HYP/Untyped_R.thy
@@ -1360,6 +1360,7 @@ crunches 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)"
+
 crunches insertNewCap
   for ksInterrupt[wp]: "\<lambda>s. P (ksInterruptState s)"
   and norq[wp]: "\<lambda>s. P (ksReadyQueues s)"
@@ -1367,22 +1368,16 @@ crunches insertNewCap
   and ksDomSchedule[wp]: "\<lambda>s. P (ksDomSchedule s)"
   and ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
   and ksCurThread[wp]: "\<lambda>s. P (ksCurThread s)"
+  and sched_queues_projs[wp]: "\<lambda>s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)"
+  and tcbQueueds_of[wp]: "\<lambda>s. P (tcbQueued |< tcbs_of' s)"
+  and valid_sched_pointers[wp]: valid_sched_pointers
   (wp: crunch_wps)
+
 crunch nosch[wp]: insertNewCaps "\<lambda>s. P (ksSchedulerAction s)"
   (simp: crunch_simps zipWithM_x_mapM wp: crunch_wps)
 
 crunch exst[wp]: set_cdt "\<lambda>s. P (exst s)"
 
-(*FIXME: Move to StateRelation*)
-lemma state_relation_schact[elim!]:
-  "(s,s') \<in> state_relation \<Longrightarrow> sched_act_relation (scheduler_action s) (ksSchedulerAction s')"
-  apply (simp add: state_relation_def)
-  done
-
-lemma state_relation_queues[elim!]: "(s,s') \<in> state_relation \<Longrightarrow> ready_queues_relation (ready_queues s) (ksReadyQueues s')"
-  apply (simp add: state_relation_def)
-  done
-
 lemma set_original_symb_exec_l:
   "corres_underlying {(s, s'). f (kheap s) (exst s) s'} nf 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)
@@ -1413,6 +1408,10 @@ lemma updateNewFreeIndex_noop_psp_corres:
         | simp add: updateTrackedFreeIndex_def getSlotCap_def)+
   done
 
+crunches 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]
 shows
@@ -3656,7 +3655,7 @@ lemma updateFreeIndex_clear_invs':
        apply (wp valid_irq_node_lift setCTE_typ_at')
       apply (wp getCTE_wp)
      apply (simp add:updateCap_def)
-     apply (wp irqs_masked_lift valid_queues_lift' cur_tcb_lift ct_idle_or_in_cur_domain'_lift
+     apply (wp irqs_masked_lift cur_tcb_lift ct_idle_or_in_cur_domain'_lift valid_bitmaps_lift
                 hoare_vcg_disj_lift untyped_ranges_zero_lift getCTE_wp setCTE_irq_handlers'
                | wp (once) hoare_use_eq[where f="gsUntypedZeroRanges"]
                | simp add: getSlotCap_def
@@ -4222,14 +4221,12 @@ context begin interpretation Arch . (*FIXME: arch_split*)
 lemma resetUntypedCap_corres:
   "untypinv_relation ui ui'
     \<Longrightarrow> corres (dc \<oplus> dc)
-    (invs 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)
@@ -5064,7 +5061,7 @@ lemma inv_untyped_corres':
       apply (clarsimp simp only: pred_conj_def invs ui)
       apply (strengthen vui)
       apply (cut_tac vui invs invs')
-      apply (clarsimp simp: cte_wp_at_caps_of_state valid_sched_etcbs)
+      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
@@ -5227,9 +5224,6 @@ crunch irq_states' [wp]: insertNewCap valid_irq_states'
 crunch pde_mappings' [wp]: insertNewCap valid_pde_mappings'
   (wp: getCTE_wp')
 
-crunch vq'[wp]: insertNewCap valid_queues'
-  (wp: crunch_wps)
-
 crunch irqs_masked' [wp]: insertNewCap irqs_masked'
   (wp: crunch_wps rule: irqs_masked_lift)
 
@@ -5320,8 +5314,8 @@ lemma insertNewCap_invs':
   apply (simp add: invs'_def valid_state'_def)
   apply (rule hoare_pre)
    apply (wp insertNewCap_valid_pspace' sch_act_wf_lift
-             valid_queues_lift cur_tcb_lift tcb_in_cur_domain'_lift
-             insertNewCap_valid_global_refs'
+             cur_tcb_lift tcb_in_cur_domain'_lift valid_bitmaps_lift
+             insertNewCap_valid_global_refs' sym_heap_sched_pointers_lift
              valid_irq_node_lift insertNewCap_valid_irq_handlers)
   apply (clarsimp simp: cte_wp_at_ctes_of)
   apply (frule ctes_of_valid[rotated, where p=parent, OF valid_pspace_valid_objs'])
diff --git a/proof/refine/ARM_HYP/VSpace_R.thy b/proof/refine/ARM_HYP/VSpace_R.thy
index b067dc1d6f..f72b52e088 100644
--- a/proof/refine/ARM_HYP/VSpace_R.thy
+++ b/proof/refine/ARM_HYP/VSpace_R.thy
@@ -616,11 +616,6 @@ lemma setVCPU_ksQ[wp]:
   "\<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace> setObject p (v::vcpu) \<lbrace>\<lambda>rv s. P (ksReadyQueues s)\<rbrace>"
   by (wp setObject_qs updateObject_default_inv | simp)+
 
-lemma setVCPU_valid_queues'[wp]:
-  "setObject v (vcpu::vcpu) \<lbrace>valid_queues'\<rbrace>"
-  unfolding valid_queues'_def
-  by (rule hoare_lift_Pf[where f=ksReadyQueues]; wp hoare_vcg_all_lift updateObject_default_inv)
-
 lemma setVCPU_ct_not_inQ[wp]:
   "setObject v (vcpu::vcpu) \<lbrace>ct_not_inQ\<rbrace>"
   apply (wp ct_not_inQ_lift)
@@ -629,8 +624,8 @@ lemma setVCPU_ct_not_inQ[wp]:
   done
 
 lemma handleVMFault_corres:
-  "corres (fr \<oplus> dc) (tcb_at thread) (tcb_at' thread)
-          (handle_vm_fault thread fault) (handleVMFault thread fault)"
+  "corres (fr \<oplus> dc) (tcb_at thread and pspace_aligned and pspace_distinct) \<top>
+     (handle_vm_fault thread fault) (handleVMFault thread fault)"
   apply (simp add: ARM_HYP_H.handleVMFault_def)
   apply (cases fault)
    apply simp
@@ -2705,8 +2700,8 @@ lemma message_info_from_data_eqv:
 
 lemma setMessageInfo_corres:
  "mi' = message_info_map mi \<Longrightarrow>
-  corres dc (tcb_at t) (tcb_at' t)
-         (set_message_info t mi) (setMessageInfo t mi')"
+  corres dc (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+    (set_message_info t mi) (setMessageInfo t mi')"
   apply (simp add: setMessageInfo_def set_message_info_def)
   apply (subgoal_tac "wordFromMessageInfo (message_info_map mi) =
                       message_info_to_data mi")
@@ -3576,23 +3571,6 @@ lemma setVCPU_valid_arch':
      apply (wp hoare_vcg_all_lift hoare_drop_imp)+
 done
 
-lemma setVCPU_valid_queues [wp]:
-  "\<lbrace>valid_queues\<rbrace> setObject p (v::vcpu) \<lbrace>\<lambda>_. valid_queues\<rbrace>"
-  by (wp valid_queues_lift | simp add: pred_tcb_at'_def)+
-
-crunches
-  vcpuDisable, vcpuRestore, vcpuEnable, vcpuUpdate, vcpuSaveRegRange, vgicUpdateLR
-  for valid_queues[wp]: valid_queues
-  (ignore: doMachineOp wp: mapM_x_wp)
-
-lemma vcpuSave_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> vcpuSave param_a \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  by (wpsimp simp: vcpuSave_def armvVCPUSave_def wp: mapM_x_wp cong: option.case_cong_weak | simp)+
-
-lemma vcpuSwitch_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> vcpuSwitch param_a \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  by (wpsimp simp: vcpuSwitch_def modifyArchState_def | simp)+
-
 lemma isb_invs_no_cicd'[wp]:
   "\<lbrace>invs_no_cicd'\<rbrace> doMachineOp isb \<lbrace>\<lambda>rv. invs_no_cicd'\<rbrace>"
   apply (wpsimp wp: dmo_invs_no_cicd' no_irq no_irq_isb)
@@ -3687,6 +3665,10 @@ lemma get_gic_vcpu_ctrl_vmcr_invs_no_cicd'[wp]:
   by (wpsimp wp: dmo_invs_no_cicd' no_irq_get_gic_vcpu_ctrl_vmcr no_irq
            simp: get_gic_vcpu_ctrl_vmcr_def gets_def in_monad)
 
+lemma setVCPU_tcbs_of'[wp]:
+  "setObject v (vcpu :: vcpu) \<lbrace>\<lambda>s. P' (tcbs_of' s)\<rbrace>"
+  by setObject_easy_cases
+
 lemma setVCPU_regs_r_invs_cicd':
   "\<lbrace>invs_no_cicd' and ko_at' vcpu v\<rbrace>
    setObject v (vcpuRegs_update (\<lambda>_. (vcpuRegs vcpu)(r:=rval)) vcpu) \<lbrace>\<lambda>_. invs_no_cicd'\<rbrace>"
@@ -3701,7 +3683,7 @@ lemma setVCPU_regs_r_invs_cicd':
                     cteCaps_of_ctes_of_lift irqs_masked_lift ct_idle_or_in_cur_domain'_lift
                     valid_irq_states_lift' hoare_vcg_all_lift hoare_vcg_disj_lift
                     valid_pde_mappings_lift' setObject_typ_at' cur_tcb_lift
-                    setVCPU_regs_valid_arch' setVCPU_regs_vcpu_live
+                    setVCPU_regs_valid_arch' setVCPU_regs_vcpu_live valid_bitmaps_lift
               simp: objBits_simps archObjSize_def vcpu_bits_def pageBits_def
                     state_refs_of'_vcpu_empty state_hyp_refs_of'_vcpu_absorb)
   apply (clarsimp simp: if_live_then_nonz_cap'_def obj_at'_real_def)
@@ -3723,7 +3705,7 @@ lemma setVCPU_vgic_invs_cicd':
                     cteCaps_of_ctes_of_lift irqs_masked_lift ct_idle_or_in_cur_domain'_lift
                     valid_irq_states_lift' hoare_vcg_all_lift hoare_vcg_disj_lift
                     valid_pde_mappings_lift' setObject_typ_at' cur_tcb_lift
-                    setVCPU_vgic_valid_arch'
+                    setVCPU_vgic_valid_arch' valid_bitmaps_lift
               simp: objBits_simps archObjSize_def vcpu_bits_def pageBits_def
                     state_refs_of'_vcpu_empty state_hyp_refs_of'_vcpu_absorb)
   apply (clarsimp simp: if_live_then_nonz_cap'_def obj_at'_real_def)
@@ -3745,7 +3727,7 @@ lemma setVCPU_VPPIMasked_invs_cicd':
                     cteCaps_of_ctes_of_lift irqs_masked_lift ct_idle_or_in_cur_domain'_lift
                     valid_irq_states_lift' hoare_vcg_all_lift hoare_vcg_disj_lift
                     valid_pde_mappings_lift' setObject_typ_at' cur_tcb_lift
-                    setVCPU_VPPIMasked_valid_arch'
+                    setVCPU_VPPIMasked_valid_arch' valid_bitmaps_lift
               simp: objBits_simps archObjSize_def vcpu_bits_def pageBits_def
                     state_refs_of'_vcpu_empty state_hyp_refs_of'_vcpu_absorb)
   apply (clarsimp simp: if_live_then_nonz_cap'_def obj_at'_real_def)
@@ -3767,7 +3749,7 @@ lemma setVCPU_VTimer_invs_cicd':
                     cteCaps_of_ctes_of_lift irqs_masked_lift ct_idle_or_in_cur_domain'_lift
                     valid_irq_states_lift' hoare_vcg_all_lift hoare_vcg_disj_lift
                     valid_pde_mappings_lift' setObject_typ_at' cur_tcb_lift
-                    setVCPU_VTimer_valid_arch'
+                    setVCPU_VTimer_valid_arch' valid_bitmaps_lift
               simp: objBits_simps archObjSize_def vcpu_bits_def pageBits_def
                     state_refs_of'_vcpu_empty state_hyp_refs_of'_vcpu_absorb)
   apply (clarsimp simp: if_live_then_nonz_cap'_def obj_at'_real_def)
@@ -3901,13 +3883,12 @@ lemma vcpuSave_invs_no_cicd'[wp]:
       | assumption)+
 
 lemma valid_arch_state'_armHSCurVCPU_update[simp]:
-  "ko_wp_at' (is_vcpu' and hyp_live') v s \<Longrightarrow>
-   valid_arch_state' s \<Longrightarrow> valid_arch_state' (s\<lparr>ksArchState := armHSCurVCPU_update (\<lambda>_. Some (v, b)) (ksArchState s)\<rparr>)"
-  by (clarsimp simp: invs'_def valid_state'_def valid_queues_def valid_queues_no_bitmap_def
-             bitmapQ_defs valid_global_refs'_def valid_arch_state'_def global_refs'_def
-             valid_queues'_def valid_irq_node'_def valid_irq_handlers'_def
-             irq_issued'_def irqs_masked'_def valid_machine_state'_def
-             cur_tcb'_def)
+  "\<lbrakk> ko_wp_at' (is_vcpu' and hyp_live') v s; valid_arch_state' s \<rbrakk> \<Longrightarrow>
+   valid_arch_state' (s\<lparr>ksArchState := armHSCurVCPU_update (\<lambda>_. Some (v, b)) (ksArchState s)\<rparr>)"
+  by (clarsimp simp: invs'_def valid_state'_def
+                     bitmapQ_defs valid_global_refs'_def valid_arch_state'_def global_refs'_def
+                     valid_irq_node'_def valid_irq_handlers'_def
+                     irq_issued'_def irqs_masked'_def valid_machine_state'_def cur_tcb'_def)
 
 lemma dmo_vcpu_hyp:
   "\<lbrace>ko_wp_at' (is_vcpu' and hyp_live') v\<rbrace> doMachineOp f \<lbrace>\<lambda>_. ko_wp_at' (is_vcpu' and hyp_live') v\<rbrace>"
@@ -3988,20 +3969,18 @@ lemma vcpuSwitch_valid_arch_state'[wp]:
 lemma invs_no_cicd'_armHSCurVCPU_update[simp]:
   "ko_wp_at' (is_vcpu' and hyp_live') v s \<Longrightarrow> invs_no_cicd' s \<Longrightarrow>
      invs_no_cicd' (s\<lparr>ksArchState := armHSCurVCPU_update (\<lambda>_. Some (v, b)) (ksArchState s)\<rparr>)"
-  by (clarsimp simp: invs_no_cicd'_def valid_state'_def valid_queues_def valid_queues_no_bitmap_def
-             bitmapQ_defs valid_global_refs'_def valid_arch_state'_def global_refs'_def
-             valid_queues'_def valid_irq_node'_def valid_irq_handlers'_def
-             irq_issued'_def irqs_masked'_def valid_machine_state'_def
-             cur_tcb'_def)
+  by (clarsimp simp: invs_no_cicd'_def valid_state'_def
+                     bitmapQ_defs valid_global_refs'_def valid_arch_state'_def global_refs'_def
+                     valid_irq_node'_def valid_irq_handlers'_def
+                     irq_issued'_def irqs_masked'_def valid_machine_state'_def cur_tcb'_def)
 
 lemma invs'_armHSCurVCPU_update[simp]:
   "ko_wp_at' (is_vcpu' and hyp_live') v s \<Longrightarrow>
    invs' s \<Longrightarrow> invs' (s\<lparr>ksArchState := armHSCurVCPU_update (\<lambda>_. Some (v, b)) (ksArchState s)\<rparr>)"
-  apply (clarsimp simp: invs'_def valid_state'_def valid_queues_def valid_queues_no_bitmap_def
-             bitmapQ_defs valid_global_refs'_def valid_arch_state'_def global_refs'_def
-             valid_queues'_def valid_irq_node'_def valid_irq_handlers'_def
-             irq_issued'_def irqs_masked'_def valid_machine_state'_def
-             cur_tcb'_def)
+  apply (clarsimp simp: invs'_def valid_state'_def
+                        bitmapQ_defs valid_global_refs'_def valid_arch_state'_def global_refs'_def
+                        valid_irq_node'_def valid_irq_handlers'_def
+                        irq_issued'_def irqs_masked'_def valid_machine_state'_def cur_tcb'_def)
   done
 
 lemma armHSCurVCPU_None_invs'[wp]:
@@ -4025,7 +4004,7 @@ lemma setVCPU_vgic_invs':
                     cteCaps_of_ctes_of_lift irqs_masked_lift ct_idle_or_in_cur_domain'_lift
                     valid_irq_states_lift' hoare_vcg_all_lift hoare_vcg_disj_lift
                     valid_pde_mappings_lift' setObject_typ_at' cur_tcb_lift
-                    setVCPU_vgic_valid_arch'
+                    setVCPU_vgic_valid_arch' valid_bitmaps_lift
               simp: objBits_simps archObjSize_def vcpu_bits_def pageBits_def
                     state_refs_of'_vcpu_empty state_hyp_refs_of'_vcpu_absorb)
   apply (clarsimp simp: if_live_then_nonz_cap'_def obj_at'_real_def)
@@ -4045,7 +4024,7 @@ lemma setVCPU_regs_invs':
                     cteCaps_of_ctes_of_lift irqs_masked_lift ct_idle_or_in_cur_domain'_lift
                     valid_irq_states_lift' hoare_vcg_all_lift hoare_vcg_disj_lift
                     valid_pde_mappings_lift' setObject_typ_at' cur_tcb_lift
-                    setVCPU_regs_valid_arch'
+                    setVCPU_regs_valid_arch' valid_bitmaps_lift
               simp: objBits_simps archObjSize_def vcpu_bits_def pageBits_def
                     state_refs_of'_vcpu_empty state_hyp_refs_of'_vcpu_absorb)
   apply (clarsimp simp: if_live_then_nonz_cap'_def obj_at'_real_def)
@@ -4065,7 +4044,7 @@ lemma setVCPU_VPPIMasked_invs':
                     cteCaps_of_ctes_of_lift irqs_masked_lift ct_idle_or_in_cur_domain'_lift
                     valid_irq_states_lift' hoare_vcg_all_lift hoare_vcg_disj_lift
                     valid_pde_mappings_lift' setObject_typ_at' cur_tcb_lift
-                    setVCPU_VPPIMasked_valid_arch'
+                    setVCPU_VPPIMasked_valid_arch' valid_bitmaps_lift
               simp: objBits_simps archObjSize_def vcpu_bits_def pageBits_def
                     state_refs_of'_vcpu_empty state_hyp_refs_of'_vcpu_absorb)
   apply (clarsimp simp: if_live_then_nonz_cap'_def obj_at'_real_def)
@@ -4085,7 +4064,7 @@ lemma setVCPU_VTimer_invs':
                     cteCaps_of_ctes_of_lift irqs_masked_lift ct_idle_or_in_cur_domain'_lift
                     valid_irq_states_lift' hoare_vcg_all_lift hoare_vcg_disj_lift
                     valid_pde_mappings_lift' setObject_typ_at' cur_tcb_lift
-                    setVCPU_VTimer_valid_arch'
+                    setVCPU_VTimer_valid_arch' valid_bitmaps_lift
               simp: objBits_simps archObjSize_def vcpu_bits_def pageBits_def
                     state_refs_of'_vcpu_empty state_hyp_refs_of'_vcpu_absorb)
   apply (clarsimp simp: if_live_then_nonz_cap'_def obj_at'_real_def)
@@ -4481,14 +4460,6 @@ lemma storePDE_nordL2[wp]:
   "\<lbrace>\<lambda>s. P (ksReadyQueuesL2Bitmap s)\<rbrace> storePDE param_a param_b \<lbrace>\<lambda>_ s. P (ksReadyQueuesL2Bitmap s)\<rbrace>"
   by (wpsimp wp: headM_inv hoare_drop_imp simp: storePDE_def updateObject_default_def)
 
-lemma storePDE_valid_queues [wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> storePDE p pde \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  by (wp valid_queues_lift | simp add: pred_tcb_at'_def)+
-
-lemma storePDE_valid_queues' [wp]:
-  "\<lbrace>valid_queues'\<rbrace> storePDE p pde \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  by (wp valid_queues_lift')
-
 lemma storePDE_iflive [wp]:
   "\<lbrace>if_live_then_nonz_cap'\<rbrace> storePDE p pde \<lbrace>\<lambda>rv. if_live_then_nonz_cap'\<rbrace>"
   apply (wpsimp simp: storePDE_def objBits_simps archObjSize_def vspace_bits_defs
@@ -4644,6 +4615,22 @@ lemma storePTE_gsUntypedZeroRanges[wp]:
   "\<lbrace>\<lambda>s. P (gsUntypedZeroRanges s)\<rbrace> storePTE p pde \<lbrace>\<lambda>rv s. P (gsUntypedZeroRanges s)\<rbrace>"
   by (wpsimp wp: headM_inv hoare_drop_imp simp: storePTE_def updateObject_default_def setObject_def)
 
+lemma setObject_pte_tcb_of'[wp]:
+  "setObject slote (pte::pte) \<lbrace>\<lambda>s. P' (tcbs_of' s)\<rbrace>"
+  by setObject_easy_cases
+
+crunches storePTE
+  for tcbs_of'[wp]: "\<lambda>s. P (tcbs_of' s)"
+  (wp: crunch_wps)
+
+lemma setObject_pde_tcb_of'[wp]:
+  "setObject slote (pde::pde) \<lbrace>\<lambda>s. P' (tcbs_of' s)\<rbrace>"
+  by setObject_easy_cases
+
+crunches storePDE
+  for tcbs_of'[wp]: "\<lambda>s. P (tcbs_of' s)"
+  (wp: crunch_wps)
+
 lemma storePDE_invs[wp]:
   "\<lbrace>invs' and valid_pde' pde
           and (\<lambda>s. valid_pde_mapping' (p && mask pdBits) pde)\<rbrace>
@@ -4655,7 +4642,7 @@ lemma storePDE_invs[wp]:
              irqs_masked_lift
              valid_arch_state_lift' valid_irq_node_lift
              cur_tcb_lift valid_irq_handlers_lift''
-             untyped_ranges_zero_lift
+             untyped_ranges_zero_lift sym_heap_sched_pointers_lift valid_bitmaps_lift
            | simp add: cteCaps_of_def o_def)+
   apply clarsimp
   done
@@ -4687,14 +4674,6 @@ lemma storePTE_nordL2[wp]:
   "\<lbrace>\<lambda>s. P (ksReadyQueuesL2Bitmap s)\<rbrace> storePTE param_a param_b \<lbrace>\<lambda>_ s. P (ksReadyQueuesL2Bitmap s)\<rbrace>"
   by (wpsimp wp: headM_inv hoare_drop_imp simp: storePTE_def updateObject_default_def)
 
-lemma storePTE_valid_queues [wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> storePTE p pde \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  by (wp valid_queues_lift | simp add: pred_tcb_at'_def)+
-
-lemma storePTE_valid_queues' [wp]:
-  "\<lbrace>valid_queues'\<rbrace> storePTE p pde \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  by (wp valid_queues_lift')
-
 lemma storePTE_iflive [wp]:
   "\<lbrace>if_live_then_nonz_cap'\<rbrace> storePTE p pte \<lbrace>\<lambda>rv. if_live_then_nonz_cap'\<rbrace>"
   apply (wpsimp simp: storePTE_def objBits_simps archObjSize_def vspace_bits_defs
@@ -4822,7 +4801,7 @@ lemma storePTE_invs [wp]:
   apply (wp sch_act_wf_lift valid_global_refs_lift' irqs_masked_lift
             valid_arch_state_lift' valid_irq_node_lift
             cur_tcb_lift valid_irq_handlers_lift''
-            untyped_ranges_zero_lift
+            untyped_ranges_zero_lift valid_bitmaps_lift
           | simp add: cteCaps_of_def o_def)+
   apply clarsimp
   done
@@ -4868,14 +4847,6 @@ 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_valid_queues [wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  by (wp valid_queues_lift | simp add: pred_tcb_at'_def)+
-
-lemma setASIDPool_valid_queues' [wp]:
-  "\<lbrace>valid_queues'\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  by (wp valid_queues_lift')
-
 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
@@ -4998,17 +4969,22 @@ 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_state'_def valid_pspace'_def)
-  apply (wp sch_act_wf_lift valid_global_refs_lift' irqs_masked_lift
-            valid_irq_node_lift
-            cur_tcb_lift valid_irq_handlers_lift''
-            untyped_ranges_zero_lift
-            updateObject_default_inv
-          | simp add: cteCaps_of_def
-          | rule setObject_ksPSpace_only)+
-  apply (clarsimp simp: o_def)
+  apply (rule hoare_pre)
+   apply (wp sch_act_wf_lift valid_global_refs_lift' irqs_masked_lift
+              valid_irq_node_lift
+             cur_tcb_lift valid_irq_handlers_lift''
+             untyped_ranges_zero_lift
+             updateObject_default_inv valid_bitmaps_lift
+           | simp add: cteCaps_of_def
+           | rule setObject_ksPSpace_only)+
+  apply (clarsimp simp add: setObject_def o_def)
   done
 
 crunches vcpuSave, vcpuRestore, vcpuDisable, vcpuEnable
diff --git a/proof/refine/RISCV64/ADT_H.thy b/proof/refine/RISCV64/ADT_H.thy
index 12353508da..15bf6278fd 100644
--- a/proof/refine/RISCV64/ADT_H.thy
+++ b/proof/refine/RISCV64/ADT_H.thy
@@ -454,7 +454,7 @@ proof -
     apply (intro conjI impI allI)
            apply (erule pspace_dom_relatedE[OF _ pspace_relation])
            apply clarsimp
-           apply (case_tac ko; simp add: other_obj_relation_def)
+           apply (case_tac ko; simp add: tcb_relation_cut_def other_obj_relation_def)
              apply (clarsimp simp: cte_relation_def split: if_split_asm)
             apply (clarsimp simp: ep_relation_def EndpointMap_def
                             split: Structures_A.endpoint.splits)
@@ -465,7 +465,7 @@ proof -
            apply (clarsimp split: if_split_asm)+
 
           apply (erule pspace_dom_relatedE[OF _ pspace_relation])
-          apply (case_tac ko; simp add: other_obj_relation_def)
+          apply (case_tac ko; simp add: tcb_relation_cut_def other_obj_relation_def)
             apply (clarsimp simp: cte_relation_def split: if_split_asm)
            apply (clarsimp simp: ntfn_relation_def AEndpointMap_def
                            split: Structures_A.ntfn.splits)
@@ -476,7 +476,7 @@ proof -
           apply (clarsimp split: if_split_asm)+
 
          apply (erule pspace_dom_relatedE[OF _ pspace_relation])
-         apply (case_tac ko; simp add: other_obj_relation_def)
+         apply (case_tac ko; simp add: tcb_relation_cut_def other_obj_relation_def)
           apply (clarsimp simp: cte_relation_def split: if_split_asm)
          apply (rename_tac arch_kernel_obj)
          apply (case_tac arch_kernel_obj; simp add: other_obj_relation_def)
@@ -484,7 +484,7 @@ proof -
          apply (clarsimp split: if_split_asm)+
 
         apply (erule pspace_dom_relatedE[OF _ pspace_relation])
-        apply (case_tac ko, simp_all add: other_obj_relation_def)
+        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)
@@ -507,7 +507,7 @@ proof -
          apply (erule n_less_2p_pageBitsForSize)
         apply (clarsimp simp: shiftl_t2n mult_ac)
        apply (erule pspace_dom_relatedE[OF _ pspace_relation])
-       apply (case_tac ko, simp_all add: other_obj_relation_def)
+       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)
@@ -530,7 +530,7 @@ proof -
         apply (erule n_less_2p_pageBitsForSize)
        apply (clarsimp simp: shiftl_t2n mult_ac)
       apply (erule pspace_dom_relatedE[OF _ pspace_relation])
-      apply (case_tac ko, simp_all add: other_obj_relation_def)
+      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)
@@ -556,7 +556,7 @@ proof -
                                 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: other_obj_relation_def
+     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)
@@ -623,7 +623,7 @@ proof -
     (* mapping architecture-specific objects *)
     apply clarsimp
     apply (erule pspace_dom_relatedE[OF _ pspace_relation])
-    apply (case_tac ko, simp_all add: other_obj_relation_def)
+    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
@@ -660,7 +660,7 @@ proof -
       apply (clarsimp dest!: koTypeOf_pte simp: objBits_simps bit_simps)
       apply (rename_tac pte')
       apply (erule pspace_dom_relatedE[OF _ pspace_relation])
-      apply (case_tac ko; simp add: other_obj_relation_def)
+      apply (case_tac ko; simp add: tcb_relation_cut_def other_obj_relation_def)
        apply (clarsimp simp add: cte_relation_def split: if_split_asm)
       apply (rename_tac ako' y ko P ako)
       apply (case_tac ako; clarsimp simp: other_obj_relation_def bit_simps)
@@ -749,7 +749,7 @@ lemma absEkheap_correct:
    apply (case_tac "ksPSpace s' x", clarsimp)
     apply (erule_tac x=x in allE, clarsimp)
    apply clarsimp
-   apply (case_tac a, simp_all add: other_obj_relation_def)
+   apply (case_tac a, simp_all add: tcb_relation_cut_def other_obj_relation_def)
   apply (insert pspace_relation)
   apply (clarsimp simp: obj_at'_def)
   apply (erule(1) pspace_dom_relatedE)
@@ -777,7 +777,7 @@ lemma TCB_implies_KOTCB:
   apply (clarsimp simp add: pspace_relation_def pspace_dom_def
                             dom_def UNION_eq Collect_eq)
   apply (erule_tac x=a in allE)+
-  apply (clarsimp simp add: other_obj_relation_def
+  apply (clarsimp simp add: tcb_relation_cut_def
                   split: Structures_H.kernel_object.splits)
   apply (drule iffD1)
    apply (fastforce simp add: dom_def image_def)
@@ -1524,7 +1524,7 @@ definition
       domain_index_internal = ksDomScheduleIdx s,
       cur_domain_internal = ksCurDomain s,
       domain_time_internal = ksDomainTime s,
-      ready_queues_internal = curry (ksReadyQueues 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:
@@ -1532,12 +1532,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 absEkheap_correct
-                           absCDTList_correct[THEN fun_cong] state_relation_def invs_def valid_state_def
-                           ready_queues_relation_def invs'_def valid_state'_def
-                           valid_pspace_def valid_sched_def valid_pspace'_def curry_def fun_eq_iff)
-      apply (fastforce simp: absEkheap_correct)
+           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
 
 
diff --git a/proof/refine/RISCV64/ArchAcc_R.thy b/proof/refine/RISCV64/ArchAcc_R.thy
index 3beb2515cf..1465eda97a 100644
--- a/proof/refine/RISCV64/ArchAcc_R.thy
+++ b/proof/refine/RISCV64/ArchAcc_R.thy
@@ -52,27 +52,38 @@ lemma pspace_aligned_cross:
   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)
-     apply (clarsimp simp: cte_map_def)
-     apply (simp add: cteSizeBits_def cte_level_bits_def)
-     apply (rule is_aligned_add)
-      apply (erule is_aligned_weaken)
-      apply simp
-     apply (rule is_aligned_shift)
+
+      \<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_shiftl_self, simp)
+
+     \<comment>\<open>TCB\<close>
+     apply (clarsimp simp: tcbBlockSizeBits_def elim!: is_aligned_weaken)
+
+    \<comment>\<open>PageTable\<close>
+    apply (clarsimp simp: archObjSize_def pteBits_def table_size_def ptTranslationBits_def pte_bits_def)
     apply (rule is_aligned_add)
      apply (erule is_aligned_weaken)
-     apply (simp add: bit_simps)
+     apply simp
     apply (rule is_aligned_shift)
+
+  \<comment>\<open>DataPage\<close>
    apply (rule is_aligned_add)
     apply (erule is_aligned_weaken)
     apply (rule pbfs_atleast_pageBits)
    apply (rule is_aligned_shift)
+
+  \<comment>\<open>other_obj_relation\<close>
   apply (simp add: other_obj_relation_def)
   apply (clarsimp simp: bit_simps' tcbBlockSizeBits_def epSizeBits_def ntfnSizeBits_def
-                  split: kernel_object.splits Structures_A.kernel_object.splits)
-  apply (clarsimp simp: archObjSize_def split: arch_kernel_object.splits arch_kernel_obj.splits)
-  apply (erule is_aligned_weaken)
-  apply (simp add: bit_simps)
+                 split: kernel_object.splits Structures_A.kernel_object.splits)
+  apply (fastforce simp: archObjSize_def split: arch_kernel_object.splits arch_kernel_obj.splits)
   done
 
 lemma of_bl_shift_cte_level_bits:
@@ -84,10 +95,12 @@ 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)
-     apply (rule_tac x=cte_level_bits in exI)
-     apply (simp add: is_aligned_shift of_bl_shift_cte_level_bits)
+      apply (drule (1) wf_cs_nD)
+      apply (clarsimp simp: cte_map_def)
+      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=tcbBlockSizeBits in exI)
+     apply (simp add: tcbBlockSizeBits_def)
     apply (rule_tac x=pte_bits in exI)
     apply (simp add: bit_simps is_aligned_shift mask_def)
     apply word_bitwise
@@ -230,14 +243,6 @@ lemma getObject_ASIDPool_corres:
   apply (clarsimp simp: other_obj_relation_def asid_pool_relation_def)
   done
 
-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 project_inject pspace_distinct'_def pspace_aligned'_def)
-  apply (drule bspec, erule domI)+
-  apply simp
-  done
-
 lemma storePTE_cte_wp_at'[wp]:
   "storePTE ptr val \<lbrace>\<lambda>s. P (cte_wp_at' P' p s)\<rbrace>"
   apply (simp add: storePTE_def)
@@ -442,10 +447,14 @@ lemma setObject_PT_corres:
    apply (drule_tac x=p in bspec, erule domI)
    apply (simp add: other_obj_relation_def
            split: Structures_A.kernel_object.splits)
-  apply (rule conjI)
+  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
+  apply (extract_conjunct \<open>match conclusion in "ready_queues_relation_2 _ _ _ _ _" \<Rightarrow> -\<close>)
+   apply (prop_tac "typ_at' (koTypeOf (injectKO pte')) p b")
+    apply (simp add: typ_at'_def ko_wp_at'_def)
+   subgoal by (fastforce dest: tcbs_of'_non_tcb_update)
   apply (simp add: map_to_ctes_upd_other)
   apply (simp add: fun_upd_def)
   apply (simp add: caps_of_state_after_update obj_at_def swp_cte_at_caps_of)
diff --git a/proof/refine/RISCV64/Arch_R.thy b/proof/refine/RISCV64/Arch_R.thy
index a209ca58c0..f9e759cd73 100644
--- a/proof/refine/RISCV64/Arch_R.thy
+++ b/proof/refine/RISCV64/Arch_R.thy
@@ -262,11 +262,10 @@ lemma performASIDControlInvocation_corres:
               deleteObjects_cte_wp_at'
               deleteObjects_null_filter[where p="makePoolParent i'"])
    apply (clarsimp simp:invs_mdb max_free_index_def invs_untyped_children)
-   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 (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)
@@ -274,9 +273,9 @@ lemma performASIDControlInvocation_corres:
        apply (fold_subgoals (prefix))[2]
      subgoal premises prems using prems by (clarsimp simp:invs_def valid_state_def)+
       apply (clarsimp simp: schact_is_rct_def)
-     apply (clarsimp simp:cte_wp_at_caps_of_state)
+     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 (fastforce simp: cte_wp_at_caps_of_state)
     apply simp
    apply (frule_tac ptr = "(aa,ba)" in detype_invariants [rotated 3])
         apply fastforce
@@ -340,7 +339,7 @@ lemma performASIDControlInvocation_corres:
      apply (simp add:pageBits_def)
     apply clarsimp
     apply (drule(1) cte_cap_in_untyped_range)
-         apply (fastforce simp:cte_wp_at_ctes_of)
+         apply (fastforce simp: cte_wp_at_ctes_of)
         apply assumption+
      apply fastforce
     apply simp
diff --git a/proof/refine/RISCV64/Bits_R.thy b/proof/refine/RISCV64/Bits_R.thy
index b6ba101ecd..bd6bafa35f 100644
--- a/proof/refine/RISCV64/Bits_R.thy
+++ b/proof/refine/RISCV64/Bits_R.thy
@@ -73,6 +73,10 @@ lemma projectKO_tcb:
   "(projectKO_opt ko = Some t) = (ko = KOTCB t)"
   by (cases ko) (auto simp: projectKO_opts_defs)
 
+lemma tcb_of'_TCB[simp]:
+  "tcb_of' (KOTCB tcb) = Some tcb"
+  by (simp add: projectKO_tcb)
+
 lemma projectKO_cte:
   "(projectKO_opt ko = Some t) = (ko = KOCTE t)"
   by (cases ko) (auto simp: projectKO_opts_defs)
diff --git a/proof/refine/RISCV64/CNodeInv_R.thy b/proof/refine/RISCV64/CNodeInv_R.thy
index d4feda068b..281a00261a 100644
--- a/proof/refine/RISCV64/CNodeInv_R.thy
+++ b/proof/refine/RISCV64/CNodeInv_R.thy
@@ -5042,8 +5042,6 @@ crunch valid_arch_state'[wp]: cteSwap "valid_arch_state'"
 
 crunch irq_states'[wp]: cteSwap "valid_irq_states'"
 
-crunch vq'[wp]: cteSwap "valid_queues'"
-
 crunch ksqsL1[wp]: cteSwap "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
 
 crunch ksqsL2[wp]: cteSwap "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
@@ -5058,6 +5056,12 @@ crunch ct_not_inQ[wp]: cteSwap "ct_not_inQ"
 
 crunch ksDomScheduleIdx [wp]: cteSwap "\<lambda>s. P (ksDomScheduleIdx s)"
 
+crunches cteSwap
+  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: valid_bitmaps_lift)
+
 lemma cteSwap_invs'[wp]:
   "\<lbrace>invs' and valid_cap' c and valid_cap' c' and
     ex_cte_cap_to' c1 and ex_cte_cap_to' c2 and
@@ -5513,6 +5517,10 @@ lemma updateCap_untyped_ranges_zero_simple:
 crunch tcb_in_cur_domain'[wp]: updateCap "tcb_in_cur_domain' t"
   (wp: crunch_wps simp: crunch_simps rule: tcb_in_cur_domain'_lift)
 
+crunches updateCap
+  for valid_bitmaps[wp]: valid_bitmaps
+  (rule: valid_bitmaps_lift)
+
 lemma make_zombie_invs':
   "\<lbrace>\<lambda>s. invs' s \<and> s \<turnstile>' cap \<and>
     cte_wp_at' (\<lambda>cte. isFinal (cteCap cte) sl (cteCaps_of s)) sl s \<and>
@@ -5529,7 +5537,8 @@ lemma make_zombie_invs':
                             st_tcb_at' ((=) Inactive) p s
                              \<and> bound_tcb_at' ((=) None) p s
                              \<and> obj_at' (Not \<circ> tcbQueued) p s
-                             \<and> (\<forall>pr. p \<notin> set (ksReadyQueues s pr)))) sl s\<rbrace>
+                             \<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_state'_def valid_pspace'_def valid_mdb'_def
@@ -5566,7 +5575,9 @@ lemma make_zombie_invs':
    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_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)
    apply (auto dest!: isCapDs)[1]
   apply (clarsimp simp: cte_wp_at_ctes_of disj_ac
@@ -8528,6 +8539,15 @@ lemma cteMove_urz [wp]:
   apply auto
   done
 
+crunches updateMDB
+  for valid_bitmaps[wp]: valid_bitmaps
+  (rule: valid_bitmaps_lift)
+
+(* FIXME: arch_split *)
+lemma haskell_assert_inv:
+  "haskell_assert Q L \<lbrace>P\<rbrace>"
+  by wpsimp
+
 lemma cteMove_invs' [wp]:
   "\<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>
@@ -8605,6 +8625,10 @@ crunch ksDomSchedule[wp]: updateCap "\<lambda>s. P (ksDomSchedule s)"
 crunch ksDomScheduleIdx[wp]: updateCap "\<lambda>s. P (ksDomScheduleIdx s)"
 crunch ksDomainTime[wp]: updateCap "\<lambda>s. P (ksDomainTime s)"
 
+crunches updateCap
+  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 corres_null_cap_update:
   "cap_relation cap cap' \<Longrightarrow>
    corres dc (invs and cte_wp_at ((=) cap) slot)
diff --git a/proof/refine/RISCV64/CSpace1_R.thy b/proof/refine/RISCV64/CSpace1_R.thy
index 437285321d..3ee92fdf7c 100644
--- a/proof/refine/RISCV64/CSpace1_R.thy
+++ b/proof/refine/RISCV64/CSpace1_R.thy
@@ -233,7 +233,7 @@ lemma pspace_relation_cte_wp_at:
    apply (clarsimp elim!: cte_wp_at_weakenE')
   apply clarsimp
   apply (drule(1) pspace_relation_absD)
-  apply (clarsimp simp: other_obj_relation_def)
+  apply (clarsimp simp: tcb_relation_cut_def)
   apply (simp split: kernel_object.split_asm)
   apply (drule(2) aligned_distinct_obj_atI'[where 'a=tcb])
    apply simp
@@ -1631,10 +1631,10 @@ lemma cte_map_pulls_tcb_to_abstract:
      \<Longrightarrow> \<exists>tcb'. kheap s x = Some (TCB tcb') \<and> tcb_relation tcb' tcb
                   \<and> (z = (x, tcb_cnode_index (unat ((y - x) >> cte_level_bits))))"
   apply (rule pspace_dom_relatedE, assumption+)
-  apply (erule(1) obj_relation_cutsE, simp_all split: if_split_asm)
-  apply (clarsimp simp: other_obj_relation_def
+  apply (erule(1) obj_relation_cutsE;
+         clarsimp simp: other_obj_relation_def
                  split: Structures_A.kernel_object.split_asm
-                        RISCV64_A.arch_kernel_obj.split_asm)
+                        RISCV64_A.arch_kernel_obj.split_asm if_split_asm)
   apply (drule tcb_cases_related2)
   apply clarsimp
   apply (frule(1) cte_wp_at_tcbI [OF _ _ TrueI, where t="(a, b)" for a b, simplified])
@@ -1650,8 +1650,7 @@ lemma pspace_relation_update_tcbs:
               del: dom_fun_upd)
   apply (erule conjE)
   apply (rule ballI, drule(1) bspec)
-  apply (rule conjI, simp add: other_obj_relation_def)
-  apply (clarsimp split: Structures_A.kernel_object.split_asm)
+  apply (clarsimp simp: tcb_relation_cut_def split: Structures_A.kernel_object.split_asm)
   apply (drule bspec, fastforce)
   apply clarsimp
   apply (erule(1) obj_relation_cutsE, simp_all split: if_split_asm)
@@ -1873,6 +1872,27 @@ lemma descendants_of_eq':
   apply simp
   done
 
+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
+
+lemma setObject_cte_tcbSchedNexts_of_use_valid_ksPSpace:
+  assumes step: "(x, s\<lparr>ksPSpace := ps\<rparr>) \<in> fst (setObject p (cte :: cte) s)"
+  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_inQ_of_use_valid_ksPSpace:
+  assumes step: "(x, s\<lparr>ksPSpace := ps\<rparr>) \<in> fst (setObject p (cte :: cte) s)"
+  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>
@@ -1886,7 +1906,12 @@ lemma updateCap_stuff:
          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'')" using assms
+         (pspace_distinct' s' \<longrightarrow> pspace_distinct' s'') \<and>
+         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)
@@ -1895,8 +1920,11 @@ lemma updateCap_stuff:
   apply (frule setCTE_pspace_only)
   apply (clarsimp simp: setCTE_def)
   apply (intro conjI impI)
-   apply (erule(1) use_valid [OF _ setObject_aligned])
-  apply (erule(1) use_valid [OF _ setObject_distinct])
+      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 *)
@@ -1913,16 +1941,16 @@ lemma pspace_relation_cte_wp_atI':
    apply (simp split: if_split_asm)
   apply (erule(1) pspace_dom_relatedE)
   apply (erule(1) obj_relation_cutsE, simp_all split: if_split_asm)
+   apply (subgoal_tac "n = x - y", clarsimp)
+    apply (drule tcb_cases_related2, clarsimp)
+    apply (intro exI, rule conjI)
+     apply (erule(1) cte_wp_at_tcbI[where t="(a, b)" for a b, simplified])
+     apply fastforce
+    apply simp
+   apply clarsimp
   apply (simp add: other_obj_relation_def
             split: Structures_A.kernel_object.split_asm
                    RISCV64_A.arch_kernel_obj.split_asm)
-  apply (subgoal_tac "n = x - y", clarsimp)
-   apply (drule tcb_cases_related2, clarsimp)
-   apply (intro exI, rule conjI)
-    apply (erule(1) cte_wp_at_tcbI[where t="(a, b)" for a b, simplified])
-    apply fastforce
-   apply simp
-  apply clarsimp
   done
 
 lemma pspace_relation_cte_wp_atI:
@@ -2444,7 +2472,7 @@ lemma updateCap_corres:
   apply (clarsimp simp: in_set_cap_cte_at_swp pspace_relations_def)
   apply (drule updateCap_stuff)
   apply simp
-  apply (rule conjI)
+  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 (rule conjI)
    prefer 2
@@ -2532,9 +2560,9 @@ lemma updateMDB_pspace_relation:
     apply (clarsimp simp: tcb_ctes_clear cte_level_bits_def objBits_defs)
    apply clarsimp
    apply (rule pspace_dom_relatedE, assumption+)
-   apply (rule obj_relation_cutsE, assumption+, simp_all split: if_split_asm)[1]
-   apply (clarsimp split: Structures_A.kernel_object.split_asm
-                          RISCV64_A.arch_kernel_obj.split_asm
+   apply (rule obj_relation_cutsE, assumption+;
+          clarsimp split: Structures_A.kernel_object.split_asm
+                          RISCV64_A.arch_kernel_obj.split_asm if_split_asm
                     simp: other_obj_relation_def)
    apply (frule(1) tcb_cte_cases_aligned_helpers(1))
    apply (frule(1) tcb_cte_cases_aligned_helpers(2))
@@ -2596,6 +2624,25 @@ lemma updateMDB_ctes_of:
 
 crunch aligned[wp]: updateMDB "pspace_aligned'"
 crunch pdistinct[wp]: updateMDB "pspace_distinct'"
+crunch tcbSchedPrevs_of[wp]: updateMDB "\<lambda>s. P (tcbSchedPrevs_of s)"
+crunch tcbSchedNexts_of[wp]: updateMDB "\<lambda>s. P (tcbSchedNexts_of s)"
+crunch inQ_opt_pred[wp]: updateMDB "\<lambda>s. P (inQ d p |< tcbs_of' s)"
+crunch inQ_opt_pred'[wp]: updateMDB "\<lambda>s. P (\<lambda>d p. inQ d p |< tcbs_of' s)"
+crunch ksReadyQueues[wp]: updateMDB "\<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
+
+crunches 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')"
@@ -2618,7 +2665,11 @@ lemma updateMDB_the_lot:
          ksDomScheduleIdx s'' = ksDomScheduleIdx s' \<and>
          ksDomSchedule s''    = ksDomSchedule s' \<and>
          ksCurDomain s''      = ksCurDomain s' \<and>
-         ksDomainTime s''     = ksDomainTime s'"
+         ksDomainTime s''     = ksDomainTime s' \<and>
+         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)
@@ -2627,9 +2678,8 @@ using assms
    apply (erule use_valid)
     apply wp
    apply simp
-  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 is_cap_revocable_eq:
@@ -3792,6 +3842,9 @@ lemma updateUntypedCap_descendants_of:
   apply (clarsimp simp:mdb_next_rel_def mdb_next_def split:if_splits)
   done
 
+crunches setCTE
+  for tcbQueued[wp]: "\<lambda>s. P (tcbQueued |< tcbs_of' s)"
+
 lemma setCTE_UntypedCap_corres:
   "\<lbrakk>cap_relation cap (cteCap cte); is_untyped_cap cap; idx' = idx\<rbrakk>
    \<Longrightarrow> corres dc (cte_wp_at ((=) cap) src and valid_objs and
@@ -3821,10 +3874,19 @@ lemma setCTE_UntypedCap_corres:
    apply assumption
   apply (clarsimp simp: pspace_relations_def)
   apply (subst conj_assoc[symmetric])
+  apply clarsimp
   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)
@@ -5104,11 +5166,15 @@ lemma updateMDB_the_lot':
          ksDomScheduleIdx s'' = ksDomScheduleIdx s' \<and>
          ksDomSchedule s''    = ksDomSchedule s' \<and>
          ksCurDomain s''      = ksCurDomain s' \<and>
-         ksDomainTime s''     = ksDomainTime s'"
+         ksDomainTime s''     = ksDomainTime s' \<and>
+         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
+   done
 
 lemma cte_map_inj_eq':
   "\<lbrakk>(cte_map p = cte_map p');
@@ -5210,7 +5276,6 @@ lemma cteInsert_corres:
             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 "ksReadyQueues t = p" for p t)+
             apply (thin_tac "ksSchedulerAction t = p" for p t)+
             apply (clarsimp simp: pspace_relations_def)
 
diff --git a/proof/refine/RISCV64/CSpace_R.thy b/proof/refine/RISCV64/CSpace_R.thy
index 797bc486ce..b4c1d528ac 100644
--- a/proof/refine/RISCV64/CSpace_R.thy
+++ b/proof/refine/RISCV64/CSpace_R.thy
@@ -1091,43 +1091,6 @@ lemma bitmapQ_no_L2_orphans_lift:
   apply (rule hoare_vcg_prop, assumption)
   done
 
-lemma valid_queues_lift_asm:
-  assumes tat1: "\<And>d p tcb. \<lbrace>obj_at' (inQ d p) tcb and Q \<rbrace> f \<lbrace>\<lambda>_. obj_at' (inQ d p) tcb\<rbrace>"
-  and     tat2: "\<And>tcb. \<lbrace>st_tcb_at' runnable' tcb and Q \<rbrace> f \<lbrace>\<lambda>_. st_tcb_at' runnable' tcb\<rbrace>"
-  and     prq: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueues s) \<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueues s)\<rbrace>"
-  and     prqL1: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueuesL1Bitmap s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueuesL1Bitmap s)\<rbrace>"
-  and     prqL2: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueuesL2Bitmap s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueuesL2Bitmap s)\<rbrace>"
-  shows   "\<lbrace>Invariants_H.valid_queues and Q\<rbrace> f \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  proof -
-    have tat:  "\<And>d p tcb. \<lbrace>obj_at' (inQ d p) tcb and st_tcb_at' runnable' tcb and Q\<rbrace> f
-                         \<lbrace>\<lambda>_. obj_at' (inQ d p) tcb and st_tcb_at' runnable' tcb\<rbrace>"
-      apply (rule hoare_chain [OF hoare_vcg_conj_lift [OF tat1 tat2]])
-       apply (fastforce)+
-       done
-    have tat_combined: "\<And>d p tcb. \<lbrace>obj_at' (inQ d p and runnable' \<circ> tcbState) tcb and Q\<rbrace> f
-                         \<lbrace>\<lambda>_. obj_at' (inQ d p and runnable' \<circ> tcbState) tcb\<rbrace>"
-      apply (rule hoare_chain [OF tat])
-       apply (fastforce simp add: obj_at'_and pred_tcb_at'_def o_def)+
-      done
-    show ?thesis unfolding valid_queues_def valid_queues_no_bitmap_def
-      by (wp tat_combined prq prqL1 prqL2 valid_bitmapQ_lift bitmapQ_no_L2_orphans_lift
-             bitmapQ_no_L1_orphans_lift hoare_vcg_all_lift hoare_vcg_conj_lift hoare_Ball_helper)
-         simp_all
-  qed
-
-lemmas valid_queues_lift = valid_queues_lift_asm[where Q="\<lambda>_. True", simplified]
-
-lemma valid_queues_lift':
-  assumes tat: "\<And>d p tcb. \<lbrace>\<lambda>s. \<not> obj_at' (inQ d p) tcb s\<rbrace> f \<lbrace>\<lambda>_ s. \<not> obj_at' (inQ d p) tcb s\<rbrace>"
-  and     prq: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueues s)\<rbrace>"
-  shows   "\<lbrace>valid_queues'\<rbrace> f \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  unfolding valid_queues'_def imp_conv_disj
-  by (wp hoare_vcg_all_lift hoare_vcg_disj_lift tat prq)
-
-lemma setCTE_norq [wp]:
-  "\<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace> setCTE ptr cte \<lbrace>\<lambda>r s. P (ksReadyQueues s) \<rbrace>"
-  by (clarsimp simp: valid_def dest!: setCTE_pspace_only)
-
 lemma setCTE_norqL1 [wp]:
   "\<lbrace>\<lambda>s. P (ksReadyQueuesL1Bitmap s)\<rbrace> setCTE ptr cte \<lbrace>\<lambda>r s. P (ksReadyQueuesL1Bitmap s) \<rbrace>"
   by (clarsimp simp: valid_def dest!: setCTE_pspace_only)
@@ -2784,12 +2747,6 @@ lemma setCTE_inQ[wp]:
    apply (simp_all add: inQ_def)
   done
 
-lemma setCTE_valid_queues'[wp]:
-  "\<lbrace>valid_queues'\<rbrace> setCTE p cte \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (simp only: valid_queues'_def imp_conv_disj)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-  done
-
 crunch inQ[wp]: cteInsert "\<lambda>s. P (obj_at' (inQ d p) t s)"
   (wp: crunch_wps)
 
@@ -3289,6 +3246,13 @@ lemma cteInsert_untyped_ranges_zero[wp]:
   apply blast
   done
 
+crunches cteInsert
+  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
   (\<lambda>s. src \<noteq> dest) and (\<lambda>s. cte_wp_at' (is_derived' (ctes_of s) src cap \<circ> cteCap) src s)
@@ -3297,9 +3261,9 @@ lemma cteInsert_invs:
   cteInsert cap src dest
   \<lbrace>\<lambda>rv. invs'\<rbrace>"
   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 CSpace_R.valid_queues_lift
-                    valid_irq_node_lift valid_queues_lift' irqs_masked_lift cteInsert_norq
-              simp: st_tcb_at'_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
 
@@ -3603,10 +3567,13 @@ lemma corres_caps_decomposition:
              "\<And>P. \<lbrace>\<lambda>s. P (new_ups' s)\<rbrace> g \<lbrace>\<lambda>rv s. P (gsUserPages s)\<rbrace>"
              "\<And>P. \<lbrace>\<lambda>s. P (new_cns s)\<rbrace> f \<lbrace>\<lambda>rv s. P (cns_of_heap (kheap s))\<rbrace>"
              "\<And>P. \<lbrace>\<lambda>s. P (new_cns' s)\<rbrace> g \<lbrace>\<lambda>rv s. P (gsCNodes s)\<rbrace>"
-             "\<And>P. \<lbrace>\<lambda>s. P (new_queues s)\<rbrace> f \<lbrace>\<lambda>rv s. P (ready_queues s)\<rbrace>"
+             "\<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_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>"
@@ -3622,7 +3589,9 @@ lemma corres_caps_decomposition:
              "\<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 (new_queues s) (new_rqs' s')"
+                       \<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>
@@ -3690,8 +3659,9 @@ proof -
     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 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 pspace_relations_def swp_cte_at))+
+    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
 
@@ -3796,7 +3766,7 @@ lemma create_reply_master_corres:
   apply clarsimp
   apply (rule corres_caps_decomposition)
                                  defer
-                                 apply (wp|simp)+
+                                 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)
@@ -4172,6 +4142,9 @@ crunches setupReplyMaster
   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]:
@@ -4200,7 +4173,8 @@ lemma setupReplyMaster_invs'[wp]:
   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 valid_queues_lift' hoare_vcg_disj_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
@@ -4464,8 +4438,8 @@ lemma arch_update_setCTE_invs:
   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
+             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)
@@ -5840,7 +5814,7 @@ lemma cteInsert_simple_invs:
   apply (rule hoare_pre)
    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' irqs_masked_lift
+             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
@@ -5975,6 +5949,21 @@ lemma arch_update_updateCap_invs:
   apply clarsimp
   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
@@ -6006,6 +5995,8 @@ lemma updateCap_same_master:
         apply 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
@@ -6236,8 +6227,9 @@ lemma updateFreeIndex_forward_invs':
        apply (simp add:updateCap_def)
        apply (wp setCTE_irq_handlers' getCTE_wp)
       apply (simp add:updateCap_def)
-      apply (wp irqs_masked_lift valid_queues_lift' cur_tcb_lift ct_idle_or_in_cur_domain'_lift
+      apply (wp irqs_masked_lift cur_tcb_lift ct_idle_or_in_cur_domain'_lift
                 hoare_vcg_disj_lift untyped_ranges_zero_lift getCTE_wp
+                sym_heap_sched_pointers_lift valid_bitmaps_lift
                | wp (once) hoare_use_eq[where f="gsUntypedZeroRanges"]
                | simp add: getSlotCap_def)+
   apply (clarsimp simp: cte_wp_at_ctes_of fun_upd_def[symmetric])
diff --git a/proof/refine/RISCV64/Detype_R.thy b/proof/refine/RISCV64/Detype_R.thy
index 6c6fb9cc16..42d0703b7d 100644
--- a/proof/refine/RISCV64/Detype_R.thy
+++ b/proof/refine/RISCV64/Detype_R.thy
@@ -558,7 +558,6 @@ lemma sym_refs_ko_wp_atD:
 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 =
@@ -578,8 +577,9 @@ lemma valid_objs: "valid_objs' s'"
   and        pc: "pspace_canonical' s'"
   and       pkm: "pspace_in_kernel_mappings' s'"
   and        pd: "pspace_distinct' s'"
-  and        vq: "valid_queues s'"
-  and       vq': "valid_queues' s'"
+  and       vbm: "valid_bitmaps s'"
+  and sym_sched: "sym_heap_sched_pointers s'"
+  and       vsp: "valid_sched_pointers s'"
   and  sym_refs: "sym_refs (state_refs_of' s')"
   and    iflive: "if_live_then_nonz_cap' s'"
   and  ifunsafe: "if_unsafe_then_cap' s'"
@@ -770,7 +770,6 @@ lemma refs_notRange:
   apply (rule refs_of_live')
   apply clarsimp
   done
-
 end
 
 context begin interpretation Arch . (*FIXME: arch_split*)
@@ -836,6 +835,70 @@ crunches doMachineOp
   for deletionIsSafe_delete_locale[wp]: "deletionIsSafe_delete_locale base magnitude"
   (simp: deletionIsSafe_delete_locale_def)
 
+lemma detype_tcbSchedNexts_of:
+  "\<lbrakk>pspace_aligned' s'; pspace_distinct' 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) |> tcb_of' |> tcbSchedNext)
+       = tcbSchedNexts_of s'"
+  using pspace_alignedD' pspace_distinctD'
+  apply (clarsimp simp: opt_map_def)
+  apply (rule ext)
+  apply (rename_tac s)
+  apply (clarsimp simp: ko_wp_at'_def split: option.splits)
+  apply (drule_tac x=s in spec)
+  apply force
+  done
+
+lemma detype_tcbSchedPrevs_of:
+  "\<lbrakk>pspace_aligned' s'; pspace_distinct' 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) |> tcb_of' |> tcbSchedPrev)
+       = tcbSchedPrevs_of s'"
+  using pspace_alignedD' pspace_distinctD'
+  using pspace_alignedD' pspace_distinctD'
+  apply (clarsimp simp: opt_map_def)
+  apply (rule ext)
+  apply (rename_tac s)
+  apply (clarsimp simp: ko_wp_at'_def split: option.splits)
+  apply (drule_tac x=s in spec)
+  apply force
+  done
+
+lemma detype_inQ:
+  "\<lbrakk>pspace_aligned' s'; pspace_distinct' s'; \<forall>p. p \<in> S \<longrightarrow> \<not> ko_wp_at' live' p s'\<rbrakk>
+   \<Longrightarrow> \<forall>d p. (inQ d p |< ((\<lambda>x. if x \<in> S then None else ksPSpace s' x) |> tcb_of'))
+             = (inQ d p |< tcbs_of' s')"
+  using pspace_alignedD' pspace_distinctD'
+  using pspace_alignedD' pspace_distinctD'
+  apply (clarsimp simp: opt_map_def)
+  apply (rule ext)
+  apply (rename_tac s)
+  apply (clarsimp simp: inQ_def opt_pred_def ko_wp_at'_def split: option.splits)
+  apply (drule_tac x=s in spec)
+  apply force
+  done
+
+lemma detype_ready_queues_relation:
+  "\<lbrakk>pspace_aligned' s'; pspace_distinct' s';
+    \<forall>p. p \<in> {lower..upper} \<longrightarrow> \<not> ko_wp_at' live' p s';
+    ready_queues_relation s s'; upper = upper'\<rbrakk>
+   \<Longrightarrow> ready_queues_relation_2
+        (ready_queues (detype {lower..upper'} s))
+        (ksReadyQueues s')
+        ((\<lambda>x. if lower \<le> x \<and> x \<le> upper then None
+              else ksPSpace s' x) |>
+         tcb_of' |>
+         tcbSchedNext)
+        ((\<lambda>x. if lower \<le> x \<and> x \<le> upper then None
+              else ksPSpace s' x) |>
+         tcb_of' |>
+         tcbSchedPrev)
+        (\<lambda>d p. inQ d p |< ((\<lambda>x. if lower \<le> x \<and> x \<le> upper then None else ksPSpace s' x) |> tcb_of'))"
+  apply (clarsimp simp: detype_ext_def ready_queues_relation_def Let_def)
+  apply (frule (1) detype_tcbSchedNexts_of[where S="{lower..upper}"]; simp)
+  apply (frule (1) detype_tcbSchedPrevs_of[where S="{lower..upper}"]; simp)
+  apply (frule (1) detype_inQ[where S="{lower..upper}"]; simp)
+  apply (fastforce simp add: detype_def detype_ext_def)
+  done
+
 lemma deleteObjects_corres:
   "is_aligned base magnitude \<Longrightarrow> magnitude \<ge> 3 \<Longrightarrow>
    corres dc
@@ -856,20 +919,19 @@ lemma deleteObjects_corres:
   apply (rule corres_stateAssert_implied[where P'=\<top>, simplified])
    prefer 2
    apply clarsimp
-   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 p_assoc_help invs_valid_pspace)[1]
-   apply (simp add:valid_cap_simps)
+   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 (fastforce simp: sch_act_simple_def schact_is_rct_def state_relation_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: valid_cap_simps)
   apply (simp add: bind_assoc[symmetric] ksASIDMapSafe_def)
   apply (simp add: delete_objects_def)
   apply (rule_tac Q="\<lambda>_ s. valid_objs s \<and> valid_list s \<and>
@@ -921,6 +983,10 @@ lemma deleteObjects_corres:
         apply (clarsimp simp: valid_cap_def, assumption)
        apply (fastforce simp: detype_def detype_ext_def add_mask_fold intro!: ekheap_relation_detype)
       apply (simp add: add_mask_fold)
+      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)
@@ -932,13 +998,31 @@ lemma deleteObjects_corres:
                     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':
+  "ko_wp_at' live' p s' \<or> p = idle_thread_ptr \<Longrightarrow> p \<notin> base_bits"
+  apply (case_tac "ko_wp_at' live' 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 invs_valid_idle'[OF invs])
+  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 mask_eq_exp_minus_1)
+  by fastforce
+
+lemma untyped_range_live_idle':
+  "p \<in> base_bits \<Longrightarrow> \<not> (ko_wp_at' live' p s' \<or> p = idle_thread_ptr)"
+  using live_idle_untyped_range' by blast
+
 lemma valid_obj':
-  "\<lbrakk> valid_obj' obj s'; ko_wp_at' ((=) obj) p s' \<rbrakk> \<Longrightarrow> valid_obj' obj state'"
+  "\<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 (rename_tac endpoint)
      apply (case_tac endpoint, simp_all add: valid_ep'_def)[1]
@@ -965,10 +1049,21 @@ lemma valid_obj':
     apply (erule(2) cte_wp_at_tcbI')
      apply fastforce
     apply simp
-   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 (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)
+   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)
   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])
@@ -976,14 +1071,46 @@ lemma valid_obj':
   apply simp
   done
 
+lemma tcbSchedNexts_of_pspace':
+  "\<lbrakk>pspace_aligned' s'; pspace_distinct' s'; pspace_distinct' state'\<rbrakk>
+   \<Longrightarrow> (pspace' |> tcb_of' |> tcbSchedNext) = tcbSchedNexts_of s'"
+  apply (rule ext)
+  apply (rename_tac p)
+  apply (case_tac "p \<in> base_bits")
+   apply (frule untyped_range_live_idle')
+   apply (clarsimp simp: opt_map_def)
+   apply (case_tac "ksPSpace s' p"; clarsimp)
+   apply (rename_tac obj)
+   apply (case_tac "tcb_of' obj"; clarsimp)
+   apply (clarsimp simp: ko_wp_at'_def obj_at'_def)
+   apply (fastforce simp: pspace_alignedD' pspace_distinctD')
+  apply (clarsimp simp: opt_map_def split: option.splits)
+  done
+
+lemma tcbSchedPrevs_of_pspace':
+  "\<lbrakk>pspace_aligned' s'; pspace_distinct' s'; pspace_distinct' state'\<rbrakk>
+   \<Longrightarrow> (pspace' |> tcb_of' |> tcbSchedPrev) = tcbSchedPrevs_of s'"
+  apply (rule ext)
+  apply (rename_tac p)
+  apply (case_tac "p \<in> base_bits")
+   apply (frule untyped_range_live_idle')
+   apply (clarsimp simp: opt_map_def)
+   apply (case_tac "ksPSpace s' p"; clarsimp)
+   apply (rename_tac obj)
+   apply (case_tac "tcb_of' obj"; clarsimp)
+   apply (clarsimp simp: ko_wp_at'_def obj_at'_def)
+   apply (fastforce simp: pspace_alignedD' pspace_distinctD')
+  apply (clarsimp simp: opt_map_def split: option.splits)
+  done
+
 lemma st_tcb:
-    "\<And>P p. \<lbrakk> st_tcb_at' P p s'; \<not> P Inactive; \<not> P IdleThreadState \<rbrakk> \<Longrightarrow> st_tcb_at' P p state'"
-    by (fastforce simp: pred_tcb_at'_def obj_at'_real_def
-                 dest: live_notRange)
+  "\<And>P p. \<lbrakk> st_tcb_at' P p s'; \<not> P Inactive; \<not> P IdleThreadState \<rbrakk> \<Longrightarrow> st_tcb_at' P p state'"
+  by (fastforce simp: pred_tcb_at'_def obj_at'_real_def
+                dest: live_notRange)
 
 lemma irq_nodes_global:
-  "\<forall>irq :: irq. irq_node' s' + (ucast irq << cteSizeBits) \<in> global_refs' s'"
-  by (simp add: global_refs'_def)
+    "\<forall>irq :: irq. irq_node' s' + (ucast irq << cteSizeBits) \<in> global_refs' s'"
+    by (simp add: global_refs'_def)
 
 lemma global_refs:
   "global_refs' s' \<inter> base_bits = {}"
@@ -1189,17 +1316,18 @@ proof (simp add: invs'_def valid_state'_def valid_pspace'_def
   show "pspace_in_kernel_mappings' ?s" using pkm
     by (simp add: pspace_in_kernel_mappings'_def dom_def)
 
-  show "pspace_distinct' ?s" using pd
+  show pspace_distinct'_state': "pspace_distinct' ?s" using pd
     by (clarsimp simp add: pspace_distinct'_def ps_clear_def
                            dom_if_None Diff_Int_distrib)
 
-  show "valid_objs' ?s" using valid_objs
+  show "valid_objs' ?s" using valid_objs sym_sched
     apply (clarsimp simp: valid_objs'_def ran_def)
     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
+     apply (frule pspace_alignedD'[OF _ pa])
+     apply (frule pspace_distinctD'[OF _ pd])
+     apply (clarsimp simp: ko_wp_at'_def)
+    apply fastforce
     done
 
   from sym_refs show "sym_refs (state_refs_of' ?s)"
@@ -1211,19 +1339,6 @@ proof (simp add: invs'_def valid_state'_def valid_pspace'_def
     apply (simp add: refs_notRange[simplified] state_refs_ko_wp_at_eq)
     done
 
-  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: inQ_def)
-    apply (clarsimp dest!: ex_nonz_cap_notRange)
-    done
-
-  from vq' show "valid_queues' ?s"
-    by (simp add: valid_queues'_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)
@@ -1471,6 +1586,20 @@ proof (simp add: invs'_def valid_state'_def valid_pspace'_def
     apply simp
     done
 
+  from vbm
+  show "valid_bitmaps state'"
+    by (simp add: valid_bitmaps_def bitmapQ_defs)
+
+  from sym_sched
+  show "sym_heap (pspace' |> tcb_of' |> tcbSchedNext) (pspace' |> tcb_of' |> tcbSchedPrev)"
+    using pa pd pspace_distinct'_state'
+    by (fastforce simp: tcbSchedNexts_of_pspace' tcbSchedPrevs_of_pspace')
+
+  from vsp show "valid_sched_pointers_2 (pspace' |> tcb_of' |> tcbSchedPrev)
+                                        (pspace' |> tcb_of' |> tcbSchedNext)
+                                        (tcbQueued |< (pspace' |> tcb_of'))"
+    by (clarsimp simp: valid_sched_pointers_def opt_pred_def opt_map_def)
+
 qed (clarsimp)
 
 lemma (in delete_locale) delete_ko_wp_at':
diff --git a/proof/refine/RISCV64/EmptyFail_H.thy b/proof/refine/RISCV64/EmptyFail_H.thy
index 068729f1a3..bde07a1ef8 100644
--- a/proof/refine/RISCV64/EmptyFail_H.thy
+++ b/proof/refine/RISCV64/EmptyFail_H.thy
@@ -163,7 +163,7 @@ lemma ignoreFailure_empty_fail[intro!, wp, simp]:
   by (simp add: ignoreFailure_def empty_fail_catch)
 
 crunch (empty_fail) empty_fail[intro!, wp, simp]: cancelIPC, setThreadState, tcbSchedDequeue, setupReplyMaster, isStopped, possibleSwitchTo, tcbSchedAppend
-(simp: Let_def setNotification_def setBoundNotification_def)
+(simp: Let_def setNotification_def setBoundNotification_def wp: empty_fail_getObject)
 
 crunch (empty_fail) "_H_empty_fail"[intro!, wp, simp]: "ThreadDecls_H.suspend"
   (ignore_del: ThreadDecls_H.suspend)
diff --git a/proof/refine/RISCV64/Finalise_R.thy b/proof/refine/RISCV64/Finalise_R.thy
index f658b4d758..9039981d11 100644
--- a/proof/refine/RISCV64/Finalise_R.thy
+++ b/proof/refine/RISCV64/Finalise_R.thy
@@ -16,9 +16,7 @@ context begin interpretation Arch . (*FIXME: arch_split*)
 declare doUnbindNotification_def[simp]
 
 crunches copyGlobalMappings
-  for queues[wp]: "Invariants_H.valid_queues"
-  and queues'[wp]: "Invariants_H.valid_queues'"
-  and ifunsafe'[wp]: "if_unsafe_then_cap'"
+  for ifunsafe'[wp]: "if_unsafe_then_cap'"
   and pred_tcb_at'[wp]: "pred_tcb_at' proj P t"
   and vms'[wp]: "valid_machine_state'"
   and ct_not_inQ[wp]: "ct_not_inQ"
@@ -95,20 +93,10 @@ crunch ksRQL1[wp]: emptySlot "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
 crunch ksRQL2[wp]: emptySlot "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
 crunch obj_at'[wp]: postCapDeletion "obj_at' P p"
 
-lemmas postCapDeletion_valid_queues[wp] =
-    valid_queues_lift [OF postCapDeletion_obj_at'
-                          postCapDeletion_pred_tcb_at'
-                          postCapDeletion_ksRQ]
-
 crunch inQ[wp]: clearUntypedFreeIndex "\<lambda>s. P (obj_at' (inQ d p) t s)"
 crunch tcbDomain[wp]: clearUntypedFreeIndex "obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t"
 crunch tcbPriority[wp]: clearUntypedFreeIndex "obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t"
 
-lemma emptySlot_queues [wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> emptySlot sl opt \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  unfolding emptySlot_def
-  by (wp | wpcw | wp valid_queues_lift | simp)+
-
 crunch nosch[wp]: emptySlot "\<lambda>s. P (ksSchedulerAction s)"
 crunch ksCurDomain[wp]: emptySlot "\<lambda>s. P (ksCurDomain s)"
 
@@ -1181,8 +1169,7 @@ definition
  "removeable' sl \<equiv> \<lambda>s cap.
     (\<exists>p. p \<noteq> sl \<and> cte_wp_at' (\<lambda>cte. capMasterCap (cteCap cte) = capMasterCap cap) p s)
     \<or> ((\<forall>p \<in> cte_refs' cap (irq_node' s). p \<noteq> sl \<longrightarrow> cte_wp_at' (\<lambda>cte. cteCap cte = NullCap) p s)
-         \<and> (\<forall>p \<in> zobj_refs' cap. ko_wp_at' (Not \<circ> live') p s)
-         \<and> (\<forall>t \<in> threadCapRefs cap. \<forall>p. t \<notin> set (ksReadyQueues s p)))"
+         \<and> (\<forall>p \<in> zobj_refs' cap. ko_wp_at' (Not \<circ> live') p s))"
 
 lemma not_Final_removeable:
   "\<not> isFinal cap sl (cteCaps_of s)
@@ -1400,11 +1387,6 @@ crunch irq_states' [wp]: emptySlot valid_irq_states'
 crunch no_0_obj' [wp]: emptySlot no_0_obj'
  (wp: crunch_wps)
 
-crunch valid_queues'[wp]: setInterruptState "valid_queues'"
-  (simp: valid_queues'_def)
-
-crunch valid_queues'[wp]: emptySlot "valid_queues'"
-
 end
 
 lemma deletedIRQHandler_irqs_masked'[wp]:
@@ -1498,6 +1480,13 @@ lemma emptySlot_valid_arch'[wp]:
   by (wpsimp simp: emptySlot_def cte_wp_at_ctes_of
                wp: getCTE_wp hoare_drop_imps hoare_vcg_ex_lift)
 
+crunches emptySlot
+  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> (info \<noteq> NullCap \<longrightarrow> post_cap_delete_pre' info sl (cteCaps_of s) )\<rbrace>
@@ -2292,6 +2281,14 @@ 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)
 
+crunches 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]:
   "\<lbrace>invs'\<rbrace> unbindNotification tcb \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (simp add: unbindNotification_def invs'_def valid_state'_def)
@@ -2300,8 +2297,8 @@ lemma unbindNotification_invs[wp]:
   apply clarsimp
   apply (rule hoare_seq_ext[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
+  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 (clarsimp elim!: obj_atE'
@@ -2341,7 +2338,7 @@ lemma unbindMaybeNotification_invs[wp]:
   apply (simp add: unbindMaybeNotification_def invs'_def valid_state'_def)
   apply (rule hoare_seq_ext[OF _ get_ntfn_sp'])
   apply (rule hoare_pre)
-   apply (wp sbn'_valid_pspace'_inv sbn_sch_act' sbn_valid_queues valid_irq_node_lift
+   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)+
@@ -2495,7 +2492,6 @@ lemma cteDeleteOne_isFinal:
 
 lemmas setEndpoint_cteCaps_of[wp] = cteCaps_of_ctes_of_lift [OF set_ep_ctes_of]
 lemmas setNotification_cteCaps_of[wp] = cteCaps_of_ctes_of_lift [OF set_ntfn_ctes_of]
-lemmas setQueue_cteCaps_of[wp] = cteCaps_of_ctes_of_lift [OF setQueue_ctes_of]
 lemmas threadSet_cteCaps_of = cteCaps_of_ctes_of_lift [OF threadSet_ctes_of]
 
 crunch isFinal: suspend, prepareThreadDelete "\<lambda>s. isFinal cap slot (cteCaps_of s)"
@@ -2584,16 +2580,6 @@ lemma unbindNotification_valid_objs'_helper':
   by (clarsimp simp: valid_bound_tcb'_def valid_ntfn'_def
                   split: option.splits ntfn.splits)
 
-lemma typ_at'_valid_tcb'_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_tcb' tcb s\<rbrace> f \<lbrace>\<lambda>rv s. valid_tcb' tcb s\<rbrace>"
-  including no_pre
-  apply (simp add: valid_tcb'_def)
-  apply (case_tac "tcbState tcb", simp_all add: valid_tcb_state'_def split_def valid_bound_ntfn'_def)
-         apply (wp hoare_vcg_const_Ball_lift typ_at_lifts[OF P]
-               | case_tac "tcbBoundNotification tcb", simp_all)+
-  done
-
 lemmas setNotification_valid_tcb' = typ_at'_valid_tcb'_lift [OF setNotification_typ_at']
 
 lemma unbindNotification_valid_objs'[wp]:
@@ -2726,10 +2712,6 @@ lemma unbindNotification_bound_tcb_at':
   apply (wp setBoundNotification_bound_tcb gbn_wp' | wpc | simp)+
   done
 
-crunches unbindNotification, unbindMaybeNotification
-  for valid_queues[wp]: "Invariants_H.valid_queues"
-  (wp: sbn_valid_queues)
-
 crunches unbindNotification, unbindMaybeNotification
   for weak_sch_act_wf[wp]: "\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s"
 
@@ -2754,6 +2736,36 @@ crunch obj_at'[wp]: prepareThreadDelete
 
 end
 
+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 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
+               split: option.splits)
+
+crunches updateRestartPC, cancelIPC
+  for valid_sched_pointers[wp]: valid_sched_pointers
+  (simp: crunch_simps wp: crunch_wps)
+
+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)))
@@ -2773,21 +2785,22 @@ 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))))\<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 (wp prepares_delete_helper'' [OF cancelAllIPC_unlive]
              prepares_delete_helper'' [OF cancelAllSignals_unlive]
-             suspend_isFinal prepareThreadDelete_unqueued prepareThreadDelete_nonq
+             suspend_isFinal prepareThreadDelete_unqueued
              prepareThreadDelete_inactive prepareThreadDelete_isFinal
-             suspend_makes_inactive suspend_nonq
+             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]],
@@ -2854,7 +2867,9 @@ lemma cancelIPC_cte_wp_at':
   apply (clarsimp simp: cteCaps_of_def cte_wp_at_ctes_of x)
   done
 
-crunch cte_wp_at'[wp]: tcbSchedDequeue "cte_wp_at' P p"
+crunches tcbSchedDequeue
+  for cte_wp_at'[wp]: "cte_wp_at' P p"
+  (wp: crunch_wps)
 
 lemma suspend_cte_wp_at':
   assumes x: "\<And>cap final. P cap \<Longrightarrow> finaliseCap cap final True = fail"
@@ -2979,25 +2994,6 @@ crunch sch_act_not[wp]: cteDeleteOne "sch_act_not t"
   (simp: crunch_simps case_Null_If unless_def
    wp: crunch_wps getObject_inv loadObject_default_inv)
 
-lemma cancelAllIPC_mapM_x_valid_queues:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. \<forall>t\<in>set q. tcb_at' t s)\<rbrace>
-   mapM_x (\<lambda>t. do
-                 y \<leftarrow> setThreadState Structures_H.thread_state.Restart t;
-                 tcbSchedEnqueue t
-               od) q
-   \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (rule_tac R="\<lambda>_ s. (\<forall>t\<in>set q. tcb_at' t s) \<and> valid_objs' s"
-               in hoare_post_add)
-  apply (rule hoare_pre)
-  apply (rule mapM_x_wp')
-  apply (rule hoare_name_pre_state)
-  apply (wp hoare_vcg_const_Ball_lift
-            tcbSchedEnqueue_valid_queues tcbSchedEnqueue_not_st
-            sts_valid_queues sts_st_tcb_at'_cases setThreadState_not_st
-       | simp
-       | ((elim conjE)?, drule (1) bspec, clarsimp elim!: obj_at'_weakenE simp: valid_tcb_state'_def))+
-  done
-
 lemma cancelAllIPC_mapM_x_weak_sch_act:
   "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
    mapM_x (\<lambda>t. do
@@ -3011,13 +3007,15 @@ lemma cancelAllIPC_mapM_x_weak_sch_act:
   done
 
 lemma cancelAllIPC_mapM_x_valid_objs':
-  "\<lbrace>valid_objs'\<rbrace>
+  "\<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 (wpsimp wp: mapM_x_wp' sts_valid_objs')
+  apply (rule hoare_strengthen_post)
+   apply (rule mapM_x_wp')
+  apply (wpsimp wp: sts_valid_objs')
    apply (clarsimp simp: valid_tcb_state'_def)+
   done
 
@@ -3028,17 +3026,12 @@ lemma cancelAllIPC_mapM_x_tcbDomain_obj_at':
                  tcbSchedEnqueue t
                od) q
   \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
-  by (wp mapM_x_wp' tcbSchedEnqueue_not_st setThreadState_oa_queued | simp)+
+  by (wp mapM_x_wp' | simp)+
 
 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)
-  apply (wp tcbSchedEnqueue_not_st
-       | wpc
-       | simp)+
-  done
+  "rescheduleRequired \<lbrace>obj_at' (\<lambda>tcb. Q (tcbDomain tcb) (tcbPriority tcb)) t\<rbrace>"
+  unfolding rescheduleRequired_def tcbSchedEnqueue_def tcbQueuePrepend_def
+  by wpsimp
 
 lemma cancelAllIPC_tcbDomain_obj_at':
   "\<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>
@@ -3052,21 +3045,6 @@ lemma cancelAllIPC_tcbDomain_obj_at':
        | simp)+
   done
 
-lemma cancelAllIPC_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)\<rbrace>
-   cancelAllIPC ep_ptr
-   \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: cancelAllIPC_def ep'_Idle_case_helper)
-  apply (wp hoare_vcg_conj_lift hoare_vcg_const_Ball_lift
-            cancelAllIPC_mapM_x_valid_queues cancelAllIPC_mapM_x_valid_objs' cancelAllIPC_mapM_x_weak_sch_act
-            set_ep_valid_objs' getEndpoint_wp)
-  apply (clarsimp simp: valid_ep'_def)
-  apply (drule (1) ko_at_valid_objs')
-  apply (auto simp: valid_obj'_def valid_ep'_def valid_tcb'_def
-             split: endpoint.splits
-              elim: valid_objs_valid_tcbE)
-  done
-
 lemma cancelAllSignals_tcbDomain_obj_at':
   "\<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>
      cancelAllSignals epptr
@@ -3083,41 +3061,8 @@ 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>"
-  apply (simp add: unbindMaybeNotification_def)
-  apply (wp setBoundNotification_oa_queued getNotification_wp gbn_wp' | wpc | simp)+
-  done
-
-lemma cancelAllSignals_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)\<rbrace>
-   cancelAllSignals ntfn
-   \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: cancelAllSignals_def)
-  apply (rule hoare_seq_ext [OF _ get_ntfn_sp'])
-  apply (case_tac "ntfnObj ntfna", simp_all)
-    apply (wp, simp)+
-    apply (wp hoare_vcg_conj_lift hoare_vcg_const_Ball_lift
-              cancelAllIPC_mapM_x_valid_queues cancelAllIPC_mapM_x_valid_objs' cancelAllIPC_mapM_x_weak_sch_act
-              set_ntfn_valid_objs'
-          | simp)+
-  apply (clarsimp simp: valid_ep'_def)
-  apply (drule (1) ko_at_valid_objs')
-  apply (auto simp: valid_obj'_def valid_ntfn'_def valid_tcb'_def
-             split: endpoint.splits
-              elim: valid_objs_valid_tcbE)
-  done
-
-lemma finaliseCapTrue_standin_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)\<rbrace>
-   finaliseCapTrue_standin cap final
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: finaliseCapTrue_standin_def Let_def)
-  apply (safe)
-       apply (wp | clarsimp | wpc)+
-  done
-
-
-crunch valid_queues[wp]: isFinalCapability "Invariants_H.valid_queues"
-  (simp: crunch_simps)
+  unfolding unbindMaybeNotification_def
+  by (wpsimp wp: getNotification_wp gbn_wp' simp: setBoundNotification_def)+
 
 crunch sch_act[wp]: isFinalCapability "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
   (simp: crunch_simps)
@@ -3126,93 +3071,6 @@ crunch weak_sch_act[wp]:
   isFinalCapability "\<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. \<lbrace>obj_at' (inQ d p) tcb\<rbrace> f \<lbrace>\<lambda>_. obj_at' (inQ d p) tcb\<rbrace>"
-  and     prq: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueues s)\<rbrace>"
-  shows   "\<lbrace>valid_inQ_queues\<rbrace> f \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  proof -
-    show ?thesis
-      apply (clarsimp simp: valid_def valid_inQ_queues_def)
-      apply safe
-       apply (rule use_valid [OF _ tat], assumption)
-       apply (drule spec, drule spec, erule conjE, erule bspec)
-       apply (rule ccontr)
-       apply (erule notE[rotated], erule(1) use_valid [OF _ prq])
-      apply (erule use_valid [OF _ prq])
-      apply simp
-      done
-  qed
-
-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)+
-
-lemma cancelAllIPC_mapM_x_valid_inQ_queues:
-  "\<lbrace>valid_inQ_queues\<rbrace>
-   mapM_x (\<lambda>t. do
-                 y \<leftarrow> setThreadState Structures_H.thread_state.Restart t;
-                 tcbSchedEnqueue t
-               od) q
-   \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (rule mapM_x_wp_inv)
-  apply (wp sts_valid_queues [where st="Structures_H.thread_state.Restart", simplified]
-            setThreadState_st_tcb)
-   done
-
-lemma cancelAllIPC_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace>
-   cancelAllIPC ep_ptr
-   \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (simp add: cancelAllIPC_def ep'_Idle_case_helper)
-  apply (wp cancelAllIPC_mapM_x_valid_inQ_queues)
-  apply (wp hoare_conjI hoare_drop_imp | simp)+
-  done
-
-lemma cancelAllSignals_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace>
-   cancelAllSignals ntfn
-   \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (simp add: cancelAllSignals_def)
-  apply (rule hoare_seq_ext [OF _ get_ntfn_sp'])
-  apply (case_tac "ntfnObj ntfna", simp_all)
-    apply (wp, simp)+
-    apply (wp cancelAllIPC_mapM_x_valid_inQ_queues)+
-   apply (simp)
-  done
-
-crunches unbindNotification, unbindMaybeNotification
-  for valid_inQ_queues[wp]: "valid_inQ_queues"
-
-lemma finaliseCapTrue_standin_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace>
-   finaliseCapTrue_standin cap final
-   \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  apply (simp add: finaliseCapTrue_standin_def Let_def)
-  apply (safe)
-       apply (wp | clarsimp | wpc)+
-  done
-
-crunch valid_inQ_queues[wp]: isFinalCapability valid_inQ_queues
-  (simp: crunch_simps)
-
-lemma cteDeleteOne_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<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)
-  done
-
 crunch ksCurDomain[wp]: cteDeleteOne "\<lambda>s. P (ksCurDomain s)"
   (wp: crunch_wps simp: crunch_simps unless_def)
 
@@ -3703,178 +3561,6 @@ lemma isFinal_lift:
 
 lemmas final_matters'_simps = final_matters'_def [split_simps capability.split arch_capability.split]
 
-definition set_thread_all :: "obj_ref \<Rightarrow> Structures_A.tcb \<Rightarrow> etcb
-                                \<Rightarrow> unit det_ext_monad" where
-  "set_thread_all ptr tcb etcb \<equiv>
-     do s \<leftarrow> get;
-       kh \<leftarrow> return $ (kheap s)(ptr \<mapsto> (TCB tcb));
-       ekh \<leftarrow> return $ (ekheap s)(ptr \<mapsto> etcb);
-       put (s\<lparr>kheap := kh, ekheap := ekh\<rparr>)
-     od"
-
-definition thread_gets_the_all :: "obj_ref \<Rightarrow> (Structures_A.tcb \<times> etcb) det_ext_monad" where
-  "thread_gets_the_all tptr \<equiv>
-          do tcb \<leftarrow> gets_the $ get_tcb tptr;
-             etcb \<leftarrow> gets_the $ get_etcb tptr;
-             return $ (tcb, etcb) od"
-
-definition thread_set_all :: "(Structures_A.tcb \<Rightarrow> Structures_A.tcb) \<Rightarrow> (etcb \<Rightarrow> etcb)
-                  \<Rightarrow> obj_ref \<Rightarrow> unit det_ext_monad" where
-  "thread_set_all f g tptr \<equiv>
-     do (tcb, etcb) \<leftarrow> thread_gets_the_all tptr;
-        set_thread_all tptr (f tcb) (g etcb)
-     od"
-
-lemma set_thread_all_corres:
-  fixes ob' :: "'a :: pspace_storable"
-  assumes x: "updateObject ob' = updateObject_default ob'"
-  assumes z: "\<And>s. obj_at' P ptr s
-               \<Longrightarrow> map_to_ctes ((ksPSpace s) (ptr \<mapsto> injectKO ob')) = map_to_ctes (ksPSpace s)"
-  assumes b: "\<And>ko. P ko \<Longrightarrow> objBits ko = objBits ob'"
-  assumes P: "\<And>(v::'a::pspace_storable). (1 :: machine_word) < 2 ^ (objBits v)"
-  assumes e: "etcb_relation etcb tcb'"
-  assumes is_t: "injectKO (ob' :: 'a :: pspace_storable) = KOTCB tcb'"
-  shows      "other_obj_relation (TCB tcb) (injectKO (ob' :: 'a :: pspace_storable)) \<Longrightarrow>
-  corres dc (obj_at (same_caps (TCB tcb)) ptr and is_etcb_at ptr)
-            (obj_at' (P :: 'a \<Rightarrow> bool) ptr)
-            (set_thread_all ptr tcb etcb) (setObject ptr ob')"
-  apply (rule corres_no_failI)
-   apply (rule no_fail_pre)
-    apply wp
-    apply (rule x)
-   apply (clarsimp simp: b elim!: obj_at'_weakenE)
-  apply (unfold set_thread_all_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
-                        updateObject_default_def in_magnitude_check [OF _ P])
-  apply (clarsimp simp add: state_relation_def z)
-  apply (simp flip: trans_state_update)
-  apply (clarsimp simp add: swp_def fun_upd_def obj_at_def is_etcb_at_def)
-  apply (subst cte_wp_at_after_update,fastforce simp add: obj_at_def)
-  apply (subst caps_of_state_after_update,fastforce simp add: obj_at_def)
-  apply clarsimp
-  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
-                   split: Structures_A.kernel_object.splits if_split_asm)
-
-  apply (fold fun_upd_def)
-  apply (simp only: pspace_relation_def dom_fun_upd2 simp_thms)
-  apply (subst pspace_dom_update)
-    apply assumption
-   apply simp
-  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: is_other_obj_relation_type)
-   apply (drule(1) bspec)
-   apply clarsimp
-   apply (frule_tac ko'="TCB tcb'" and x'=ptr in obj_relation_cut_same_type,
-           (fastforce simp add: is_other_obj_relation_type)+)[1]
-  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 is_t)
-  by (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)
-
-lemma tcb_update_all_corres':
-  assumes tcbs: "tcb_relation tcb tcb' \<Longrightarrow> tcb_relation tcbu tcbu'"
-  assumes tables: "\<forall>(getF, v) \<in> ran tcb_cap_cases. getF tcbu = getF tcb"
-  assumes tables': "\<forall>(getF, v) \<in> ran tcb_cte_cases. getF tcbu' = getF tcb'"
-  assumes r: "r () ()"
-  assumes e: "etcb_relation etcb tcb' \<Longrightarrow> etcb_relation etcbu tcbu'"
-  shows "corres r (ko_at (TCB tcb) add and (\<lambda>s. ekheap s add = Some etcb))
-                  (ko_at' tcb' add)
-                  (set_thread_all add tcbu etcbu) (setObject add tcbu')"
-  apply (rule_tac F="tcb_relation tcb tcb' \<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 (force simp: other_obj_relation_def ekheap_relation_def e)
-  apply (erule conjE)
-  apply (rule corres_guard_imp)
-    apply (rule corres_rel_imp)
-     apply (rule set_thread_all_corres[where P="(=) tcb'"])
-           apply (rule ext)+
-           apply simp
-          defer
-          apply (simp add: is_other_obj_relation_type_def
-                           objBits_simps' other_obj_relation_def tcbs r)+
-    apply (fastforce simp: is_etcb_at_def elim!: obj_at_weakenE dest: bspec[OF tables])
-   apply (subst(asm) eq_commute, assumption)
-  apply (clarsimp simp: obj_at'_def objBits_simps)
-  apply (subst map_to_ctes_upd_tcb, assumption+)
-   apply (simp add: ps_clear_def3 field_simps objBits_defs mask_def)
-  apply (subst if_not_P)
-   apply (fastforce dest: bspec [OF tables', OF ranI])
-  apply simp
-  done
-
-lemma thread_gets_the_all_corres:
-  shows      "corres (\<lambda>(tcb, etcb) tcb'. tcb_relation tcb tcb' \<and> etcb_relation etcb tcb')
-                (tcb_at t and is_etcb_at t) (tcb_at' t)
-                (thread_gets_the_all t) (getObject t)"
-  apply (rule corres_no_failI)
-   apply wp
-  apply (clarsimp simp: gets_def get_def return_def bind_def get_tcb_def thread_gets_the_all_def
-                        threadGet_def ethread_get_def gets_the_def assert_opt_def get_etcb_def
-                        is_etcb_at_def tcb_at_def liftM_def
-                  split: option.splits Structures_A.kernel_object.splits)
-  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 ko)
-   apply (simp_all add: fail_def return_def)
-  apply (clarsimp simp add: state_relation_def pspace_relation_def ekheap_relation_def)
-  apply (drule bspec)
-   apply clarsimp
-   apply blast
-  apply (drule bspec, erule domI)
-  apply (clarsimp simp add: other_obj_relation_def
-                            lookupAround2_known1)
-  done
-
-lemma thread_set_all_corresT:
-  assumes x: "\<And>tcb tcb'. tcb_relation tcb tcb' \<Longrightarrow>
-                         tcb_relation (f tcb) (f' tcb')"
-  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"
-  assumes e: "\<And>etcb tcb'. etcb_relation etcb tcb' \<Longrightarrow>
-                         etcb_relation (g etcb) (f' tcb')"
-  shows      "corres dc (tcb_at t and valid_etcbs)
-                        (tcb_at' t)
-                    (thread_set_all f g t) (threadSet f' t)"
-  apply (simp add: thread_set_all_def threadSet_def bind_assoc)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF thread_gets_the_all_corres])
-      apply (simp add: split_def)
-      apply (rule tcb_update_all_corres')
-          apply (erule x)
-         apply (rule y)
-        apply (clarsimp simp: bspec_split [OF spec [OF z]])
-       apply fastforce
-      apply (erule e)
-     apply (simp add: thread_gets_the_all_def, wp+)
-   apply clarsimp
-   apply (frule(1) tcb_at_is_etcb_at)
-   apply (clarsimp simp add: tcb_at_def get_etcb_def obj_at_def)
-   apply (drule get_tcb_SomeD)
-   apply fastforce
-  apply simp
-  done
-
-lemmas thread_set_all_corres =
-    thread_set_all_corresT [OF _ _ all_tcbI, OF _ ball_tcb_cap_casesI ball_tcb_cte_casesI]
-
 crunch idle_thread[wp]: deleteCallerCap "\<lambda>s. P (ksIdleThread s)"
   (wp: crunch_wps)
 crunch sch_act_simple: deleteCallerCap sch_act_simple
@@ -3890,89 +3576,6 @@ lemma setEndpoint_sch_act_not_ct[wp]:
    setEndpoint ptr val \<lbrace>\<lambda>_ s. sch_act_not (ksCurThread s) s\<rbrace>"
   by (rule hoare_weaken_pre, wps setEndpoint_ct', wp, simp)
 
-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
-
-lemma cancelAllIPC_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>
-   cancelAllIPC epptr
-   \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  (is "\<lbrace>?PRE\<rbrace> _ \<lbrace>\<lambda>_. ?POST\<rbrace>")
-  apply (simp add: cancelAllIPC_def)
-  apply (wp, wpc, wp)
-        apply (wps rescheduleRequired_ct')
-        apply (wp rescheduleRequired_ksQ')
-       apply (clarsimp)
-       apply (wp cancelAll_ct_not_ksQ_helper mapM_x_wp_inv)
-      apply (wp hoare_lift_Pf2 [OF setEndpoint_ksQ setEndpoint_ct'])+
-      apply (wps rescheduleRequired_ct')
-      apply (wp rescheduleRequired_ksQ')
-     apply (clarsimp)
-     apply (wp cancelAll_ct_not_ksQ_helper mapM_x_wp_inv)
-    apply (wp hoare_lift_Pf2 [OF setEndpoint_ksQ setEndpoint_ct'])+
-   prefer 2
-   apply assumption
-  apply (rule_tac Q="\<lambda>ep. ?PRE and ko_at' ep epptr" in hoare_post_imp)
-   apply (clarsimp)
-   apply (rule conjI)
-    apply ((clarsimp simp: invs'_def valid_state'_def
-                           sch_act_sane_def
-            | drule(1) ct_not_in_epQueue)+)[2]
-  apply (wp get_ep_sp')
-  done
-
-lemma cancelAllSignals_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>
-   cancelAllSignals ntfnptr
-   \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  (is "\<lbrace>?PRE\<rbrace> _ \<lbrace>\<lambda>_. ?POST\<rbrace>")
-  apply (simp add: cancelAllSignals_def)
-  apply (wp, wpc, wp+)
-      apply (wps rescheduleRequired_ct')
-      apply (wp rescheduleRequired_ksQ')
-     apply clarsimp
-     apply (wp cancelAll_ct_not_ksQ_helper mapM_x_wp_inv)
-    apply (wp hoare_lift_Pf2 [OF setNotification_ksQ setNotification_ksCurThread])
-    apply (wps setNotification_ksCurThread, wp)
-   prefer 2
-   apply assumption
-  apply (rule_tac Q="\<lambda>ep. ?PRE and ko_at' ep ntfnptr" in hoare_post_imp)
-   apply ((clarsimp simp: invs'_def valid_state'_def sch_act_sane_def
-          | drule(1) ct_not_in_ntfnQueue)+)[1]
-  apply (wp get_ntfn_sp')
-  done
-
-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 hoare_seq_ext[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 setNotification_ksCurThread, wp)
-  apply clarsimp
-  done
-
 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)
@@ -4005,37 +3608,6 @@ lemma unbindMaybeNotification_sch_act_sane[wp]:
   apply (wp setNotification_sch_act_sane sbn_sch_act_sane | wpc | clarsimp)+
   done
 
-lemma finaliseCapTrue_standin_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>
-   finaliseCapTrue_standin cap final
-   \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: finaliseCapTrue_standin_def Let_def)
-  apply (safe)
-      apply (wp cancelAllIPC_ct_not_ksQ cancelAllSignals_ct_not_ksQ
-                hoare_drop_imps unbindMaybeNotification_ct_not_ksQ
-             | wpc
-             | clarsimp simp: isNotificationCap_def isReplyCap_def split:capability.splits)+
-  done
-
-lemma cteDeleteOne_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>
-   cteDeleteOne slot
-   \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: cteDeleteOne_def unless_def split_def)
-  apply (rule hoare_seq_ext [OF _ getCTE_sp])
-  apply (case_tac "\<forall>final. finaliseCap (cteCap cte) final True = fail")
-   apply (simp add: finaliseCapTrue_standin_simple_def)
-   apply wp
-   apply (clarsimp)
-  apply (wp emptySlot_cteCaps_of hoare_lift_Pf2 [OF emptySlot_ksRQ emptySlot_ct])
-    apply (simp add: cteCaps_of_def)
-    apply (wp (once) hoare_drop_imps)
-    apply (wp finaliseCapTrue_standin_ct_not_ksQ isFinalCapability_inv)+
-  apply (clarsimp)
-  done
-
 end
 
 end
diff --git a/proof/refine/RISCV64/Init_R.thy b/proof/refine/RISCV64/Init_R.thy
index 9cac8880a1..7b0d851e7e 100644
--- a/proof/refine/RISCV64/Init_R.thy
+++ b/proof/refine/RISCV64/Init_R.thy
@@ -91,7 +91,7 @@ definition zeroed_intermediate_state ::
     ksDomSchedule = [],
     ksCurDomain = 0,
     ksDomainTime = 0,
-    ksReadyQueues = K [],
+    ksReadyQueues = K (TcbQueue None None),
     ksReadyQueuesL1Bitmap = K 0,
     ksReadyQueuesL2Bitmap = K 0,
     ksCurThread = 0,
@@ -112,9 +112,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: ekheap_relation_def)
-         apply (clarsimp simp: ready_queues_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/RISCV64/InterruptAcc_R.thy b/proof/refine/RISCV64/InterruptAcc_R.thy
index 02a1048ede..367b136b6c 100644
--- a/proof/refine/RISCV64/InterruptAcc_R.thy
+++ b/proof/refine/RISCV64/InterruptAcc_R.thy
@@ -50,14 +50,13 @@ lemma setIRQState_invs[wp]:
   apply (simp add: setIRQState_def setInterruptState_def getInterruptState_def)
   apply (wp dmo_maskInterrupt)
   apply (clarsimp simp: invs'_def valid_state'_def cur_tcb'_def
-                        Invariants_H.valid_queues_def valid_queues'_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)
+                        bitmapQ_defs valid_bitmaps_def)
   apply (rule conjI, clarsimp)
   apply (clarsimp simp: irqs_masked'_def ct_not_inQ_def)
   apply (rule conjI; clarsimp)
@@ -148,8 +147,7 @@ lemma invs'_irq_state_independent [simp, intro!]:
           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_queues_no_bitmap_def
-          valid_queues'_def
+          irqs_masked'_def bitmapQ_defs valid_bitmaps_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
diff --git a/proof/refine/RISCV64/Interrupt_R.thy b/proof/refine/RISCV64/Interrupt_R.thy
index fffa216df0..dcc577606f 100644
--- a/proof/refine/RISCV64/Interrupt_R.thy
+++ b/proof/refine/RISCV64/Interrupt_R.thy
@@ -609,13 +609,6 @@ lemma decDomainTime_corres:
   apply (clarsimp simp:state_relation_def)
   done
 
-lemma tcbSchedAppend_valid_objs':
-  "\<lbrace>valid_objs'\<rbrace>tcbSchedAppend t \<lbrace>\<lambda>r. valid_objs'\<rbrace>"
-  apply (simp add:tcbSchedAppend_def)
-  apply (wpsimp wp: unless_wp threadSet_valid_objs' threadGet_wp)
-  apply (clarsimp simp add:obj_at'_def typ_at'_def)
-  done
-
 lemma thread_state_case_if:
  "(case state of Structures_A.thread_state.Running \<Rightarrow> f | _ \<Rightarrow> g) =
   (if state = Structures_A.thread_state.Running then f else g)"
@@ -626,26 +619,19 @@ lemma threadState_case_if:
   (if state = Structures_H.thread_state.Running then f else g)"
   by (case_tac state,auto)
 
-lemma tcbSchedAppend_invs_but_ct_not_inQ':
-  "\<lbrace>invs' and st_tcb_at' runnable' t \<rbrace>
-   tcbSchedAppend t \<lbrace>\<lambda>_. all_invs_but_ct_not_inQ'\<rbrace>"
-  apply (simp add: invs'_def valid_state'_def)
-  apply (rule hoare_pre)
-   apply (wp 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
-        | fastforce elim!: st_tcb_ex_cap'' split: thread_state.split_asm)+
-  done
+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 timerTick_corres:
-  "corres dc (cur_tcb and valid_sched and pspace_aligned and pspace_distinct)
-             invs'
-             timer_tick timerTick"
+  "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="\<top> and (cur_tcb and valid_sched and pspace_aligned and pspace_distinct)"
-                  and Q'="\<top> and invs'" in corres_guard_imp)
+  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
@@ -665,63 +651,71 @@ lemma timerTick_corres:
                 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])
+                  apply (rule corres_split[OF tcbSchedAppend_corres], simp)
                     apply (rule rescheduleRequired_corres)
-                   apply (wp)[1]
-                  apply (rule hoare_strengthen_post)
-                   apply (rule tcbSchedAppend_invs_but_ct_not_inQ', clarsimp simp: sch_act_wf_weak)
-                 apply (wp threadSet_timeslice_invs threadSet_valid_queues
-                           threadSet_valid_queues' threadSet_pred_tcb_at_state)+
-             apply simp
-            apply (rule corres_when,simp)
+                   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 (simp add:dec_domain_time_def)
-             apply wp+
-            apply (simp add:decDomainTime_def)
-            apply wp
-           apply (wpsimp wp: hoare_weak_lift_imp threadSet_timeslice_invs threadSet_valid_queues
-                             threadSet_valid_queues' tcbSchedAppend_valid_objs'
+             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 tcbSchedAppend_valid_queues)+
-             apply (strengthen sch_act_wf_weak)
-             apply (clarsimp simp:conj_comms)
-             apply (wp tcbSchedAppend_valid_queues tcbSchedAppend_sch_act_wf)
-            apply simp
-            apply (wpsimp wp: threadSet_valid_queues threadSet_pred_tcb_at_state threadSet_sch_act
-                              threadSet_tcbDomain_triv threadSet_valid_queues' threadSet_valid_objs'
-                              threadGet_wp gts_wp gts_wp')+
-     apply (clarsimp simp: cur_tcb_def tcb_at_is_etcb_at valid_sched_def valid_sched_action_def)
-    apply (clarsimp simp: invs'_def valid_state'_def sch_act_wf_weak cur_tcb'_def inQ_def
-                          ct_in_state'_def obj_at'_def)
-    apply (clarsimp simp:st_tcb_at'_def valid_idle'_def ct_idle_or_in_cur_domain'_def obj_at'_def)
-   apply simp
-  apply simp
+                             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) (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 (einvs) ?P' ?f ?g")
-  apply (simp add: handle_interrupt_def handleInterrupt_def )
+  (is "corres dc ?P ?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. einvs"
+                               where R="\<lambda>rv. ?P"
                                  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 )+
-   apply (rule corres_guard_imp)
-     apply (rule corres_split)
-        apply (rule corres_machine_op, rule corres_eq_trivial ; (simp add: dc_def no_fail_maskInterrupt no_fail_bind no_fail_ackInterrupt)+)+
-      apply ((wp | simp)+)[4]
+       apply (wp getIRQState_prop getIRQState_inv do_machine_op_bind doMachineOp_bind
+              | simp add: do_machine_op_bind doMachineOp_bind valid_sched_def)+
+   apply (corres corres: corres_machine_op)
 
   apply (rule corres_gen_asm2)
   apply (case_tac st, simp_all add: irq_state_relation_def split: irqstate.split_asm)
@@ -751,7 +745,7 @@ lemma handleInterrupt_corres:
       apply (rule corres_machine_op)
       apply (rule corres_eq_trivial, (simp add: no_fail_ackInterrupt)+)
      apply wp+
-   apply (clarsimp simp: invs_distinct invs_psp_aligned)
+   apply (clarsimp simp: invs_distinct invs_psp_aligned schact_is_rct_def)
   apply clarsimp
   done
 
@@ -774,14 +768,6 @@ lemma updateTimeSlice_valid_pspace[wp]:
   apply (auto simp:tcb_cte_cases_def cteSizeBits_def)
   done
 
-lemma updateTimeSlice_valid_queues[wp]:
-  "\<lbrace>\<lambda>s. Invariants_H.valid_queues s \<rbrace>
-   threadSet (tcbTimeSlice_update (\<lambda>_. ts')) thread
-   \<lbrace>\<lambda>r s. Invariants_H.valid_queues s\<rbrace>"
-  apply (wp threadSet_valid_queues,simp)
-  apply (clarsimp simp:obj_at'_def inQ_def)
-  done
-
 crunches tcbSchedAppend
   for irq_handlers'[wp]: valid_irq_handlers'
   and irqs_masked'[wp]: irqs_masked'
@@ -789,29 +775,29 @@ crunches tcbSchedAppend
   (simp: unless_def tcb_cte_cases_def cteSizeBits_def wp: crunch_wps cur_tcb_lift)
 
 lemma timerTick_invs'[wp]:
-  "\<lbrace>invs'\<rbrace> timerTick \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  "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
-                    tcbSchedAppend_invs_but_ct_not_inQ'
-                simp: tcb_cte_cases_def)
-     apply (rule_tac Q="\<lambda>rv. invs'" in hoare_post_imp)
-     apply (clarsimp simp add:invs'_def valid_state'_def)
+              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'
-                          del: tcbSchedAppend_sch_act_wf)+
-             apply (rule hoare_strengthen_post[OF tcbSchedAppend_invs_but_ct_not_inQ'])
-             apply (wpsimp simp: valid_pspace'_def sch_act_wf_weak)+
-           apply (wpsimp wp: threadSet_pred_tcb_no_state threadSet_tcbDomain_triv
-                             threadSet_valid_objs' threadSet_timeslice_invs)+
-       apply (wp threadGet_wp)
+            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 (clarsimp simp: invs'_def st_tcb_at'_def obj_at'_def valid_state'_def)
+  apply (auto simp: invs'_def st_tcb_at'_def obj_at'_def valid_state'_def cong: conj_cong)
   done
 
 lemma resetTimer_invs'[wp]:
diff --git a/proof/refine/RISCV64/InvariantUpdates_H.thy b/proof/refine/RISCV64/InvariantUpdates_H.thy
index 938a45b494..41354e5a19 100644
--- a/proof/refine/RISCV64/InvariantUpdates_H.thy
+++ b/proof/refine/RISCV64/InvariantUpdates_H.thy
@@ -38,8 +38,9 @@ lemma invs'_machine:
 proof -
   show ?thesis
     apply (cases "ksSchedulerAction s")
-    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_queues_def valid_queues_no_bitmap_def bitmapQ_defs
+    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
@@ -56,12 +57,13 @@ lemma invs_no_cicd'_machine:
 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_queues_def valid_queues_no_bitmap_def bitmapQ_defs
-                    vms ct_not_inQ_def
-                    state_refs_of'_def ps_clear_def
-                    valid_irq_node'_def mask
-              cong: option.case_cong)
+    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)
     done
 qed
 
@@ -98,14 +100,9 @@ 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_queues_ksSchedulerAction_update[simp]:
-  "valid_queues (ksSchedulerAction_update f s) = valid_queues s"
- unfolding valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs
- by simp
-
-lemma valid_queues'_ksSchedulerAction_update[simp]:
-  "valid_queues' (ksSchedulerAction_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_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'"
@@ -140,45 +137,25 @@ lemma tcb_in_cur_domain_ct[simp]:
   "tcb_in_cur_domain' t  (ksCurThread_update f s) = tcb_in_cur_domain' t s"
   by (fastforce simp: tcb_in_cur_domain'_def)
 
-lemma valid_queues'_ksCurDomain[simp]:
-  "valid_queues' (ksCurDomain_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
-
-lemma valid_queues'_ksDomScheduleIdx[simp]:
-  "valid_queues' (ksDomScheduleIdx_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
+lemma valid_bitmaps_ksCurDomain[simp]:
+  "valid_bitmaps (ksCurDomain_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
 
-lemma valid_queues'_ksDomSchedule[simp]:
-  "valid_queues' (ksDomSchedule_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
+lemma valid_bitmaps_ksDomScheduleIdx[simp]:
+  "valid_bitmaps (ksDomScheduleIdx_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
 
-lemma valid_queues'_ksDomainTime[simp]:
-  "valid_queues' (ksDomainTime_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
+lemma valid_bitmaps_ksDomSchedule[simp]:
+   "valid_bitmaps (ksDomSchedule_update f s) = valid_bitmaps s"
+   by (simp add: valid_bitmaps_def bitmapQ_defs)
 
-lemma valid_queues'_ksWorkUnitsCompleted[simp]:
-  "valid_queues' (ksWorkUnitsCompleted_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
+lemma valid_bitmaps_ksDomainTime[simp]:
+  "valid_bitmaps (ksDomainTime_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
 
-lemma valid_queues_ksCurDomain[simp]:
-  "valid_queues (ksCurDomain_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
-
-lemma valid_queues_ksDomScheduleIdx[simp]:
-  "valid_queues (ksDomScheduleIdx_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
-
-lemma valid_queues_ksDomSchedule[simp]:
-  "valid_queues (ksDomSchedule_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
-
-lemma valid_queues_ksDomainTime[simp]:
-  "valid_queues (ksDomainTime_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
-
-lemma valid_queues_ksWorkUnitsCompleted[simp]:
-  "valid_queues (ksWorkUnitsCompleted_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
+lemma valid_bitmaps_ksWorkUnitsCompleted[simp]:
+  "valid_bitmaps (ksWorkUnitsCompleted_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
 
 lemma valid_irq_node'_ksCurDomain[simp]:
   "valid_irq_node' w (ksCurDomain_update f s) = valid_irq_node' w s"
@@ -255,6 +232,10 @@ lemma valid_mdb_interrupts'[simp]:
   "valid_mdb' (ksInterruptState_update f s) = valid_mdb' s"
   by (simp add: valid_mdb'_def)
 
+lemma valid_mdb'_ksReadyQueues_update[simp]:
+  "valid_mdb' (ksReadyQueues_update f s) = valid_mdb' s"
+  by (simp add: valid_mdb'_def)
+
 lemma vms_ksReadyQueues_update[simp]:
   "valid_machine_state' (ksReadyQueues_update f s) = valid_machine_state' s"
   by (simp add: valid_machine_state'_def)
@@ -279,10 +260,10 @@ lemma ct_in_state_ksSched[simp]:
 
 lemma invs'_wu [simp]:
   "invs' (ksWorkUnitsCompleted_update f s) = invs' s"
-  apply (simp add: invs'_def cur_tcb'_def valid_state'_def Invariants_H.valid_queues_def
-                   valid_queues'_def valid_irq_node'_def valid_machine_state'_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 valid_queues_no_bitmap_def)
+                   bitmapQ_defs)
   done
 
 lemma valid_arch_state'_interrupt[simp]:
@@ -334,9 +315,8 @@ lemma sch_act_simple_ksReadyQueuesL2Bitmap[simp]:
 
 lemma ksDomainTime_invs[simp]:
   "invs' (ksDomainTime_update f s) = invs' s"
-  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)
+  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"
@@ -364,9 +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 valid_state'_def valid_queues_def valid_queues'_def
-                      valid_irq_node'_def cur_tcb'_def ct_idle_or_in_cur_domain'_def
-                      tcb_in_cur_domain'_def valid_queues_no_bitmap_def
-                      bitmapQ_no_L2_orphans_def bitmapQ_no_L1_orphans_def)
+   by (clarsimp simp: invs'_def valid_state'_def valid_queues_def valid_irq_node'_def cur_tcb'_def
+                      ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def bitmapQ_defs)
 
 end
\ No newline at end of file
diff --git a/proof/refine/RISCV64/Invariants_H.thy b/proof/refine/RISCV64/Invariants_H.thy
index 8a3518e556..5cc523ed1e 100644
--- a/proof/refine/RISCV64/Invariants_H.thy
+++ b/proof/refine/RISCV64/Invariants_H.thy
@@ -8,6 +8,7 @@ theory Invariants_H
 imports
   LevityCatch
   "AInvs.ArchDetSchedSchedule_AI"
+  "Lib.Heap_List"
 begin
 
 (* global data and code of the kernel, not covered by any cap *)
@@ -137,6 +138,21 @@ definition cte_wp_at' :: "(cte \<Rightarrow> bool) \<Rightarrow> obj_ref \<Right
 abbreviation cte_at' :: "obj_ref \<Rightarrow> kernel_state \<Rightarrow> bool" where
   "cte_at' \<equiv> cte_wp_at' \<top>"
 
+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 tcbSchedPrevs_of :: "kernel_state \<Rightarrow> obj_ref \<Rightarrow> obj_ref option" where
+   "tcbSchedPrevs_of s \<equiv> tcbs_of' s |> tcbSchedPrev"
+
+abbreviation tcbSchedNexts_of :: "kernel_state \<Rightarrow> obj_ref \<Rightarrow> obj_ref option" where
+  "tcbSchedNexts_of s \<equiv> tcbs_of' s |> tcbSchedNext"
+
+abbreviation sym_heap_sched_pointers :: "global.kernel_state \<Rightarrow> bool" where
+  "sym_heap_sched_pointers s \<equiv> sym_heap (tcbSchedNexts_of s) (tcbSchedPrevs_of s)"
+
 definition tcb_cte_cases :: "machine_word \<rightharpoonup> ((tcb \<Rightarrow> cte) \<times> ((cte \<Rightarrow> cte) \<Rightarrow> tcb \<Rightarrow> tcb))" where
  "tcb_cte_cases \<equiv> [ 0 << cteSizeBits \<mapsto> (tcbCTable, tcbCTable_update),
                     1 << cteSizeBits \<mapsto> (tcbVTable, tcbVTable_update),
@@ -188,8 +204,10 @@ definition state_refs_of' :: "kernel_state \<Rightarrow> obj_ref \<Rightarrow> (
 
 fun live' :: "kernel_object \<Rightarrow> bool" where
   "live' (KOTCB tcb) =
-     (bound (tcbBoundNotification 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' (KOEndpoint ep)       = (ep \<noteq> IdleEP)"
 | "live' (KONotification ntfn) = (bound (ntfnBoundTCB ntfn) \<or> (\<exists>ts. ntfnObj ntfn = WaitingNtfn ts))"
 | "live' _                     = False"
@@ -387,6 +405,11 @@ definition valid_bound_ntfn' :: "machine_word option \<Rightarrow> kernel_state
 definition is_device_frame_cap' :: "capability \<Rightarrow> bool" where
   "is_device_frame_cap' cap \<equiv> case cap of ArchObjectCap (FrameCap _ _ _ 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
   "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
@@ -394,7 +417,9 @@ definition valid_tcb' :: "tcb \<Rightarrow> kernel_state \<Rightarrow> bool" whe
                   \<and> valid_bound_ntfn' (tcbBoundNotification t) s
                   \<and> tcbDomain t \<le> maxDomain
                   \<and> tcbPriority t \<le> maxPriority
-                  \<and> tcbMCP 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
   "valid_ep' ep s \<equiv> case ep of
@@ -402,7 +427,6 @@ definition valid_ep' :: "Structures_H.endpoint \<Rightarrow> kernel_state \<Righ
    | SendEP ts \<Rightarrow> (ts \<noteq> [] \<and> (\<forall>t \<in> set ts. tcb_at' t s) \<and> distinct ts)
    | RecvEP ts \<Rightarrow> (ts \<noteq> [] \<and> (\<forall>t \<in> set ts. tcb_at' t s) \<and> distinct ts)"
 
-
 definition valid_bound_tcb' :: "machine_word 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"
 
@@ -733,10 +757,15 @@ where
 | "runnable' (Structures_H.BlockedOnSend a b c d e) = False"
 | "runnable' (Structures_H.BlockedOnNotification x) = False"
 
-definition
-  inQ :: "domain \<Rightarrow> priority \<Rightarrow> tcb \<Rightarrow> bool"
-where
- "inQ d p tcb \<equiv> tcbQueued tcb \<and> tcbPriority tcb = p \<and> tcbDomain tcb = d"
+definition inQ :: "domain \<Rightarrow> priority \<Rightarrow> tcb \<Rightarrow> bool" where
+  "inQ d p tcb \<equiv> tcbQueued tcb \<and> tcbPriority tcb = p \<and> tcbDomain tcb = d"
+
+lemma inQ_implies_tcbQueueds_of:
+  "(inQ domain priority |< tcbs_of' s') tcbPtr \<Longrightarrow> (tcbQueued |< tcbs_of' s') tcbPtr"
+  by (clarsimp simp: opt_map_def opt_pred_def inQ_def split: option.splits)
+
+defs ready_qs_runnable_def:
+  "ready_qs_runnable s \<equiv> \<forall>t. obj_at' tcbQueued t s \<longrightarrow> st_tcb_at' runnable' t s"
 
 definition
   (* for given domain and priority, the scheduler bitmap indicates a thread is in the queue *)
@@ -746,15 +775,6 @@ where
   "bitmapQ d p s \<equiv> ksReadyQueuesL1Bitmap s d !! prioToL1Index p
                      \<and> ksReadyQueuesL2Bitmap s (d, invertL1Index (prioToL1Index p))
                          !! unat (p && mask wordRadix)"
-
-definition
-  valid_queues_no_bitmap :: "kernel_state \<Rightarrow> bool"
-where
- "valid_queues_no_bitmap \<equiv> \<lambda>s.
-   (\<forall>d p. (\<forall>t \<in> set (ksReadyQueues s (d, p)). obj_at' (inQ d p and runnable' \<circ> tcbState) t s)
-    \<and>  distinct (ksReadyQueues s (d, p))
-    \<and> (d > maxDomain \<or> p > maxPriority \<longrightarrow> ksReadyQueues s (d,p) = []))"
-
 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
@@ -778,31 +798,62 @@ where
     \<forall>d i. ksReadyQueuesL1Bitmap s d !! i \<longrightarrow> ksReadyQueuesL2Bitmap s (d, invertL1Index i) \<noteq> 0 \<and>
                                              i < l2BitmapSize"
 
-definition
-  valid_bitmapQ :: "kernel_state \<Rightarrow> bool"
-where
-  "valid_bitmapQ \<equiv> \<lambda>s. (\<forall>d p. bitmapQ d p s \<longleftrightarrow> ksReadyQueues s (d,p) \<noteq> [])"
+definition valid_bitmapQ :: "kernel_state \<Rightarrow> bool" where
+  "valid_bitmapQ \<equiv> \<lambda>s. \<forall>d p. bitmapQ d p s \<longleftrightarrow> \<not> tcbQueueEmpty (ksReadyQueues s (d,p))"
 
-definition
-  valid_queues :: "kernel_state \<Rightarrow> bool"
-where
- "valid_queues \<equiv> \<lambda>s. valid_queues_no_bitmap s \<and> valid_bitmapQ s \<and>
-                     bitmapQ_no_L2_orphans s \<and> bitmapQ_no_L1_orphans s"
+definition valid_bitmaps :: "kernel_state \<Rightarrow> bool" where
+  "valid_bitmaps \<equiv> \<lambda>s. valid_bitmapQ s \<and> bitmapQ_no_L2_orphans s \<and> bitmapQ_no_L1_orphans s"
 
-definition
-  (* when a thread gets added to / removed from a queue, but before bitmap updated *)
-  valid_bitmapQ_except :: "domain \<Rightarrow> priority \<Rightarrow> kernel_state \<Rightarrow> bool"
-where
+lemma valid_bitmaps_valid_bitmapQ[elim!]:
+  "valid_bitmaps s \<Longrightarrow> valid_bitmapQ s"
+  by (simp add: valid_bitmaps_def)
+
+lemma valid_bitmaps_bitmapQ_no_L2_orphans[elim!]:
+  "valid_bitmaps s \<Longrightarrow> bitmapQ_no_L2_orphans s"
+  by (simp add: valid_bitmaps_def)
+
+lemma valid_bitmaps_bitmapQ_no_L1_orphans[elim!]:
+  "valid_bitmaps s \<Longrightarrow> bitmapQ_no_L1_orphans s"
+  by (simp add: valid_bitmaps_def)
+
+lemma valid_bitmaps_lift:
+  assumes prq: "\<And>P. f \<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace>"
+  assumes prqL1: "\<And>P. f \<lbrace>\<lambda>s. P (ksReadyQueuesL1Bitmap s)\<rbrace>"
+  assumes prqL2: "\<And>P. f \<lbrace>\<lambda>s. P (ksReadyQueuesL2Bitmap s)\<rbrace>"
+  shows "f \<lbrace>valid_bitmaps\<rbrace>"
+  unfolding valid_bitmaps_def valid_bitmapQ_def bitmapQ_def
+            bitmapQ_no_L1_orphans_def bitmapQ_no_L2_orphans_def
+  apply (rule hoare_pre)
+   apply (wps assms | wpsimp)+
+  done
+
+(* when a thread gets added to / removed from a queue, but before bitmap updated *)
+definition valid_bitmapQ_except :: "domain \<Rightarrow> priority \<Rightarrow> kernel_state \<Rightarrow> bool" where
   "valid_bitmapQ_except d' p' \<equiv> \<lambda>s.
-    (\<forall>d p. (d \<noteq> d' \<or> p \<noteq> p') \<longrightarrow> (bitmapQ d p s \<longleftrightarrow> ksReadyQueues s (d,p) \<noteq> []))"
+    \<forall>d p. (d \<noteq> d' \<or> p \<noteq> p') \<longrightarrow> (bitmapQ d p s \<longleftrightarrow> \<not> tcbQueueEmpty (ksReadyQueues s (d,p)))"
 
 lemmas bitmapQ_defs = valid_bitmapQ_def valid_bitmapQ_except_def bitmapQ_def
                        bitmapQ_no_L2_orphans_def bitmapQ_no_L1_orphans_def
 
-definition
-  valid_queues' :: "kernel_state \<Rightarrow> bool"
-where
- "valid_queues' \<equiv> \<lambda>s. \<forall>d p t. obj_at' (inQ d p) t s \<longrightarrow> t \<in> set (ksReadyQueues s (d, p))"
+\<comment> \<open>
+  The tcbSchedPrev and tcbSchedNext fields of a TCB are used only to indicate membership in
+  one of the ready queues. \<close>
+definition valid_sched_pointers_2 ::
+  "(obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> (obj_ref \<Rightarrow> bool) \<Rightarrow> bool "
+  where
+  "valid_sched_pointers_2 prevs nexts ready \<equiv>
+     \<forall>ptr. prevs ptr \<noteq> None \<or> nexts ptr \<noteq> None \<longrightarrow> ready ptr"
+
+abbreviation valid_sched_pointers :: "kernel_state \<Rightarrow> bool" where
+  "valid_sched_pointers s \<equiv>
+     valid_sched_pointers_2 (tcbSchedPrevs_of s) (tcbSchedNexts_of s) (tcbQueued |< tcbs_of' s)"
+
+lemmas valid_sched_pointers_def = valid_sched_pointers_2_def
+
+lemma valid_sched_pointersD:
+  "\<lbrakk>valid_sched_pointers s; \<not> (tcbQueued |< tcbs_of' s) t\<rbrakk>
+   \<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 tcb_in_cur_domain' :: "machine_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"
@@ -949,7 +1000,7 @@ abbreviation
 
 definition valid_state' :: "kernel_state \<Rightarrow> bool" where
   "valid_state' \<equiv> \<lambda>s. valid_pspace' s \<and> sch_act_wf (ksSchedulerAction s) s
-                      \<and> valid_queues s \<and> sym_refs (state_refs_of' 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
@@ -958,7 +1009,9 @@ definition valid_state' :: "kernel_state \<Rightarrow> bool" where
                       \<and> valid_irq_states' s
                       \<and> valid_machine_state' s
                       \<and> irqs_masked' s
-                      \<and> valid_queues' 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> pspace_domain_valid s
@@ -1009,6 +1062,11 @@ definition
 abbreviation
   "active' st \<equiv> st = Structures_H.Running \<or> st = Structures_H.Restart"
 
+lemma runnable_eq_active': "runnable' = active'"
+  apply (rule ext)
+  apply (case_tac st, simp_all)
+  done
+
 abbreviation
   "simple' st \<equiv> st = Structures_H.Inactive \<or>
                 st = Structures_H.Running \<or>
@@ -1024,11 +1082,13 @@ abbreviation
 abbreviation(input)
  "all_invs_but_sym_refs_ct_not_inQ'
     \<equiv> \<lambda>s. valid_pspace' s \<and> sch_act_wf (ksSchedulerAction s) s
-           \<and> valid_queues s \<and> if_live_then_nonz_cap' s \<and> if_unsafe_then_cap' 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> cur_tcb' s \<and> valid_queues' s \<and> ct_idle_or_in_cur_domain' s
+           \<and> valid_irq_states' s \<and> irqs_masked' s
+           \<and> sym_heap_sched_pointers s \<and> valid_sched_pointers s \<and> valid_bitmaps s
+           \<and> valid_machine_state' s
+           \<and> cur_tcb' s \<and> ct_idle_or_in_cur_domain' s
            \<and> pspace_domain_valid s
            \<and> ksCurDomain s \<le> maxDomain
            \<and> valid_dom_schedule' s \<and> untyped_ranges_zero' s"
@@ -1036,12 +1096,14 @@ abbreviation(input)
 abbreviation(input)
  "all_invs_but_ct_not_inQ'
     \<equiv> \<lambda>s. valid_pspace' s \<and> sch_act_wf (ksSchedulerAction s) s
-           \<and> valid_queues s \<and> sym_refs (state_refs_of' 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> cur_tcb' s \<and> valid_queues' s \<and> ct_idle_or_in_cur_domain' s
+           \<and> valid_irq_states' s \<and> irqs_masked' s
+           \<and> sym_heap_sched_pointers s \<and> valid_sched_pointers s \<and> valid_bitmaps s
+           \<and> valid_machine_state' s
+           \<and> cur_tcb' s \<and> ct_idle_or_in_cur_domain' s
            \<and> pspace_domain_valid s
            \<and> ksCurDomain s \<le> maxDomain
            \<and> valid_dom_schedule' s \<and> untyped_ranges_zero' s"
@@ -1057,12 +1119,14 @@ lemma all_invs_but_not_ct_inQ_check':
 definition
   "all_invs_but_ct_idle_or_in_cur_domain'
     \<equiv> \<lambda>s. valid_pspace' s \<and> sch_act_wf (ksSchedulerAction s) s
-           \<and> valid_queues s \<and> sym_refs (state_refs_of' 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> cur_tcb' s \<and> valid_queues' s \<and> ct_not_inQ s
+           \<and> valid_irq_states' s \<and> irqs_masked' s
+           \<and> sym_heap_sched_pointers s \<and> valid_sched_pointers s \<and> valid_bitmaps s
+           \<and> valid_machine_state' s
+           \<and> cur_tcb' s \<and> ct_not_inQ s
            \<and> pspace_domain_valid s
            \<and> ksCurDomain s \<le> maxDomain
            \<and> valid_dom_schedule' s \<and> untyped_ranges_zero' s"
@@ -2767,9 +2831,9 @@ lemma sch_act_wf_arch [simp]:
   "sch_act_wf sa (ksArchState_update f s) = sch_act_wf sa s"
   by (cases sa) (simp_all add: ct_in_state'_def  tcb_in_cur_domain'_def)
 
-lemma valid_queues_arch [simp]:
-  "valid_queues (ksArchState_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
+lemma valid_bitmaps_arch[simp]:
+  "valid_bitmaps (ksArchState_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
 
 lemma if_unsafe_then_cap_arch' [simp]:
   "if_unsafe_then_cap' (ksArchState_update f s) = if_unsafe_then_cap' s"
@@ -2787,22 +2851,14 @@ lemma sch_act_wf_machine_state [simp]:
   "sch_act_wf sa (ksMachineState_update f s) = sch_act_wf sa s"
   by (cases sa) (simp_all add: ct_in_state'_def  tcb_in_cur_domain'_def)
 
-lemma valid_queues_machine_state [simp]:
-  "valid_queues (ksMachineState_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
-
-lemma valid_queues_arch' [simp]:
-  "valid_queues' (ksArchState_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
-
-lemma valid_queues_machine_state' [simp]:
-  "valid_queues' (ksMachineState_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
-
 lemma valid_irq_node'_machine_state [simp]:
   "valid_irq_node' x (ksMachineState_update f s) = valid_irq_node' x s"
   by (simp add: valid_irq_node'_def)
 
+lemma valid_bitmaps_machine_state[simp]:
+  "valid_bitmaps (ksMachineState_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
+
 (* these should be reasonable safe for automation because of the 0 pattern *)
 lemma no_0_ko_wp' [elim!]:
   "\<lbrakk> ko_wp_at' Q 0 s; no_0_obj' s \<rbrakk> \<Longrightarrow> P"
@@ -2884,19 +2940,6 @@ lemma typ_at_aligned':
   "\<lbrakk> typ_at' tp p s \<rbrakk> \<Longrightarrow> is_aligned p (objBitsT tp)"
   by (clarsimp simp add: typ_at'_def ko_wp_at'_def objBitsT_koTypeOf)
 
-lemma valid_queues_obj_at'D:
-   "\<lbrakk> t \<in> set (ksReadyQueues s (d, p)); valid_queues s \<rbrakk>
-        \<Longrightarrow> obj_at' (inQ d p) t s"
-  apply (unfold valid_queues_def valid_queues_no_bitmap_def)
-  apply (elim conjE)
-  apply (drule_tac x=d in spec)
-  apply (drule_tac x=p in spec)
-  apply (clarsimp)
-  apply (drule(1) bspec)
-  apply (erule obj_at'_weakenE)
-  apply (clarsimp)
-  done
-
 lemma obj_at'_and:
   "obj_at' (P and P') t s = (obj_at' P t s \<and> obj_at' P' t s)"
   by (rule iffI, (clarsimp simp: obj_at'_def)+)
@@ -2938,21 +2981,6 @@ lemma obj_at'_ko_at'_prop:
   "ko_at' ko t s \<Longrightarrow> obj_at' P t s = P ko"
   by (drule obj_at_ko_at', clarsimp simp: obj_at'_def)
 
-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> st_tcb_at' runnable' t s) \<and>
-                  distinct (ksReadyQueues s (d, p)) \<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_queues_running:
-  assumes Q: "t \<in> set(ksReadyQueues s (d, p))" "valid_queues s"
-  shows "st_tcb_at' runnable' t s"
-  using assms by (clarsimp simp add: valid_queues_def valid_queues_no_bitmap_def')
-
 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)
@@ -3033,8 +3061,16 @@ 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_queues [elim!]:
-  "invs' s \<Longrightarrow> valid_queues s"
+lemma invs_valid_bitmaps[elim!]:
+  "invs' s \<Longrightarrow> valid_bitmaps s"
+  by (simp add: invs'_def valid_state'_def)
+
+lemma invs_sym_heap_sched_pointers[elim!]:
+  "invs' s \<Longrightarrow> sym_heap_sched_pointers s"
+  by (simp add: invs'_def valid_state'_def)
+
+lemma invs_valid_sched_pointers[elim!]:
+  "invs' s \<Longrightarrow> valid_sched_pointers s"
   by (simp add: invs'_def valid_state'_def)
 
 lemma invs_valid_idle'[elim!]:
@@ -3049,18 +3085,12 @@ 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_valid_queues'_strg:
-  "invs' s \<longrightarrow> valid_queues' s"
-  by (clarsimp simp: invs'_def valid_state'_def)
-
-lemmas invs_valid_queues'[elim!] = invs_valid_queues'_strg[rule_format]
-
 lemma einvs_valid_etcbs: "einvs s \<longrightarrow> valid_etcbs s"
   by (clarsimp simp: valid_sched_def)
 
 lemma invs'_bitmapQ_no_L1_orphans:
   "invs' s \<Longrightarrow> bitmapQ_no_L1_orphans s"
-  by (drule invs_queues, simp add: valid_queues_def)
+  by (simp add: invs'_def valid_state'_def valid_bitmaps_def)
 
 lemma invs_ksCurDomain_maxDomain' [elim!]:
   "invs' s \<Longrightarrow> ksCurDomain s \<le> maxDomain"
@@ -3085,32 +3115,22 @@ lemma invs_no_0_obj'[elim!]:
 
 lemma invs'_gsCNodes_update[simp]:
   "invs' (gsCNodes_update f s') = invs' s'"
-  apply (clarsimp simp: invs'_def valid_state'_def valid_queues_def valid_queues_no_bitmap_def
-             bitmapQ_defs
-             valid_queues'_def 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'")
-  apply (simp_all add: ct_in_state'_def tcb_in_cur_domain'_def ct_idle_or_in_cur_domain'_def ct_not_inQ_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_state'_def valid_queues_def valid_queues_no_bitmap_def
-             bitmapQ_defs
-             valid_queues'_def 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'")
-  apply (simp_all add: ct_in_state'_def ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def ct_not_inQ_def)
-  done
-
-lemma invs_queues_tcb_in_cur_domain':
-  "\<lbrakk> ksReadyQueues s (d, p) = x # xs; invs' s; d = ksCurDomain s\<rbrakk>
-     \<Longrightarrow> tcb_in_cur_domain' x s"
-  apply (subgoal_tac "x \<in> set (ksReadyQueues s (d, p))")
-   apply (drule (1) valid_queues_obj_at'D[OF _ invs_queues])
-   apply (auto simp: inQ_def tcb_in_cur_domain'_def elim: obj_at'_weakenE)
+  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:
@@ -3126,7 +3146,7 @@ lemma invs'_ksDomScheduleIdx:
 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> ksReadyQueues s (d,p) \<noteq> []) ;
+  "\<lbrakk> valid_bitmapQ_except d p s; bitmapQ d p s \<longleftrightarrow> \<not> tcbQueueEmpty (ksReadyQueues s (d,p));
      bitmapQ_no_L2_orphans s \<rbrakk>
    \<Longrightarrow> valid_bitmapQ s"
   unfolding valid_bitmapQ_def valid_bitmapQ_except_def
diff --git a/proof/refine/RISCV64/IpcCancel_R.thy b/proof/refine/RISCV64/IpcCancel_R.thy
index 4bc46d5ded..2f0bf9932d 100644
--- a/proof/refine/RISCV64/IpcCancel_R.thy
+++ b/proof/refine/RISCV64/IpcCancel_R.thy
@@ -38,25 +38,6 @@ lemma cancelSignal_pred_tcb_at':
 crunch pred_tcb_at'[wp]: emptySlot "pred_tcb_at' proj P t"
   (wp: setCTE_pred_tcb_at')
 
-(* valid_queues is too strong *)
-definition valid_inQ_queues :: "KernelStateData_H.kernel_state \<Rightarrow> bool" where
-  "valid_inQ_queues \<equiv>
-     \<lambda>s. \<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s) \<and> distinct (ksReadyQueues s (d, p))"
-
-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_inQ_queues_ksReadyQueuesL1Bitmap_upd[simp]:
-  "valid_inQ_queues (ksReadyQueuesL1Bitmap_update f s) = valid_inQ_queues s"
-  unfolding valid_inQ_queues_def
-  by simp
-
-lemma valid_inQ_queues_ksReadyQueuesL2Bitmap_upd[simp]:
-  "valid_inQ_queues (ksReadyQueuesL2Bitmap_update f s) = valid_inQ_queues s"
-  unfolding valid_inQ_queues_def
-  by simp
-
 defs capHasProperty_def:
   "capHasProperty ptr P \<equiv> cte_wp_at' (\<lambda>c. P (cteCap c)) ptr"
 
@@ -75,11 +56,6 @@ locale delete_one_conc_pre =
     "\<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_queues:
-    "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)\<rbrace>
-     cteDeleteOne sl \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  assumes delete_one_inQ_queues:
-    "\<lbrace>valid_inQ_queues\<rbrace> cteDeleteOne sl \<lbrace>\<lambda>rv. valid_inQ_queues\<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:
@@ -537,7 +513,7 @@ lemma (in delete_one) cancelIPC_ReplyCap_corres:
               and Q'="\<lambda>_. invs' and st_tcb_at' awaiting_reply' t"
                in corres_underlying_split)
      apply (rule corres_guard_imp)
-       apply (rule threadset_corresT)
+       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 cteSizeBits_def)
@@ -661,16 +637,15 @@ lemma sch_act_simple_not_t[simp]: "sch_act_simple s \<Longrightarrow> sch_act_no
 
 context begin interpretation Arch . (*FIXME: arch_split*)
 
+crunches setNotification
+  for sym_heap_sched_pointers[wp]: sym_heap_sched_pointers
+  and valid_bitmaps[wp]: valid_bitmaps
+  (wp: valid_bitmaps_lift)
+
 lemma cancelSignal_invs':
   "\<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> Invariants_H.valid_queues s; st_tcb_at' (Not \<circ> runnable') t s \<rbrakk>
-                                         \<Longrightarrow> \<forall>x. t \<notin> set (ksReadyQueues s x)"
-      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>"
@@ -681,9 +656,9 @@ lemma cancelSignal_invs':
     show ?thesis
       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 setNotification_ksQ] sts_valid_queues
+                hoare_vcg_all_lift
                 setThreadState_ct_not_inQ NTFNSN
-                hoare_vcg_all_lift setNotification_ksQ
+                hoare_vcg_all_lift
               | simp add: valid_tcb_state'_def list_case_If split del: if_split)+
        prefer 2
        apply assumption
@@ -691,8 +666,6 @@ lemma cancelSignal_invs':
        apply (rule get_ntfn_sp')
       apply (rename_tac rv s)
       apply (clarsimp simp: pred_tcb_at')
-      apply (frule NIQ)
-       apply (clarsimp simp: pred_tcb_at'_def obj_at'_def)
       apply (rule conjI)
        apply (clarsimp simp: valid_ntfn'_def)
        apply (case_tac "ntfnObj rv", simp_all add: isWaitingNtfn_def)
@@ -732,9 +705,10 @@ lemma cancelSignal_invs':
                                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 r")
+       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)
@@ -792,23 +766,25 @@ lemma setEndpoint_ct_not_inQ[wp]:
   done
 
 lemma setEndpoint_ksDomScheduleIdx[wp]:
-  "\<lbrace>\<lambda>s. P (ksDomScheduleIdx s)\<rbrace> setEndpoint ptr ep \<lbrace>\<lambda>_ s. P (ksDomScheduleIdx s)\<rbrace>"
+  "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
 
+crunches 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 NIQ: "\<And>s. \<lbrakk> Invariants_H.valid_queues s; st_tcb_at' (Not \<circ> runnable') t s \<rbrakk>
-                                       \<Longrightarrow> \<forall>x. t \<notin> set (ksReadyQueues s x)"
-    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 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>"
@@ -833,8 +809,8 @@ proof -
     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]
-              sts_valid_queues setThreadState_ct_not_inQ EPSCHN
-              hoare_vcg_all_lift setNotification_ksQ
+              setThreadState_ct_not_inQ EPSCHN
+              hoare_vcg_all_lift
               | simp add: valid_tcb_state'_def split del: if_split
               | wpc)+
      prefer 2
@@ -842,14 +818,14 @@ proof -
     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 (frule NIQ)
-     apply (erule pred_tcb'_weakenE, fastforce)
     apply (clarsimp, rule conjI)
      apply (auto simp: pred_tcb_at'_def obj_at'_def)[1]
     apply (rule conjI)
@@ -1053,18 +1029,20 @@ lemma setBoundNotification_tcb_in_cur_domain'[wp]:
   apply (wp 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> \<lbrace>obj_at' P t'\<rbrace> cancelSignal t word \<lbrace>\<lambda>_. obj_at' P t'\<rbrace>"
-  apply (simp add: cancelSignal_def setNotification_def)
-  apply (wp setThreadState_not_st getNotification_wp | wpc | simp)+
-  done
+lemma setThreadState_tcbDomain_obj_at'[wp]:
+  "setThreadState ts t \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  unfolding setThreadState_def
+  by wpsimp
+
+crunches 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 (simp add: cancelIPC_def Let_def)
   apply (wp hoare_vcg_conj_lift
-            setThreadState_not_st delete_one_tcbDomain_obj_at' cancelSignal_tcb_obj_at'
+            delete_one_tcbDomain_obj_at'
        | wpc
        | rule hoare_drop_imps
        | simp add: getThreadReplySlot_def o_def if_fun_split)+
@@ -1171,198 +1149,17 @@ lemma setNotification_weak_sch_act_wf[wp]:
 lemmas ipccancel_weak_sch_act_wfs
     = weak_sch_act_wf_lift[OF _ setCTE_pred_tcb_at']
 
-lemma tcbSchedDequeue_corres':
-  "corres dc (is_etcb_at t and tcb_at t and pspace_aligned and pspace_distinct)
-             (valid_inQ_queues)
-             (tcb_sched_action (tcb_sched_dequeue) t) (tcbSchedDequeue t)"
-  apply (rule corres_cross_over_guard[where P'=P' and Q="tcb_at' t and P'" for P'])
-   apply (fastforce simp: tcb_at_cross dest: state_relation_pspace_relation)
-  apply (simp only: tcbSchedDequeue_def tcb_sched_action_def)
-  apply (rule corres_symb_exec_r[OF _ _ threadGet_inv, where Q'="\<lambda>rv. tcb_at' t and valid_inQ_queues and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"])
-    defer
-    apply (wp threadGet_obj_at', simp, simp)
-   apply (wp, simp)
-  apply (case_tac queued)
-   defer
-   apply (simp add: unless_def when_def)
-   apply (rule corres_no_failI)
-    apply (wp)
-   apply (clarsimp simp: in_monad ethread_get_def get_etcb_def set_tcb_queue_def is_etcb_at_def state_relation_def gets_the_def gets_def get_def return_def bind_def assert_opt_def get_tcb_queue_def modify_def put_def)
-   apply (subgoal_tac "t \<notin> set (ready_queues a (tcb_domain y) (tcb_priority y))")
-    prefer 2
-    apply (force simp: tcb_sched_dequeue_def valid_inQ_queues_def
-                       ready_queues_relation_def obj_at'_def inQ_def project_inject)
-   apply (simp add: ready_queues_relation_def)
-  apply (simp add: unless_def when_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[where r'="(=)"])
-       apply (rule ethreadget_corres, simp add: etcb_relation_def)
-      apply (simp split del: if_split)
-      apply (rule corres_split_eqr)
-         apply (rule ethreadget_corres, simp add: etcb_relation_def)
-        apply (rule corres_split_eqr[OF getQueue_corres])
-          apply (simp split del: if_split)
-          apply (subst bind_return_unit, rule corres_split[where r'=dc])
-             apply (simp add: tcb_sched_dequeue_def)
-             apply (rule setQueue_corres)
-            apply (rule corres_split_noop_rhs)
-              apply (clarsimp, rule removeFromBitmap_corres_noop)
-             apply (simp add: dc_def[symmetric])
-             apply (rule threadSet_corres_noop, simp_all add: tcb_relation_def exst_same_def)[1]
-            apply (wp | simp)+
-  done
-
-lemma setQueue_valid_inQ_queues:
-  "\<lbrace>valid_inQ_queues
-      and (\<lambda>s. \<forall>t \<in> set ts. obj_at' (inQ d p) t s)
-      and K (distinct ts)\<rbrace>
-  setQueue d p ts
-  \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  apply (simp add: setQueue_def valid_inQ_queues_def)
-  apply wp
-  apply clarsimp
-  done
-
-lemma threadSet_valid_inQ_queues:
-  "\<lbrace>valid_inQ_queues and (\<lambda>s. \<forall>d p. (\<exists>tcb. (inQ d p tcb) \<and> \<not>(inQ d p (f tcb)))
-                        \<longrightarrow> obj_at' (\<lambda>tcb. (inQ d p tcb) \<and> \<not>(inQ d p (f tcb))) t s
-                        \<longrightarrow> t \<notin> set (ksReadyQueues s (d, p)))\<rbrace>
-     threadSet f t
-   \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (simp add: threadSet_def)
-  apply wp
-   apply (simp add: valid_inQ_queues_def pred_tcb_at'_def)
-   apply (wp setObject_queues_unchanged_tcb
-             hoare_Ball_helper
-             hoare_vcg_all_lift
-             setObject_tcb_strongest)[1]
-  apply (wp getObject_tcb_wp)
-  apply (clarsimp simp: valid_inQ_queues_def pred_tcb_at'_def)
-  apply (clarsimp simp: obj_at'_def)
-  apply (fastforce)
-  done
-
-(* reorder the threadSet before the setQueue, useful for lemmas that don't refer to bitmap *)
-lemma setQueue_after_addToBitmap:
-  "(setQueue d p q >>= (\<lambda>rv. (when P (addToBitmap d p)) >>= (\<lambda>rv. threadSet f t))) =
-   (when P (addToBitmap d p) >>= (\<lambda>rv. (threadSet f t) >>= (\<lambda>rv. setQueue d p q)))"
-  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 (simp add: threadSet_def getObject_def setObject_def
-                   loadObject_default_def bitmap_fun_defs
-                   split_def projectKO_def2 alignCheck_assert
-                   magnitudeCheck_assert updateObject_default_def)
-  apply (intro oblivious_bind, simp_all)
-  apply (clarsimp simp: bind_assoc)
-  done
-
-lemma tcbSchedEnqueue_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> tcbSchedEnqueue t \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def setQueue_after_addToBitmap)
-  apply (rule hoare_pre)
-   apply (rule_tac B="\<lambda>rv. valid_inQ_queues and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"
-                in hoare_seq_ext)
-    apply (rename_tac queued)
-    apply (case_tac queued, simp_all add: unless_def)[1]
-     apply (wp setQueue_valid_inQ_queues threadSet_valid_inQ_queues threadGet_wp
-               hoare_vcg_const_Ball_lift
-          | simp add: inQ_def bitmap_fun_defs
-          | fastforce simp: valid_inQ_queues_def inQ_def obj_at'_def)+
-  done
-
- (* prevents wp from splitting on the when; stronger technique than hoare_when_weak_wp
-    FIXME: possible to replace with hoare_when_weak_wp?
- *)
-definition
-  "removeFromBitmap_conceal d p q t \<equiv> when (null [x\<leftarrow>q . x \<noteq> t]) (removeFromBitmap d p)"
-
-lemma removeFromBitmap_conceal_valid_inQ_queues[wp]:
-  "\<lbrace> valid_inQ_queues \<rbrace> removeFromBitmap_conceal d p q t \<lbrace> \<lambda>_. valid_inQ_queues \<rbrace>"
-  unfolding valid_inQ_queues_def removeFromBitmap_conceal_def
-  by (wp|clarsimp simp: bitmap_fun_defs)+
-
-lemma rescheduleRequired_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> rescheduleRequired \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply wpsimp
-  done
-
-lemma sts_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> setThreadState st t \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (simp add: setThreadState_def)
-  apply (wp threadSet_valid_inQ_queues [THEN hoare_strengthen_post])
-   apply (clarsimp simp: sch_act_simple_def Invariants_H.valid_queues_def inQ_def)+
-  done
-
 lemma updateObject_ep_inv:
   "\<lbrace>P\<rbrace> updateObject (obj::endpoint) ko p q n \<lbrace>\<lambda>rv. P\<rbrace>"
   by simp (rule updateObject_default_inv)
 
-lemma sbn_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> setBoundNotification ntfn t \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (simp add: setBoundNotification_def)
-  apply (wp threadSet_valid_inQ_queues [THEN hoare_strengthen_post])
-   apply (clarsimp simp: sch_act_simple_def Invariants_H.valid_queues_def inQ_def)+
-  done
-
-lemma setEndpoint_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> setEndpoint ptr ep \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (unfold setEndpoint_def)
-  apply (rule setObject_ep_pre)
-  apply (simp add: valid_inQ_queues_def)
-  apply (wp hoare_Ball_helper hoare_vcg_all_lift setObject_queues_unchanged[OF updateObject_ep_inv])
-  apply simp
-  done
-
-lemma set_ntfn_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> setNotification ptr ntfn \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (unfold setNotification_def)
-  apply (rule setObject_ntfn_pre)
-  apply (simp add: valid_inQ_queues_def)
-  apply (wp hoare_Ball_helper hoare_vcg_all_lift)
-    apply (clarsimp simp: updateObject_default_def in_monad)
-    apply (wp updateObject_default_inv | simp)+
-    done
-
-crunch valid_inQ_queues[wp]: cancelSignal valid_inQ_queues
-  (simp: updateObject_tcb_inv crunch_simps wp: crunch_wps)
-
-lemma (in delete_one_conc_pre) cancelIPC_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> cancelIPC t \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  apply (simp add: cancelIPC_def Let_def getThreadReplySlot_def)
-  apply (wp hoare_drop_imps delete_one_inQ_queues threadSet_valid_inQ_queues | wpc | simp add:if_apply_def2 Fun.comp_def)+
-   apply (clarsimp simp: valid_inQ_queues_def inQ_def)+
-   done
-
-lemma valid_queues_inQ_queues:
-  "Invariants_H.valid_queues s \<Longrightarrow> valid_inQ_queues s"
-  by (force simp: Invariants_H.valid_queues_def valid_inQ_queues_def obj_at'_def
-                  valid_queues_no_bitmap_def)
-
 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>"
   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_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> asUser t f \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  unfolding valid_inQ_queues_def Ball_def
-  apply (wpsimp wp: hoare_vcg_all_lift)
-    defer
-    apply (wp asUser_ksQ)
-   apply assumption
-  apply (simp add: inQ_def[abs_def] obj_at'_conj)
-  apply (rule hoare_convert_imp)
-   apply (wp asUser_ksQ)
-  apply wp
-  done
-
-context begin
-interpretation Arch .
+context begin interpretation Arch .
 
 crunches cancel_ipc
   for pspace_aligned[wp]: "pspace_aligned :: det_state \<Rightarrow> _"
@@ -1371,6 +1168,30 @@ crunches cancel_ipc
 
 end
 
+crunches asUser
+  for valid_sched_pointers[wp]: valid_sched_pointers
+  (wp: crunch_wps)
+
+crunches set_thread_state
+  for in_correct_ready_q[wp]: in_correct_ready_q
+  (wp: crunch_wps)
+
+crunches set_thread_state_ext
+  for ready_qs_distinct[wp]: ready_qs_distinct
+  (wp: crunch_wps)
+
+lemma set_thread_state_ready_qs_distinct[wp]:
+  "set_thread_state ref ts \<lbrace>ready_qs_distinct\<rbrace>"
+  unfolding set_thread_state_def
+  apply (wpsimp wp: set_object_wp)
+  by (clarsimp simp: ready_qs_distinct_def)
+
+lemma as_user_ready_qs_distinct[wp]:
+  "as_user tptr f \<lbrace>ready_qs_distinct\<rbrace>"
+  unfolding as_user_def
+  apply (wpsimp wp: set_object_wp)
+  by (clarsimp simp: ready_qs_distinct_def)
+
 lemma (in delete_one) suspend_corres:
   "corres dc (einvs and tcb_at t) invs'
              (IpcCancel_A.suspend t) (ThreadDecls_H.suspend t)"
@@ -1394,15 +1215,18 @@ lemma (in delete_one) suspend_corres:
            apply (rule corres_return_trivial)
           apply (rule corres_split_nor[OF setThreadState_corres])
              apply wpsimp
-            apply (rule tcbSchedDequeue_corres')
+            apply (rule tcbSchedDequeue_corres, simp)
            apply wp
-          apply wpsimp
-         apply (wpsimp simp: update_restart_pc_def updateRestartPC_def)+
-       apply (rule hoare_post_imp[where Q = "\<lambda>rv s. tcb_at t s \<and> is_etcb_at t s \<and> pspace_aligned s \<and> pspace_distinct s"])
-        apply simp
-       apply (wp | simp)+
-   apply (fastforce simp: valid_sched_def tcb_at_is_etcb_at)
-  apply (clarsimp simp add: invs'_def valid_state'_def valid_queues_inQ_queues)
+          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:
@@ -1425,259 +1249,8 @@ lemma (in delete_one_conc_pre) cancelIPC_it[wp]:
   apply (wp hoare_drop_imps delete_one_it | wpc | simp add:if_apply_def2 Fun.comp_def)+
   done
 
-lemma tcbSchedDequeue_notksQ:
-  "\<lbrace>\<lambda>s. t' \<notin> set(ksReadyQueues s p)\<rbrace>
-    tcbSchedDequeue t
-   \<lbrace>\<lambda>_ s. t' \<notin> set(ksReadyQueues s p)\<rbrace>"
-  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+
-     apply clarsimp
-     apply (rule_tac Q="\<lambda>_ s. t' \<notin> set(ksReadyQueues s p)" in hoare_post_imp)
-      apply (wp | clarsimp)+
-  done
-
-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 B="\<lambda>rv s. (rv = ResumeCurrentThread \<or> rv = ChooseNewThread)
-                       \<and> ?OAQ t' p s" in hoare_seq_ext)
-   including classic_wp_pre
-   apply (wp | clarsimp)+
-   apply (case_tac x)
-     apply (wp | clarsimp)+
-  done
-
-lemma setThreadState_oa_queued:
-  "\<lbrace>\<lambda>s. P' (obj_at' (\<lambda>tcb. P (tcbQueued tcb) (tcbDomain tcb) (tcbPriority tcb)) t' s) \<rbrace>
-    setThreadState st 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> setThreadState st t \<lbrace>\<lambda>_. ?Q R \<rbrace>"
-      apply (simp add: setThreadState_def)
-      apply (wp rescheduleRequired_oa_queued)
-      apply (simp add: sch_act_simple_def)
-      apply (rule_tac Q="\<lambda>_. ?Q R" in hoare_post_imp, clarsimp)
-      apply (wp threadSet_obj_at'_strongish)
-      apply (clarsimp)
-      done
-    show "\<lbrace>\<lambda>s. \<not> ?Q P s\<rbrace> setThreadState st t \<lbrace>\<lambda>_ s. \<not> ?Q P s\<rbrace>"
-      by (simp add: not_obj_at' comp_def, wp hoare_convert_imp pos)
-  qed
-
-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 tcbSchedDequeue_ksQ_distinct[wp]:
-  "\<lbrace>\<lambda>s. distinct (ksReadyQueues s p)\<rbrace>
-    tcbSchedDequeue t
-   \<lbrace>\<lambda>_ s. distinct (ksReadyQueues s p)\<rbrace>"
-  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+
-     apply (rule_tac Q="\<lambda>_ s. distinct (ksReadyQueues s p)" in hoare_post_imp)
-      apply (clarsimp | wp)+
-  done
-
-lemma sts_valid_queues_partial:
-  "\<lbrace>Invariants_H.valid_queues and sch_act_simple\<rbrace>
-    setThreadState st t
-   \<lbrace>\<lambda>_ s. \<forall>t' d p.
-            (t' \<in> set(ksReadyQueues s (d, p)) \<longrightarrow>
-             (obj_at' (\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d \<and> tcbPriority tcb = p) t' s
-              \<and> (t' \<noteq> t \<longrightarrow> st_tcb_at' runnable' t' s)))
-            \<and> distinct (ksReadyQueues s (d, p))\<rbrace>"
-  (is "\<lbrace>_\<rbrace> _ \<lbrace>\<lambda>_ s. \<forall>t' d p. ?OA t' d p s \<and> ?DISTINCT d p s \<rbrace>")
-  apply (rule_tac Q="\<lambda>_ s. (\<forall>t' d p. ?OA t' d p s) \<and> (\<forall>d p. ?DISTINCT d p s)"
-           in hoare_post_imp)
-   apply (clarsimp)
-  apply (rule hoare_conjI)
-   apply (rule_tac Q="\<lambda>s. \<forall>t' d p.
-             ((t'\<in>set(ksReadyQueues s (d, p))
-               \<or> \<not> (sch_act_simple s))
-                  \<longrightarrow> (obj_at'(\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d \<and> tcbPriority tcb = p) t' s
-                       \<and> st_tcb_at' runnable' t' s))" in hoare_pre_imp)
-    apply (fastforce simp: Invariants_H.valid_queues_def valid_queues_no_bitmap_def
-                           pred_tcb_at'_def obj_at'_def inQ_def)
-   apply (rule hoare_vcg_all_lift)+
-    apply (rule hoare_convert_imp)
-     including classic_wp_pre
-     apply (wp sts_ksQ setThreadState_oa_queued hoare_impI sts_pred_tcb_neq'
-            | clarsimp)+
-  apply (rule_tac Q="\<lambda>s. \<forall>d p. ?DISTINCT d p s \<and> sch_act_simple s" in hoare_pre_imp)
-   apply (clarsimp simp: Invariants_H.valid_queues_def valid_queues_no_bitmap_def)
-  apply (wp hoare_vcg_all_lift sts_ksQ)
-  apply (clarsimp)
-  done
-
-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 Q="(\<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)
-  done
-
-lemma sts_invs_minor'_no_valid_queues:
-  "\<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. runnable' st \<and> obj_at' tcbQueued t s \<longrightarrow> st_tcb_at' runnable' t s)
-      and sch_act_simple
-      and invs'\<rbrace>
-    setThreadState st t
-   \<lbrace>\<lambda>_ s. (\<forall>t' d p.
-            (t' \<in> set(ksReadyQueues s (d, p)) \<longrightarrow>
-             (obj_at' (\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d \<and> tcbPriority tcb = p) t' s
-              \<and> (t' \<noteq> t \<longrightarrow> st_tcb_at' runnable' t' s)))
-            \<and> distinct (ksReadyQueues s (d, p)) \<and> (maxDomain < d \<or> maxPriority < p \<longrightarrow> ksReadyQueues s (d, p) = [])) \<and>
-         valid_bitmapQ s \<and>
-         bitmapQ_no_L2_orphans s \<and>
-         bitmapQ_no_L1_orphans s \<and>
-         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>
-         valid_queues' s \<and>
-         ct_not_inQ s \<and>
-         ct_idle_or_in_cur_domain' s \<and>
-         pspace_domain_valid s \<and>
-         ksCurDomain s \<le> maxDomain \<and>
-         valid_dom_schedule' s \<and>
-         untyped_ranges_zero' s \<and>
-         cur_tcb' s \<and>
-         tcb_at' t s\<rbrace>"
-  apply (simp add: invs'_def valid_state'_def valid_queues_def)
-  apply (wp sts_valid_queues_partial sts_ksQ
-            setThreadState_oa_queued sts_st_tcb_at'_cases
-            irqs_masked_lift
-            valid_irq_node_lift
-            setThreadState_ct_not_inQ
-            sts_valid_bitmapQ_sch_act_simple
-            sts_valid_bitmapQ_no_L2_orphans_sch_act_simple
-            sts_valid_bitmapQ_no_L1_orphans_sch_act_simple
-            hoare_vcg_conj_lift hoare_vcg_imp_lift hoare_vcg_all_lift)+
-  apply (clarsimp simp: disj_imp)
-  apply (intro conjI)
-        apply (clarsimp simp: valid_queues_def)
-        apply (rule conjI, clarsimp)
-         apply (drule valid_queues_no_bitmap_objD, assumption)
-         apply (clarsimp simp: inQ_def comp_def)
-         apply (rule conjI)
-          apply (erule obj_at'_weaken)
-          apply (simp add: inQ_def)
-         apply (clarsimp simp: st_tcb_at'_def)
-         apply (erule obj_at'_weaken)
-         apply (simp add: inQ_def)
-        apply (simp add: valid_queues_no_bitmap_def)
-       apply clarsimp
-     apply (clarsimp simp: st_tcb_at'_def)
-     apply (drule obj_at_valid_objs')
-      apply (clarsimp simp: valid_pspace'_def)
-     apply (clarsimp simp: valid_obj'_def valid_tcb'_def)
-     subgoal
-     by (fastforce simp: valid_tcb_state'_def
-                  split: Structures_H.thread_state.splits)
-    apply (clarsimp dest!: st_tcb_at_state_refs_ofD'
-                    elim!: rsubst[where P=sym_refs]
-                   intro!: ext)
-   apply (fastforce simp: valid_queues_def inQ_def pred_tcb_at' pred_tcb_at'_def
-                   elim!: st_tcb_ex_cap'' obj_at'_weakenE)+
-  done
-
 crunch ct_idle_or_in_cur_domain'[wp]: tcbSchedDequeue ct_idle_or_in_cur_domain'
-
-lemma tcbSchedDequeue_invs'_no_valid_queues:
-   "\<lbrace>\<lambda>s. (\<forall>t' d p.
-            (t' \<in> set(ksReadyQueues s (d, p)) \<longrightarrow>
-             (obj_at' (\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d \<and> tcbPriority tcb = p) t' s
-              \<and> (t' \<noteq> t \<longrightarrow> st_tcb_at' runnable' t' s)))
-            \<and> distinct (ksReadyQueues s (d, p)) \<and> (maxDomain < d \<or> maxPriority < p \<longrightarrow> ksReadyQueues s (d, p) = [])) \<and>
-         valid_bitmapQ s \<and>
-         bitmapQ_no_L2_orphans s \<and>
-         bitmapQ_no_L1_orphans s \<and>
-         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>
-         valid_queues' s \<and>
-         ct_not_inQ s \<and>
-         ct_idle_or_in_cur_domain' s \<and>
-         pspace_domain_valid s \<and>
-         ksCurDomain s \<le> maxDomain \<and>
-         valid_dom_schedule' s \<and>
-         untyped_ranges_zero' s \<and>
-         cur_tcb' s \<and>
-         tcb_at' t s\<rbrace>
-    tcbSchedDequeue t
-   \<lbrace>\<lambda>_. invs' \<rbrace>"
-  apply (simp add: invs'_def valid_state'_def)
-  apply (wp tcbSchedDequeue_valid_queues_weak valid_irq_handlers_lift
-            valid_irq_node_lift valid_irq_handlers_lift'
-            tcbSchedDequeue_irq_states irqs_masked_lift cur_tcb_lift
-            untyped_ranges_zero_lift
-         | clarsimp simp add: cteCaps_of_def valid_queues_def o_def)+
-  apply (rule conjI)
-   apply (fastforce simp: obj_at'_def inQ_def st_tcb_at'_def valid_queues_no_bitmap_except_def)
-  apply (rule conjI, clarsimp simp: correct_queue_def)
-  apply (fastforce simp: valid_pspace'_def intro: obj_at'_conjI
-                   elim: valid_objs'_maxDomain valid_objs'_maxPriority)
-  done
-
-lemmas sts_tcbSchedDequeue_invs' =
-  sts_invs_minor'_no_valid_queues
-  tcbSchedDequeue_invs'_no_valid_queues
+  (wp: crunch_wps)
 
 lemma asUser_sch_act_simple[wp]:
   "\<lbrace>sch_act_simple\<rbrace> asUser s t \<lbrace>\<lambda>_. sch_act_simple\<rbrace>"
@@ -1689,11 +1262,14 @@ lemma (in delete_one_conc) suspend_invs'[wp]:
   "\<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 (wp sts_tcbSchedDequeue_invs')
-      apply (simp add: updateRestartPC_def | strengthen no_refs_simple_strg')+
-      prefer 2
-      apply (wpsimp wp: hoare_drop_imps hoare_vcg_imp_lift'
-                 | strengthen no_refs_simple_strg')+
+  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]:
@@ -1737,109 +1313,6 @@ lemma (in delete_one_conc_pre) suspend_st_tcb_at':
 lemmas (in delete_one_conc_pre) suspend_makes_simple' =
        suspend_st_tcb_at' [where P=simple', simplified]
 
-lemma valid_queues_not_runnable'_not_ksQ:
-  assumes "Invariants_H.valid_queues s" and "st_tcb_at' (Not \<circ> runnable') t s"
-  shows   "\<forall>d p. t \<notin> set (ksReadyQueues s (d, p))"
-  using assms
-  apply -
-  apply (clarsimp simp: Invariants_H.valid_queues_def valid_queues_no_bitmap_def pred_tcb_at'_def)
-  apply (erule_tac x=d in allE)
-  apply (erule_tac x=p in allE)
-  apply (clarsimp)
-  apply (drule(1) bspec)
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-declare valid_queues_not_runnable'_not_ksQ[OF ByAssum, simp]
-
-lemma cancelSignal_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues and st_tcb_at' (Not \<circ> runnable') t\<rbrace>
-   cancelSignal t ae \<lbrace>\<lambda>_. Invariants_H.valid_queues \<rbrace>"
-  apply (simp add: cancelSignal_def)
-  apply (wp sts_valid_queues)
-      apply (rule_tac Q="\<lambda>_ s. \<forall>p. t \<notin> set (ksReadyQueues s p)" in hoare_post_imp, simp)
-      apply (wp hoare_vcg_all_lift)
-     apply (wpc)
-      apply (wp)+
-   apply (rule_tac Q="\<lambda>_ s. Invariants_H.valid_queues s \<and> (\<forall>p. t \<notin> set (ksReadyQueues s p))" in hoare_post_imp)
-    apply (clarsimp)
-   apply (wp)
-  apply (clarsimp)
-  done
-
-lemma (in delete_one_conc_pre) cancelIPC_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)\<rbrace>
-   cancelIPC t \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: cancelIPC_def Let_def getThreadReplySlot_def
-             cong: Structures_H.thread_state.case_cong list.case_cong)
-  apply (rule hoare_seq_ext [OF _ gts_sp'])
-  apply (rule hoare_pre)
-   apply (wpc
-           | wp hoare_vcg_conj_lift delete_one_queues threadSet_valid_queues
-                threadSet_valid_objs' sts_valid_queues setEndpoint_ksQ
-                hoare_vcg_all_lift threadSet_sch_act threadSet_weak_sch_act_wf
-           | simp add: o_def if_apply_def2 inQ_def
-           | rule hoare_drop_imps
-           | clarsimp simp: valid_tcb'_def tcb_cte_cases_def cteSizeBits_def
-                     elim!: pred_tcb'_weakenE)+
-  apply (fastforce dest: valid_queues_not_runnable'_not_ksQ elim: pred_tcb'_weakenE)
-  done
-
-(* FIXME: move to Schedule_R *)
-lemma tcbSchedDequeue_nonq[wp]:
-  "\<lbrace>Invariants_H.valid_queues and tcb_at' t and K (t = t')\<rbrace>
-    tcbSchedDequeue t \<lbrace>\<lambda>_ s. \<forall>d p. t' \<notin> set (ksReadyQueues s (d, p))\<rbrace>"
-  apply (rule hoare_gen_asm)
-  apply (simp add: tcbSchedDequeue_def)
-  apply (wp threadGet_wp|simp)+
-  apply (fastforce simp: Invariants_H.valid_queues_def valid_queues_no_bitmap_def obj_at'_def projectKOs inQ_def)
-  done
-
-lemma sts_ksQ_oaQ:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace>
-   setThreadState st t
-   \<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>"
-  (is "\<lbrace>_\<rbrace> _ \<lbrace>\<lambda>_. ?POST\<rbrace>")
-  proof -
-    have RR: "\<lbrace>sch_act_simple and ?POST\<rbrace> rescheduleRequired \<lbrace>\<lambda>_. ?POST\<rbrace>"
-      apply (simp add: rescheduleRequired_def)
-      apply (wp)
-        apply (clarsimp)
-       apply (rule_tac
-                Q="(\<lambda>s. action = ResumeCurrentThread \<or> action = ChooseNewThread) and ?POST"
-                                                               in hoare_pre_imp, assumption)
-       apply (case_tac action)
-         apply (clarsimp)+
-      apply (wp)
-      apply (clarsimp simp: sch_act_simple_def)
-      done
-    show ?thesis
-      apply (simp add: setThreadState_def)
-      apply (wp RR)
-      apply (rule_tac Q="\<lambda>_. ?POST" in hoare_post_imp)
-       apply (clarsimp simp add: sch_act_simple_def)
-      apply (wp hoare_convert_imp)
-      apply (clarsimp simp: Invariants_H.valid_queues_def valid_queues_no_bitmap_def)
-      apply (drule_tac x=d in spec)
-      apply (drule_tac x=p in spec)
-      apply (fastforce dest: bspec elim!: obj_at'_weakenE simp: inQ_def)
-      done
-  qed
-
-lemma (in delete_one_conc_pre) suspend_nonq:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and tcb_at' t
-                 and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
-                 and (\<lambda>s. t \<noteq> ksIdleThread s) and K (t = t')\<rbrace>
-     suspend t
-   \<lbrace>\<lambda>rv s. \<forall>d p. t' \<notin> set (ksReadyQueues s (d, p))\<rbrace>"
-  apply (rule hoare_gen_asm)
-  apply (simp add: suspend_def)
-  unfolding updateRestartPC_def
-  apply (wp hoare_allI tcbSchedDequeue_t_notksQ sts_ksQ_oaQ)
-    apply wpsimp+
-  done
-
 lemma suspend_makes_inactive:
   "\<lbrace>K (t = t')\<rbrace> suspend t \<lbrace>\<lambda>rv. st_tcb_at' ((=) Inactive) t'\<rbrace>"
   apply (cases "t = t'", simp_all)
@@ -1850,29 +1323,21 @@ lemma suspend_makes_inactive:
 declare threadSet_sch_act_sane [wp]
 declare sts_sch_act_sane [wp]
 
-lemma tcbSchedEnqueue_ksQset_weak:
-  "\<lbrace>\<lambda>s. t' \<in> set (ksReadyQueues s p)\<rbrace>
-   tcbSchedEnqueue t
-   \<lbrace>\<lambda>_ s. t' \<in> set (ksReadyQueues s p)\<rbrace>" (is "\<lbrace>?PRE\<rbrace> _ \<lbrace>_\<rbrace>")
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply (wp hoare_vcg_conj_lift hoare_vcg_imp_lift hoare_vcg_if_lift)
-  apply (rule_tac Q="\<lambda>_. ?PRE" in hoare_post_imp, ((wp | clarsimp)+))+
-  done
-
 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 tcbSchedEnqueue_ct', wp, simp)
+  by (rule hoare_weaken_pre, wps, wp, simp)
 
 lemma sts_sch_act_not_ct[wp]:
   "\<lbrace>\<lambda>s. sch_act_not (ksCurThread s) s\<rbrace>
    setThreadState st t \<lbrace>\<lambda>_ s. sch_act_not (ksCurThread s) s\<rbrace>"
-  by (rule hoare_weaken_pre, wps tcbSchedEnqueue_ct', wp, simp)
+  by (rule hoare_weaken_pre, wps, wp, simp)
 
 text \<open>Cancelling all IPC in an endpoint or notification object\<close>
 
 lemma ep_cancel_corres_helper:
-  "corres dc ((\<lambda>s. \<forall>t \<in> set list. tcb_at t s) and valid_etcbs and pspace_aligned and pspace_distinct)
-             (Invariants_H.valid_queues and valid_queues' and valid_objs')
+  "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
@@ -1881,28 +1346,34 @@ lemma ep_cancel_corres_helper:
                         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 (rule corres_guard_imp [OF setThreadState_corres])
-            apply simp
-           apply (simp add: valid_tcb_state_def)
-          apply simp
-         apply (wp sts_valid_queues)+
-       apply (force simp: tcb_at_is_etcb_at)
-      apply (fastforce elim: obj_at'_weakenE)
-     apply ((wp hoare_vcg_const_Ball_lift | simp)+)[1]
-    apply (rule hoare_pre)
-     apply (wp hoare_vcg_const_Ball_lift
-               weak_sch_act_wf_lift_linear sts_st_tcb' setThreadState_not_st
-               sts_valid_queues tcbSchedEnqueue_not_st
-          | simp)+
-    apply (auto elim: obj_at'_weakenE simp: valid_tcb_state'_def)
+         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
 
+crunches 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 ep_cancel_corres:
   "corres dc (invs and valid_sched and ep_at ep) (invs' and ep_at' ep)
              (cancel_all_ipc ep) (cancelAllIPC ep)"
@@ -1910,10 +1381,10 @@ proof -
   have P:
     "\<And>list.
      corres dc (\<lambda>s. (\<forall>t \<in> set list. tcb_at t s) \<and> valid_pspace s \<and> ep_at ep s
-                        \<and> valid_etcbs s \<and> weak_valid_sched_action s)
+                        \<and> valid_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> Invariants_H.valid_queues s \<and> valid_queues' s \<and> valid_objs' 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;
@@ -1935,22 +1406,23 @@ proof -
         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 R="\<lambda>_ s. \<forall>x\<in>set list. tcb_at' x s \<and> valid_objs' s"
+      apply (rule_tac R="\<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 (rule hoare_name_pre_state)
-      apply ((wp hoare_vcg_const_Ball_lift mapM_x_wp'
-                sts_valid_queues setThreadState_not_st sts_st_tcb' tcbSchedEnqueue_not_st
-           | clarsimp
-           | fastforce elim: obj_at'_weakenE simp: valid_tcb_state'_def)+)[2]
-    apply (rule hoare_name_pre_state)
+      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 elim!: valid_objs_valid_tcbE))+
+           | (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 (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
@@ -1978,6 +1450,8 @@ lemma cancelAllSignals_corres:
   "corres dc (invs and valid_sched and ntfn_at ntfn) (invs' and ntfn_at' ntfn)
              (cancel_all_signals ntfn) (cancelAllSignals ntfn)"
   apply (simp add: cancel_all_signals_def cancelAllSignals_def)
+  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+
@@ -1988,17 +1462,19 @@ lemma cancelAllSignals_corres:
       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 setThreadState_not_st
+                 weak_sch_act_wf_lift_linear
                  set_thread_state_runnable_weak_valid_sched_action
             | simp)+
       apply (rename_tac list)
-      apply (rule_tac R="\<lambda>_ s. (\<forall>x\<in>set list. tcb_at' x s) \<and> valid_objs' s"
+      apply (rule_tac R="\<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_queues setThreadState_not_st
-                  simp: valid_tcb_state'_def)
+      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)+
@@ -2045,6 +1521,11 @@ proof -
   done
 qed
 
+lemma tcbSchedEnqueue_valid_pspace'[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>valid_pspace'\<rbrace>"
+  unfolding valid_pspace'_def
+  by wpsimp
+
 lemma cancel_all_invs'_helper:
   "\<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}
@@ -2059,8 +1540,7 @@ lemma cancel_all_invs'_helper:
    apply clarsimp
   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_valid_queues sts_st_tcb' setThreadState_not_st
+             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
@@ -2069,7 +1549,7 @@ lemma cancel_all_invs'_helper:
                  elim!: rsubst[where P=sym_refs]
                  dest!: set_mono_suffix
                 intro!: ext
-       | (drule (1) bspec, clarsimp simp: valid_pspace'_def valid_tcb'_def elim!: valid_objs_valid_tcbE))+
+       | (drule (1) bspec, clarsimp simp: valid_pspace'_def valid_tcb'_def))+
   done
 
 lemma ep_q_refs_max:
@@ -2086,10 +1566,9 @@ lemma ep_q_refs_max:
   done
 
 lemma rescheduleRequired_invs'[wp]:
-  "\<lbrace>invs'\<rbrace> rescheduleRequired \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  "rescheduleRequired \<lbrace>invs'\<rbrace>"
   apply (simp add: rescheduleRequired_def)
   apply (wpsimp wp: ssa_invs')
-  apply (clarsimp simp: invs'_def valid_state'_def)
   done
 
 lemma invs_rct_ct_activatable':
@@ -2216,6 +1695,7 @@ lemma rescheduleRequired_all_invs_but_ct_not_inQ:
 lemma cancelAllIPC_invs'[wp]:
   "\<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 hoare_seq_ext[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'
@@ -2244,6 +1724,7 @@ lemma cancelAllIPC_invs'[wp]:
 lemma cancelAllSignals_invs'[wp]:
   "\<lbrace>invs'\<rbrace> cancelAllSignals ntfn \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (simp add: cancelAllSignals_def)
+  apply (rule hoare_seq_ext[OF _ stateAssert_sp])
   apply (rule hoare_seq_ext [OF _ get_ntfn_sp'])
   apply (case_tac "ntfnObj ntfna", simp_all)
     apply (wp, simp)
@@ -2275,12 +1756,14 @@ lemma cancelAllSignals_invs'[wp]:
   done
 
 lemma cancelAllIPC_valid_objs'[wp]:
-  "\<lbrace>valid_objs'\<rbrace> cancelAllIPC ep \<lbrace>\<lambda>rv. valid_objs'\<rbrace>"
+  "\<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 hoare_seq_ext[OF _ stateAssert_sp])
   apply (rule hoare_seq_ext [OF _ get_ep_sp'])
   apply (rule hoare_pre)
    apply (wp set_ep_valid_objs' setSchedulerAction_valid_objs')
-    apply (rule_tac Q="\<lambda>rv s. valid_objs' s \<and> (\<forall>x\<in>set (epQueue ep). tcb_at' x s)"
+    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)
@@ -2297,8 +1780,9 @@ lemma cancelAllIPC_valid_objs'[wp]:
   done
 
 lemma cancelAllSignals_valid_objs'[wp]:
-  "\<lbrace>valid_objs'\<rbrace> cancelAllSignals ntfn \<lbrace>\<lambda>rv. valid_objs'\<rbrace>"
+  "\<lbrace>valid_objs' and pspace_aligned' and pspace_distinct'\<rbrace> cancelAllSignals ntfn \<lbrace>\<lambda>rv. valid_objs'\<rbrace>"
   apply (simp add: cancelAllSignals_def)
+  apply (rule hoare_seq_ext[OF _ stateAssert_sp])
   apply (rule hoare_seq_ext [OF _ get_ntfn_sp'])
   apply (case_tac "ntfnObj ntfna", simp_all)
     apply (wp, simp)
@@ -2351,19 +1835,17 @@ 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>"
-  apply (simp add: setThreadState_def setQueue_def
-                   rescheduleRequired_def tcbSchedEnqueue_def
-                   unless_def bitmap_fun_defs
-             cong: scheduler_action.case_cong  cong del: if_cong
-            | wp | wpcw)+
-  done
+  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 unless_def)
+  apply (simp add: tcbSchedEnqueue_def tcbQueuePrepend_def unless_def)
   apply (wp | simp add: setQueue_def bitmap_fun_defs)+
   done
 
@@ -2397,19 +1879,41 @@ lemma setObject_ko_wp_at':
                      objBits_def[symmetric] ps_clear_upd
                      in_magnitude_check v)
 
-lemma rescheduleRequired_unlive:
-  "\<lbrace>\<lambda>s. ko_wp_at' (Not \<circ> live') p s \<and> ksSchedulerAction s \<noteq> SwitchToThread p\<rbrace>
-      rescheduleRequired
+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>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | simp | wpc)+
-   apply (simp add: tcbSchedEnqueue_def unless_def
-                    threadSet_def setQueue_def threadGet_def)
-   apply (wp setObject_ko_wp_at getObject_tcb_wp
-            | simp add: objBits_simps' bitmap_fun_defs split del: if_split)+
-  apply (clarsimp simp: o_def)
-  apply (drule obj_at_ko_at')
-  apply clarsimp
+  by (clarsimp simp: threadSet_def valid_def getObject_def
+                     setObject_def in_monad loadObject_default_def
+                     ko_wp_at'_def  split_def in_magnitude_check
+                     objBits_simps' updateObject_default_def
+                     ps_clear_upd RISCV64_H.fromPPtr_def)
+
+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 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
+                   split: option.splits)
+  done
+
+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>"
+  supply comp_apply[simp del]
+  unfolding rescheduleRequired_def
+  apply (wpsimp wp: tcbSchedEnqueue_unlive_other)
   done
 
 lemmas setEndpoint_ko_wp_at'
@@ -2419,6 +1923,7 @@ 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>"
   apply (simp add: cancelAllIPC_def ep'_Idle_case_helper)
+  apply (rule hoare_seq_ext[OF _ stateAssert_sp])
   apply (rule hoare_seq_ext [OF _ get_ep_sp'])
   apply (rule hoare_pre)
    apply (wp cancelAll_unlive_helper setEndpoint_ko_wp_at'
@@ -2437,6 +1942,7 @@ lemma cancelAllSignals_unlive:
       \<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 (rule hoare_seq_ext[OF _ stateAssert_sp])
   apply (rule hoare_seq_ext [OF _ get_ntfn_sp'])
   apply (case_tac "ntfnObj ntfn", simp_all add: setNotification_def)
     apply wp
@@ -2501,25 +2007,20 @@ lemma cancelBadgedSends_filterM_helper':
   apply (rule hoare_pre)
    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' sts_valid_queues setThreadState_not_st
-             tcbSchedEnqueue_not_st
-             untyped_ranges_zero_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
+  apply (clarsimp simp: valid_pspace'_def cong: conj_cong)
   apply (intro conjI)
-      apply (clarsimp simp: valid_pspace'_def valid_tcb'_def elim!: valid_objs_valid_tcbE dest!: st_tcb_ex_cap'')
-     apply (fastforce dest!: 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)
-    apply (fastforce elim!: obj_atE'
-                      simp: state_refs_of'_def tcb_bound_refs'_def
-                            subsetD symreftype_inverse'
-                     split: if_split_asm)+
-  done
+    by (fastforce elim!: obj_atE'
+                   simp: state_refs_of'_def tcb_bound_refs'_def subsetD symreftype_inverse'
+                  split: if_split_asm)+
 
 lemmas cancelBadgedSends_filterM_helper
     = spec [where x=Nil, OF cancelBadgedSends_filterM_helper', simplified]
@@ -2529,7 +2030,8 @@ lemma cancelBadgedSends_invs[wp]:
   shows
   "\<lbrace>invs'\<rbrace> cancelBadgedSends epptr badge \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (simp add: cancelBadgedSends_def)
-  apply (rule hoare_seq_ext [OF _ get_ep_sp'])
+  apply (rule hoare_seq_ext[OF _ stateAssert_sp])
+  apply (rule hoare_seq_ext [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",
@@ -2561,11 +2063,20 @@ lemma cancelBadgedSends_invs[wp]:
 
 crunch state_refs_of[wp]: tcb_sched_action "\<lambda>s. P (state_refs_of s)"
 
+lemma setEndpoint_valid_tcbs'[wp]:
+  "setEndpoint ePtr val \<lbrace>valid_tcbs'\<rbrace>"
+  unfolding setEndpoint_def
+  apply (wpsimp wp: setObject_valid_tcbs'[where P=\<top>])
+   apply (clarsimp simp: updateObject_default_def monad_simps)
+  apply fastforce
+  done
 
 lemma cancelBadgedSends_corres:
   "corres dc (invs and valid_sched and ep_at epptr) (invs' and ep_at' epptr)
          (cancel_badged_sends epptr bdg) (cancelBadgedSends epptr bdg)"
   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 Q'=invs'])
@@ -2575,11 +2086,16 @@ lemma cancelBadgedSends_corres:
   apply (rule corres_guard_imp)
     apply (rule corres_split_nor[OF setEndpoint_corres])
        apply (simp add: ep_relation_def)
-      apply (rule corres_split_eqr[OF _ _ _ hoare_post_add[where R="\<lambda>_. valid_objs'"]])
+      apply (rule corres_split_eqr[OF _ _ _ hoare_post_add
+                                             [where R="\<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> pspace_aligned s \<and> pspace_distinct s"
-                    and Q'="\<lambda>xs s. Invariants_H.valid_queues s \<and> valid_queues' s \<and> valid_objs' s"
+                                   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)
@@ -2590,61 +2106,56 @@ lemma cancelBadgedSends_corres:
                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])
+                 apply (rule corres_split[OF tcbSchedEnqueue_corres], simp)
                    apply (rule corres_trivial)
                    apply simp
                   apply wp+
                apply simp
-               apply (wp sts_valid_queues gts_st_tcb_at)+
+               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: is_tcb_def)
-           apply simp
+            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_queues
+            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 (wp gts_st_tcb_at hoare_vcg_imp_lift mapM_wp'
-                 sts_st_tcb' sts_valid_queues
-                 set_thread_state_runnable_weak_valid_sched_action
-                 | clarsimp simp: valid_tcb_state'_def)+
-    apply (wp hoare_vcg_const_Ball_lift weak_sch_act_wf_lift_linear set_ep_valid_objs'
-               | simp)+
+       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 (drule ko_at_valid_objs', clarsimp)
-   apply simp
-  apply (clarsimp simp: valid_obj'_def valid_ep'_def invs_weak_sch_act_wf
-                        invs'_def valid_state'_def)
+  apply (fastforce simp: valid_ep'_def)
   done
 
+crunches 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 (simp add: threadGet_def| wp getObject_tcb_wp)+
-    apply (rule hoare_strengthen_post, rule hoare_post_taut)
-    apply (fastforce simp: obj_at'_def)
-   apply (rule hoare_post_taut)
-    apply wp+
-  done
+  unfolding suspend_def
+  by (wpsimp simp: comp_def wp: tcbSchedDequeue_not_tcbQueued)
 
 crunch unqueued: prepareThreadDelete "obj_at' (\<lambda>a. \<not> tcbQueued a) t"
 crunch inactive: prepareThreadDelete "st_tcb_at' ((=) Inactive) t'"
-crunch nonq: prepareThreadDelete " \<lambda>s. \<forall>d p. t' \<notin> set (ksReadyQueues s (d, p))"
 
 end
 end
diff --git a/proof/refine/RISCV64/Ipc_R.thy b/proof/refine/RISCV64/Ipc_R.thy
index b9aaacf25f..cc33607a7f 100644
--- a/proof/refine/RISCV64/Ipc_R.thy
+++ b/proof/refine/RISCV64/Ipc_R.thy
@@ -764,14 +764,6 @@ lemma tcts_sch_act[wp]:
    \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
   by (wp sch_act_wf_lift tcb_in_cur_domain'_lift transferCapsToSlots_pres1)
 
-lemma tcts_vq[wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> transferCapsToSlots ep buffer n caps slots mi \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  by (wp valid_queues_lift transferCapsToSlots_pres1)
-
-lemma tcts_vq'[wp]:
-  "\<lbrace>valid_queues'\<rbrace> transferCapsToSlots ep buffer n caps slots mi \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  by (wp valid_queues_lift' transferCapsToSlots_pres1)
-
 crunch state_refs_of' [wp]: setExtraBadge "\<lambda>s. P (state_refs_of' s)"
 
 lemma tcts_state_refs_of'[wp]:
@@ -979,6 +971,11 @@ crunch ksDomScheduleIdx[wp]: setExtraBadge "\<lambda>s. P (ksDomScheduleIdx s)"
 crunch ksDomSchedule[wp]: transferCapsToSlots "\<lambda>s. P (ksDomSchedule s)"
 crunch ksDomScheduleIdx[wp]: transferCapsToSlots "\<lambda>s. P (ksDomScheduleIdx s)"
 
+crunches transferCapsToSlots
+  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)
 
 lemma transferCapsToSlots_invs[wp]:
   "\<lbrace>\<lambda>s. invs' s \<and> distinct slots
@@ -1226,18 +1223,12 @@ lemma set_mrs_valid_objs' [wp]:
 crunch valid_objs'[wp]: copyMRs valid_objs'
   (wp: crunch_wps simp: crunch_simps)
 
-crunch valid_queues'[wp]: asUser "Invariants_H.valid_queues'"
-  (simp: crunch_simps wp: hoare_drop_imps)
-
-
 lemma setMRs_invs_bits[wp]:
   "\<lbrace>valid_pspace'\<rbrace> setMRs t buf mrs \<lbrace>\<lambda>rv. valid_pspace'\<rbrace>"
   "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>
      setMRs t buf mrs \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
   "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
      setMRs t buf mrs \<lbrace>\<lambda>rv s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> setMRs t buf mrs \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  "\<lbrace>valid_queues'\<rbrace> setMRs t buf mrs \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
   "\<lbrace>\<lambda>s. P (state_refs_of' s)\<rbrace>
      setMRs t buf mrs
    \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
@@ -1254,8 +1245,6 @@ lemma copyMRs_invs_bits[wp]:
   "\<lbrace>valid_pspace'\<rbrace> copyMRs s sb r rb n \<lbrace>\<lambda>rv. valid_pspace'\<rbrace>"
   "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace> copyMRs s sb r rb n
       \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> copyMRs s sb r rb n \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  "\<lbrace>valid_queues'\<rbrace> copyMRs s sb r rb n \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
   "\<lbrace>\<lambda>s. P (state_refs_of' s)\<rbrace>
       copyMRs s sb r rb n
    \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
@@ -1735,10 +1724,6 @@ crunch vp[wp]: doIPCTransfer "valid_pspace'"
   (wp: crunch_wps hoare_vcg_const_Ball_lift get_rs_cte_at' wp: transferCapsToSlots_vp simp:ball_conj_distrib )
 crunch sch_act_wf[wp]: doIPCTransfer "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
   (wp: crunch_wps get_rs_cte_at' ignore: transferCapsToSlots  simp: zipWithM_x_mapM)
-crunch vq[wp]: doIPCTransfer "Invariants_H.valid_queues"
-  (wp: crunch_wps get_rs_cte_at' ignore: transferCapsToSlots  simp: zipWithM_x_mapM)
-crunch vq'[wp]: doIPCTransfer "valid_queues'"
-  (wp: crunch_wps get_rs_cte_at' ignore: transferCapsToSlots  simp: zipWithM_x_mapM)
 crunch state_refs_of[wp]: doIPCTransfer "\<lambda>s. P (state_refs_of' s)"
   (wp: crunch_wps get_rs_cte_at' ignore: transferCapsToSlots  simp: zipWithM_x_mapM)
 crunch ct[wp]: doIPCTransfer "cur_tcb'"
@@ -1890,16 +1875,6 @@ lemma getThreadCallerSlot_inv:
   "\<lbrace>P\<rbrace> getThreadCallerSlot t \<lbrace>\<lambda>_. P\<rbrace>"
   by (simp add: getThreadCallerSlot_def, wp)
 
-lemma deleteCallerCap_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>
-   deleteCallerCap t
-   \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: deleteCallerCap_def getSlotCap_def getThreadCallerSlot_def locateSlot_conv)
-  apply (wp getThreadCallerSlot_inv cteDeleteOne_ct_not_ksQ getCTE_wp)
-  apply (clarsimp simp: cte_wp_at_ctes_of)
-  done
-
 lemma finaliseCapTrue_standin_tcb_at' [wp]:
   "\<lbrace>tcb_at' x\<rbrace> finaliseCapTrue_standin cap v2 \<lbrace>\<lambda>_. tcb_at' x\<rbrace>"
   apply (simp add: finaliseCapTrue_standin_def Let_def)
@@ -2055,39 +2030,11 @@ lemma cteDeleteOne_weak_sch_act[wp]:
 crunch weak_sch_act_wf[wp]: emptySlot "\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s"
 
 crunch pred_tcb_at'[wp]: handleFaultReply "pred_tcb_at' proj P t"
-crunch valid_queues[wp]: handleFaultReply "Invariants_H.valid_queues"
-crunch valid_queues'[wp]: handleFaultReply "valid_queues'"
 crunch tcb_in_cur_domain'[wp]: handleFaultReply "tcb_in_cur_domain' t"
 
 crunch sch_act_wf[wp]: unbindNotification "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
 (wp: sbn_sch_act')
 
-crunch valid_queues'[wp]: cteDeleteOne valid_queues'
-  (simp: crunch_simps unless_def inQ_def
-     wp: crunch_wps sts_st_tcb' getObject_inv loadObject_default_inv
-         threadSet_valid_queues' rescheduleRequired_valid_queues'_weak)
-
-lemma cancelSignal_valid_queues'[wp]:
-  "\<lbrace>valid_queues'\<rbrace> cancelSignal t ntfn \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (simp add: cancelSignal_def)
-  apply (rule hoare_pre)
-   apply (wp getNotification_wp| wpc | simp)+
-  done
-
-lemma cancelIPC_valid_queues'[wp]:
-  "\<lbrace>valid_queues' and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) \<rbrace> cancelIPC t \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (simp add: cancelIPC_def Let_def getThreadReplySlot_def locateSlot_conv liftM_def)
-  apply (rule hoare_seq_ext[OF _ gts_sp'])
-  apply (case_tac state, simp_all) defer 2
-  apply (rule hoare_pre)
-   apply ((wp getEndpoint_wp getCTE_wp | wpc | simp)+)[8]
-  apply (wp cteDeleteOne_valid_queues')
-  apply (rule_tac Q="\<lambda>_. valid_queues' and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)" in hoare_post_imp)
-  apply (clarsimp simp: capHasProperty_def cte_wp_at_ctes_of)
-   apply (wp threadSet_valid_queues' threadSet_sch_act| simp)+
-  apply (clarsimp simp: inQ_def)
-  done
-
 crunch valid_objs'[wp]: handleFaultReply valid_objs'
 
 lemma cte_wp_at_is_reply_cap_toI:
@@ -2099,6 +2046,13 @@ crunches handle_fault_reply
   for pspace_alignedp[wp]: pspace_aligned
   and pspace_distinct[wp]: pspace_distinct
 
+crunches 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 doReplyTransfer_corres:
   "corres dc
      (einvs and tcb_at receiver and tcb_at sender
@@ -2144,8 +2098,12 @@ lemma doReplyTransfer_corres:
            apply (rule corres_split[OF setThreadState_corres])
               apply simp
              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_queues sts_valid_objs' delete_one_tcbDomain_obj_at'
-                   | simp add: valid_tcb_state'_def)+
+            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])
@@ -2154,7 +2112,11 @@ lemma doReplyTransfer_corres:
           apply (fastforce)
          apply (clarsimp simp:is_cap_simps)
         apply (wp weak_valid_sched_action_lift)+
-       apply (rule_tac Q="\<lambda>_. valid_queues' and valid_objs' and cur_tcb' and tcb_at' receiver and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)" in hoare_post_imp, simp add: sch_act_wf_weak)
+       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)
@@ -2186,7 +2148,9 @@ lemma doReplyTransfer_corres:
                 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 Invariants_H.valid_queues and valid_queues' and valid_objs'"
+                                      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)
@@ -2195,18 +2159,16 @@ lemma doReplyTransfer_corres:
                        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_queues
+                                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 simp: tcb_relation_def)
                    apply (wp threadSet_cur weak_sch_act_wf_lift_linear threadSet_pred_tcb_no_state
-                             thread_set_not_state_valid_sched threadSet_valid_queues threadSet_valid_queues'
+                             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 (wp threadSet_cur weak_sch_act_wf_lift_linear threadSet_pred_tcb_no_state
-                      thread_set_not_state_valid_sched threadSet_valid_queues threadSet_valid_queues'
-                 | simp add: runnable_def inQ_def valid_tcb'_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)
@@ -2476,10 +2438,12 @@ proof -
                  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 setThreadState_valid_queues' sts_valid_queues sts_weak_sch_act_wf
+               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)
+              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)
@@ -2544,11 +2508,13 @@ proof -
                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 setThreadState_valid_queues' sts_valid_queues sts_weak_sch_act_wf
+              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)+)[1]
+                     | 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)
@@ -2622,14 +2588,15 @@ lemma sendSignal_corres:
                apply (rule possibleSwitchTo_corres)
               apply wp
              apply (wp set_thread_state_runnable_weak_valid_sched_action sts_st_tcb_at'
-                       sts_valid_queues sts_st_tcb' hoare_disjI2
+                       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 (clarsimp simp: invs'_def valid_state'_def sch_act_wf_weak
-                               valid_tcb_state'_def)
+         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)+
@@ -2655,23 +2622,23 @@ lemma sendSignal_corres:
           apply (rule corres_split[OF asUser_setRegister_corres])
             apply (rule possibleSwitchTo_corres)
            apply ((wp | simp)+)[1]
-          apply (rule_tac Q="\<lambda>_. Invariants_H.valid_queues and valid_queues' and
-                                 (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and
+          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'"
+                                 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_queues setThreadState_valid_queues'
-                  setThreadState_st_tcb
+        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 (clarsimp 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 (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)
 
@@ -2689,16 +2656,14 @@ lemma sendSignal_corres:
           apply (wp cur_tcb_lift | 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_queues setThreadState_valid_queues'
-                 setThreadState_st_tcb
-            | 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 (clarsimp 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 (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]
@@ -2729,38 +2694,6 @@ lemma possibleSwitchTo_sch_act[wp]:
   apply (auto simp: obj_at'_def projectKOs tcb_in_cur_domain'_def)
   done
 
-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>"
-  apply (simp add: possibleSwitchTo_def curDomain_def bitmap_fun_defs)
-  apply (wp hoare_drop_imps | wpc | simp)+
-  apply (auto simp: valid_tcb'_def weak_sch_act_wf_def
-              dest: pred_tcb_at'
-             elim!: valid_objs_valid_tcbE)
-  done
-
-lemma possibleSwitchTo_ksQ':
-  "\<lbrace>(\<lambda>s. t' \<notin> set (ksReadyQueues s p) \<and> sch_act_not t' s) and K(t' \<noteq> t)\<rbrace>
-     possibleSwitchTo t
-   \<lbrace>\<lambda>_ s. t' \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: possibleSwitchTo_def curDomain_def bitmap_fun_defs)
-  apply (wp hoare_weak_lift_imp rescheduleRequired_ksQ' tcbSchedEnqueue_ksQ threadGet_wp
-         | wpc
-         | simp split del: if_split)+
-  apply (auto simp: obj_at'_def)
-  done
-
-lemma possibleSwitchTo_valid_queues'[wp]:
-  "\<lbrace>valid_queues' and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)
-                  and st_tcb_at' runnable' t\<rbrace>
-   possibleSwitchTo t
-   \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (simp add: possibleSwitchTo_def curDomain_def bitmap_fun_defs)
-  apply (wp hoare_weak_lift_imp threadGet_wp | wpc | simp)+
-  apply (auto simp: obj_at'_def)
-  done
-
 crunch st_refs_of'[wp]: possibleSwitchTo "\<lambda>s. P (state_refs_of' s)"
   (wp: crunch_wps)
 
@@ -2772,15 +2705,15 @@ crunch ct[wp]: possibleSwitchTo 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>"
+  "\<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)+
-  apply (auto simp: obj_at'_def projectKOs)
+  apply (auto simp: obj_at'_def)
   done
 
 crunch ifunsafe[wp]: possibleSwitchTo if_unsafe_then_cap'
@@ -2812,10 +2745,6 @@ crunch irqs_masked'[wp]: sendSignal "irqs_masked'"
    simp: crunch_simps unless_def o_def
    rule: irqs_masked_lift)
 
-lemma sts_running_valid_queues:
-  "runnable' st \<Longrightarrow> \<lbrace> Invariants_H.valid_queues \<rbrace> setThreadState st t \<lbrace>\<lambda>_. Invariants_H.valid_queues \<rbrace>"
-  by (wp sts_valid_queues, clarsimp)
-
 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)
@@ -2828,24 +2757,21 @@ lemma setThreadState_nonqueued_state_update:
                \<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)
-               \<and> (\<not> runnable' st \<longrightarrow> (\<forall>p. t \<notin> set (ksReadyQueues s p)))\<rbrace>
-  setThreadState st t \<lbrace>\<lambda>rv. invs'\<rbrace>"
+               \<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
-                            sts_valid_queues
-                            setThreadState_ct_not_inQ)
+  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 (drule simple_st_tcb_at_state_refs_ofD')
   apply (drule bound_tcb_at_state_refs_ofD')
-  apply (rule conjI, fastforce)
-  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 (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
 
 lemma cteDeleteOne_reply_cap_to'[wp]:
@@ -2913,16 +2839,14 @@ lemma cancelAllIPC_not_rct[wp]:
    \<lbrace>\<lambda>_ s. ksSchedulerAction s \<noteq> ResumeCurrentThread \<rbrace>"
   apply (simp add: cancelAllIPC_def)
   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 (wp)+
-     apply (rule hoare_post_imp [OF _ rescheduleRequired_notresume], simp)
-    apply simp
-    apply (rule mapM_x_wp_inv)
-    apply (wp)+
-  apply (wp hoare_vcg_all_lift hoare_drop_imp)
-    apply (simp_all)
+      apply (wpsimp wp: hoare_vcg_all_lift hoare_drop_imp)+
   done
 
 lemma cancelAllSignals_not_rct[wp]:
@@ -2931,12 +2855,10 @@ lemma cancelAllSignals_not_rct[wp]:
    \<lbrace>\<lambda>_ s. ksSchedulerAction s \<noteq> ResumeCurrentThread \<rbrace>"
   apply (simp add: cancelAllSignals_def)
   apply (wp | wpc)+
-     apply (rule hoare_post_imp [OF _ rescheduleRequired_notresume], simp)
-    apply simp
-    apply (rule mapM_x_wp_inv)
-    apply (wp)+
-  apply (wp hoare_vcg_all_lift hoare_drop_imp)
-    apply (simp_all)
+       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 not_rct[wp]: finaliseCapTrue_standin "\<lambda>s. ksSchedulerAction s \<noteq> ResumeCurrentThread"
@@ -3020,7 +2942,6 @@ lemma sai_invs'[wp]:
      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
-               sts_valid_queues [where st="Structures_H.thread_state.Running", simplified]
                set_ntfn_valid_objs' cur_tcb_lift sts_st_tcb'
                hoare_convert_imp [OF setNotification_nosch]
            | simp split del: if_split)+
@@ -3233,11 +3154,11 @@ lemma receiveIPC_corres:
                                              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 Invariants_H.valid_queues
-                                                   and valid_queues'
                                                    and valid_pspace'
                                                    and valid_objs'
-                                             and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)"
+                                             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])
@@ -3246,17 +3167,18 @@ lemma receiveIPC_corres:
                        apply (rule corres_split[OF setThreadState_corres])
                           apply simp
                          apply (rule possibleSwitchTo_corres)
-                        apply (wp sts_st_tcb_at' set_thread_state_runnable_weak_valid_sched_action
-                             | simp)+
-                       apply (wp sts_st_tcb_at'_cases sts_valid_queues setThreadState_valid_queues'
-                                 setThreadState_st_tcb
+                        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 (clarsimp simp: st_tcb_at_tcb_at st_tcb_def2 valid_sched_def
-                                            valid_sched_action_def)
+                      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"
-                         in hoare_post_imp, erule sch_act_wf_weak)
+                   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
@@ -3475,30 +3397,6 @@ lemma setupCallerCap_state_refs_of[wp]:
   apply (simp add: fun_upd_def cong: if_cong)
   done
 
-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 vq[wp]: cteInsert "Invariants_H.valid_queues"
-  (wp: crunch_wps)
-
-crunch vq[wp]: getThreadCallerSlot "Invariants_H.valid_queues"
-  (wp: crunch_wps)
-
-crunch vq[wp]: getThreadReplySlot "Invariants_H.valid_queues"
-  (wp: crunch_wps)
-
-lemma setupCallerCap_vq[wp]:
-  "\<lbrace>Invariants_H.valid_queues and (\<lambda>s. \<forall>p. send \<notin> set (ksReadyQueues s p))\<rbrace>
-   setupCallerCap send recv grant \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: setupCallerCap_def)
-  apply (wp crunch_wps sts_valid_queues)
-  apply (fastforce simp: valid_queues_def obj_at'_def inQ_def)
-  done
-
-crunch vq'[wp]: setupCallerCap "valid_queues'"
-  (wp: crunch_wps)
-
 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)"
@@ -3540,7 +3438,7 @@ lemma setupCallerCap_vp[wp]:
   done
 
 lemma setupCallerCap_iflive[wp]:
-  "\<lbrace>if_live_then_nonz_cap' and ex_nonz_cap_to' sender\<rbrace>
+  "\<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
@@ -3552,7 +3450,7 @@ lemma setupCallerCap_iflive[wp]:
 
 lemma setupCallerCap_ifunsafe[wp]:
   "\<lbrace>if_unsafe_then_cap' and valid_objs' and
-    ex_nonz_cap_to' rcvr and tcb_at' rcvr\<rbrace>
+    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
@@ -3574,13 +3472,11 @@ lemma setupCallerCap_global_refs'[wp]:
    \<lbrace>\<lambda>rv. valid_global_refs'\<rbrace>"
   unfolding setupCallerCap_def getThreadCallerSlot_def
             getThreadReplySlot_def locateSlot_conv
-  apply (wp getSlotCap_cte_wp_at
-    | simp add: o_def unique_master_reply_cap'
-    | strengthen eq_imp_strg
-    | wp (once) getCTE_wp | clarsimp simp: cte_wp_at_ctes_of)+
-  (* at setThreadState *)
-  apply (rule_tac Q="\<lambda>_. valid_global_refs'" in hoare_post_imp, wpsimp+)
-  done
+  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 valid_arch'[wp]: setupCallerCap "valid_arch_state'"
   (wp: hoare_drop_imps)
@@ -3756,12 +3652,21 @@ crunches possibleSwitchTo
   for ksArch[wp]: "\<lambda>s. P (ksArchState s)"
   (wp: possibleSwitchTo_ctes_of crunch_wps ignore: constOnFailure)
 
+crunches asUser
+  for valid_bitmaps[wp]: valid_bitmaps
+  (rule: valid_bitmaps_lift wp: crunch_wps)
+
+crunches 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)
+
 (* 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 (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))
           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
@@ -3779,7 +3684,7 @@ lemma ri_invs' [wp]:
      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
-                sts_valid_queues setThreadState_ct_not_inQ
+                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)
@@ -3806,7 +3711,7 @@ lemma ri_invs' [wp]:
     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
-               sts_valid_queues setThreadState_ct_not_inQ
+               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)
@@ -3830,9 +3735,8 @@ lemma ri_invs' [wp]:
    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' sts_valid_queues
-              setThreadState_ct_not_inQ possibleSwitchTo_valid_queues
-              possibleSwitchTo_valid_queues'
+              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
@@ -3850,8 +3754,6 @@ lemma ri_invs' [wp]:
                          st_tcb_at_refs_of_rev' conj_ac
               split del: if_split
                    cong: if_cong)
-   apply (frule_tac t=sender in valid_queues_not_runnable'_not_ksQ)
-    apply (erule pred_tcb'_weakenE, clarsimp)
    apply (subgoal_tac "sch_act_not sender s")
     prefer 2
     apply (clarsimp simp: pred_tcb_at'_def obj_at'_def)
@@ -3885,7 +3787,6 @@ lemma ri_invs' [wp]:
 lemma rai_invs'[wp]:
   "\<lbrace>invs' and sch_act_not t
           and st_tcb_at' simple' t
-          and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))
           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
@@ -3902,7 +3803,7 @@ lemma rai_invs'[wp]:
     apply (simp add: invs'_def valid_state'_def)
     apply (rule hoare_pre)
      apply (wp valid_irq_node_lift sts_sch_act' typ_at_lifts
-               sts_valid_queues setThreadState_ct_not_inQ
+               setThreadState_ct_not_inQ
                asUser_urz
             | simp add: valid_ntfn'_def doNBRecvFailedTransfer_def | wpc)+
     apply (clarsimp simp: pred_tcb_at' valid_tcb_state'_def)
@@ -3920,7 +3821,7 @@ lemma rai_invs'[wp]:
        apply (clarsimp split: if_split_asm)
       apply (fastforce simp: tcb_bound_refs'_def symreftype_inverse'
                       split: if_split_asm)
-     apply (clarsimp dest!: global'_no_ex_cap)
+     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)
@@ -3940,7 +3841,7 @@ lemma rai_invs'[wp]:
   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'
-             sts_valid_queues setThreadState_ct_not_inQ typ_at_lifts
+             setThreadState_ct_not_inQ typ_at_lifts
              asUser_urz
         | simp add: valid_ntfn'_def doNBRecvFailedTransfer_def | wpc)+
   apply (clarsimp simp: valid_tcb_state'_def)
@@ -3968,7 +3869,7 @@ lemma rai_invs'[wp]:
         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 (clarsimp dest!: global'_no_ex_cap)
+  apply (fastforce dest!: global'_no_ex_cap)
   done
 
 lemma getCTE_cap_to_refs[wp]:
@@ -4000,7 +3901,6 @@ 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>Invariants_H.valid_queues\<rbrace> cteInsert a b c \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<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
@@ -4018,9 +3918,12 @@ lemma possibleSwitchTo_sch_act_not:
 crunch urz[wp]: possibleSwitchTo "untyped_ranges_zero'"
   (simp: crunch_simps unless_def wp: crunch_wps)
 
+crunches possibleSwitchTo
+  for pspace_aligned'[wp]: pspace_aligned'
+  and pspace_distinct'[wp]: pspace_distinct'
+
 lemma si_invs'[wp]:
   "\<lbrace>invs' and st_tcb_at' simple' t
-          and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))
           and sch_act_not t
           and ex_nonz_cap_to' ep and ex_nonz_cap_to' t\<rbrace>
   sendIPC bl call ba cg cgr t ep
@@ -4039,8 +3942,8 @@ lemma si_invs'[wp]:
      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 sts_valid_queues setThreadState_ct_not_inQ
-               possibleSwitchTo_ksQ' possibleSwitchTo_ct_not_inQ hoare_vcg_all_lift sts_ksQ'
+               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"]
@@ -4092,8 +3995,7 @@ lemma si_invs'[wp]:
     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' sts_valid_queues
-               setThreadState_ct_not_inQ)
+     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")
@@ -4112,8 +4014,7 @@ lemma si_invs'[wp]:
    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'
-              sts_valid_queues setThreadState_ct_not_inQ)
+    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)
@@ -4139,19 +4040,15 @@ lemma si_invs'[wp]:
 lemma sfi_invs_plus':
   "\<lbrace>invs' and st_tcb_at' simple' t
           and sch_act_not t
-          and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))
           and ex_nonz_cap_to' t\<rbrace>
-      sendFaultIPC t f
-   \<lbrace>\<lambda>rv. invs'\<rbrace>, \<lbrace>\<lambda>rv. invs' and st_tcb_at' simple' t
-                      and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))
-                      and sch_act_not t and (\<lambda>s. ksIdleThread s \<noteq> 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'
            | wpc | simp)+
    apply (rule_tac Q'="\<lambda>rv s. invs' s \<and> sch_act_not t s
                              \<and> st_tcb_at' simple' t s
-                             \<and> (\<forall>p. t \<notin> set (ksReadyQueues s p))
                              \<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)"
@@ -4173,7 +4070,6 @@ lemma handleFault_corres:
    corres dc (einvs and st_tcb_at active thread and ex_nonz_cap_to thread
                    and (\<lambda>_. valid_fault f))
              (invs' and sch_act_not thread
-                    and (\<lambda>s. \<forall>p. thread \<notin> set(ksReadyQueues s p))
                     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)
@@ -4197,17 +4093,13 @@ lemma sts_invs_minor'':
                    \<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. (\<exists>p. t \<in> set (ksReadyQueues s p)) \<longrightarrow> runnable' st)
-      and (\<lambda>s. runnable' st \<and> obj_at' tcbQueued t s
-                                      \<longrightarrow> st_tcb_at' runnable' t s)
       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' sts_valid_queues
-             setThreadState_ct_not_inQ)
+   apply (wp valid_irq_node_lift sts_sch_act' setThreadState_ct_not_inQ)
   apply clarsimp
   apply (rule conjI)
    apply fastforce
@@ -4222,12 +4114,11 @@ lemma sts_invs_minor'':
    apply (clarsimp dest!: st_tcb_at_state_refs_ofD'
                    elim!: rsubst[where P=sym_refs]
                   intro!: ext)
-  apply (clarsimp elim!: st_tcb_ex_cap'')
+  apply (fastforce elim!: st_tcb_ex_cap'')
   done
 
 lemma hf_invs' [wp]:
   "\<lbrace>invs' and sch_act_not t
-          and (\<lambda>s. \<forall>p. t \<notin> set(ksReadyQueues s p))
           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>"
diff --git a/proof/refine/RISCV64/KHeap_R.thy b/proof/refine/RISCV64/KHeap_R.thy
index 194f9a1b90..9073187811 100644
--- a/proof/refine/RISCV64/KHeap_R.thy
+++ b/proof/refine/RISCV64/KHeap_R.thy
@@ -13,8 +13,45 @@ lemma lookupAround2_known1:
   "m x = Some y \<Longrightarrow> fst (lookupAround2 x m) = Some (x, y)"
   by (fastforce simp: lookupAround2_char1)
 
+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
+
 context begin interpretation Arch . (*FIXME: arch_split*)
 
+lemma setObject_modify_variable_size:
+  fixes v :: "'a :: pspace_storable" shows
+  "\<lbrakk>obj_at' (P :: 'a \<Rightarrow> bool) p s; updateObject v = updateObject_default v;
+    (1 :: machine_word) < 2 ^ objBits v; obj_at' (\<lambda>obj. objBits v = objBits obj) p s\<rbrakk>
+   \<Longrightarrow> setObject p v s = modify (ksPSpace_update (\<lambda>ps. ps (p \<mapsto> injectKO v))) s"
+  apply (clarsimp simp: setObject_def split_def exec_gets obj_at'_def lookupAround2_known1
+                        assert_opt_def updateObject_default_def bind_assoc)
+  apply (simp add: projectKO_def alignCheck_assert)
+  apply (simp add: project_inject objBits_def)
+  apply (clarsimp simp only: koTypeOf_injectKO)
+  apply (frule in_magnitude_check[where s'=s])
+    apply blast
+   apply fastforce
+  apply (simp add: magnitudeCheck_assert in_monad bind_def gets_def oassert_opt_def
+                   get_def return_def)
+  apply (simp add: simpler_modify_def)
+  done
+
+lemma setObject_modify:
+  fixes v :: "'a :: pspace_storable" shows
+  "\<lbrakk>obj_at' (P :: 'a \<Rightarrow> bool) p s; updateObject v = updateObject_default v;
+    (1 :: machine_word) < 2 ^ objBits v; \<And>ko. P ko \<Longrightarrow> objBits ko = objBits v \<rbrakk>
+   \<Longrightarrow> setObject p v s = modify (ksPSpace_update (\<lambda>ps. ps (p \<mapsto> injectKO v))) s"
+  apply (rule setObject_modify_variable_size)
+     apply fastforce
+    apply fastforce
+  apply fastforce
+  unfolding obj_at'_def
+  by fastforce
+
 lemma obj_at_getObject:
   assumes R:
   "\<And>a b n ko s obj::'a::pspace_storable.
@@ -114,8 +151,7 @@ lemma corres_get_tcb:
   apply (drule bspec)
    apply clarsimp
    apply blast
-  apply (clarsimp simp add: other_obj_relation_def
-                            lookupAround2_known1)
+  apply (clarsimp simp: tcb_relation_cut_def lookupAround2_known1)
   done
 
 lemma lookupAround2_same1[simp]:
@@ -381,6 +417,40 @@ lemma setObject_tcb_strongest:
                         updateObject_default_def ps_clear_upd)
   done
 
+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 opt_pred_def projectKO_opts_defs projectKO_eq
+          split: if_split_asm
+                 Structures_H.kernel_object.split_asm
+
+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_tcbs_of'[wp]:
+  "setObject c (notification :: notification) \<lbrace>\<lambda>s. P' (tcbs_of' s)\<rbrace>"
+  by setObject_easy_cases
+
+lemma setObject_cte_tcbSchedNexts_of[wp]:
+  "setObject c (cte :: cte) \<lbrace>\<lambda>s. P' (tcbSchedNexts_of s)\<rbrace>"
+  by setObject_easy_cases
+
+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_tcbQueued[wp]:
+  "setObject c (cte :: cte) \<lbrace>\<lambda>s. P' (tcbQueued |< tcbs_of' s)\<rbrace>"
+  supply inQ_def[simp]
+  by setObject_easy_cases
+
+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 getObject_obj_at':
   assumes x: "\<And>q n ko. loadObject p q n ko =
                 (loadObject_default p q n ko :: ('a :: pspace_storable) kernel)"
@@ -896,7 +966,7 @@ lemma obj_relation_cut_same_type:
          \<or> (\<exists>sz sz'. a_type ko = AArch (ADeviceData sz) \<and> a_type ko' = AArch (ADeviceData sz'))"
   apply (rule ccontr)
   apply (simp add: obj_relation_cuts_def2 a_type_def)
-  apply (auto simp: other_obj_relation_def cte_relation_def pte_relation_def
+  apply (auto simp: other_obj_relation_def tcb_relation_cut_def cte_relation_def pte_relation_def
              split: Structures_A.kernel_object.split_asm if_split_asm
                     Structures_H.kernel_object.split_asm
                     arch_kernel_obj.split_asm)
@@ -913,6 +983,16 @@ where
   "exst_same' (KOTCB tcb) (KOTCB tcb') = exst_same tcb tcb'" |
   "exst_same' _ _ = True"
 
+lemma tcbs_of'_non_tcb_update:
+  "\<lbrakk>typ_at' (koTypeOf ko) ptr s'; koTypeOf ko \<noteq> TCBT\<rbrakk>
+   \<Longrightarrow> tcbs_of' (s'\<lparr>ksPSpace := (ksPSpace s')(ptr \<mapsto> ko)\<rparr>) = tcbs_of' s'"
+  by (fastforce simp: typ_at'_def ko_wp_at'_def opt_map_def projectKO_opts_defs
+               split: kernel_object.splits)
+
+lemma typ_at'_koTypeOf:
+  "ko_at' ob' ptr b \<Longrightarrow> typ_at' (koTypeOf (injectKO ob')) ptr b"
+  by (auto simp: typ_at'_def ko_wp_at'_def obj_at'_def project_inject)
+
 lemma setObject_other_corres:
   fixes ob' :: "'a :: pspace_storable"
   assumes x: "updateObject ob' = updateObject_default ob'"
@@ -942,7 +1022,7 @@ lemma setObject_other_corres:
   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 (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 simp: obj_at_def a_type_def
@@ -952,6 +1032,14 @@ lemma setObject_other_corres:
   apply (simp only: pspace_relation_def pspace_dom_update dom_fun_upd2 simp_thms)
   apply (elim conjE)
   apply (frule bspec, erule domI)
+  apply (prop_tac "typ_at' (koTypeOf (injectKO ob')) ptr b")
+   subgoal
+     by (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 clarsimp
   apply (rule conjI)
    apply (rule ballI, drule(1) bspec)
    apply (drule domD)
@@ -960,31 +1048,30 @@ lemma setObject_other_corres:
    apply clarsimp
    apply (frule_tac ko'=ko and x'=ptr in obj_relation_cut_same_type,
            (fastforce simp add: is_other_obj_relation_type t)+)
-   apply (erule disjE)
-    apply (simp add: is_other_obj_relation_type t)
-   apply (erule disjE)
-    apply (insert t,
-      clarsimp simp: is_other_obj_relation_type_CapTable a_type_def)
-   apply (erule disjE)
-    apply (insert t,
-       clarsimp simp: is_other_obj_relation_type_UserData a_type_def)
-   apply (insert t,
-      clarsimp simp: is_other_obj_relation_type_DeviceData a_type_def)
-  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)+
-  done
+   apply (insert t)
+   apply ((erule disjE
+          | clarsimp simp: is_other_obj_relation_type is_other_obj_relation_type_def a_type_def)+)[1]
+  apply (extract_conjunct \<open>match conclusion in "ekheap_relation _ _" \<Rightarrow> -\<close>)
+   apply (simp only: ekheap_relation_def)
+   apply (rule ballI, drule(1) bspec)
+   apply (drule domD)
+   apply (insert e)
+   apply atomize
+   apply (clarsimp simp: obj_at'_def)
+   apply (erule_tac x=obj in allE)
+   apply (clarsimp simp: projectKO_eq project_inject)
+   apply (case_tac ob;
+          simp_all add: a_type_def other_obj_relation_def etcb_relation_def
+                        is_other_obj_relation_type t exst_same_def)
+     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 map_to_ctes_upd_other
                       is_other_obj_relation_type_def
@@ -1074,13 +1161,14 @@ lemma typ_at'_valid_obj'_lift:
      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,
+            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 valid_bound_ntfn'_def
-             split: option.splits,
-          wpsimp)
+          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)
   done
 
@@ -1357,32 +1445,6 @@ lemma set_ep_bitmapQ_no_L2_orphans[wp]:
   apply (wp hoare_Ball_helper hoare_vcg_all_lift updateObject_default_inv | simp add: bitmapQ_def)+
   done
 
-lemma set_ep_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> setEndpoint epptr ep \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: Invariants_H.valid_queues_def)
-  apply (wp hoare_vcg_conj_lift)
-    apply (simp add: setEndpoint_def valid_queues_no_bitmap_def)
-    apply (wp hoare_Ball_helper hoare_vcg_all_lift)
-      apply (rule obj_at_setObject2)
-      apply (clarsimp simp: updateObject_default_def in_monad)
-     apply (wp updateObject_default_inv set_ep_valid_bitmapQ[unfolded setEndpoint_def]
-            | simp add: valid_queues_no_bitmap_def)+
-  done
-
-lemma set_ep_valid_queues'[wp]:
-  "\<lbrace>valid_queues'\<rbrace> setEndpoint epptr ep \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (unfold setEndpoint_def)
-  apply (simp only: valid_queues'_def imp_conv_disj
-                    obj_at'_real_def)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-    apply (rule setObject_ko_wp_at)
-      apply simp
-     apply (simp add: objBits_simps')
-    apply simp
-   apply (wp updateObject_default_inv | simp)+
-  apply (clarsimp simp: ko_wp_at'_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>"
@@ -1579,34 +1641,6 @@ lemma set_ntfn_bitmapQ_no_L2_orphans[wp]:
   apply (wp hoare_Ball_helper hoare_vcg_all_lift updateObject_default_inv | simp)+
   done
 
-lemma set_ntfn_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> setNotification p ntfn \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: Invariants_H.valid_queues_def)
-  apply (rule hoare_pre)
-   apply (wp hoare_vcg_conj_lift)
-    apply (simp add: setNotification_def valid_queues_no_bitmap_def)
-    apply (wp hoare_Ball_helper hoare_vcg_all_lift)
-      apply (rule obj_at_setObject2)
-      apply (clarsimp simp: updateObject_default_def in_monad)
-     apply (wp updateObject_default_inv set_ep_valid_bitmapQ[unfolded setEndpoint_def]
-            | simp add: valid_queues_no_bitmap_def)+
-  done
-
-lemma set_ntfn_valid_queues'[wp]:
-  "\<lbrace>valid_queues'\<rbrace> setNotification p ntfn \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (unfold setNotification_def)
-  apply (rule setObject_ntfn_pre)
-  apply (simp only: valid_queues'_def imp_conv_disj
-                    obj_at'_real_def)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-    apply (rule setObject_ko_wp_at)
-      apply simp
-     apply (simp add: objBits_simps')
-    apply simp
-   apply (wp updateObject_default_inv | simp)+
-  apply (clarsimp simp: ko_wp_at'_def)
-  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>
@@ -1993,6 +2027,21 @@ lemma setNotification_ct_idle_or_in_cur_domain'[wp]:
 crunch gsUntypedZeroRanges[wp]: setNotification "\<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>"
+  assumes nexts: "\<And>P. f \<lbrace>\<lambda>s. P (tcbSchedNexts_of s)\<rbrace>"
+  shows "f \<lbrace>sym_heap_sched_pointers\<rbrace>"
+  by (rule_tac f=tcbSchedPrevs_of in hoare_lift_Pf2; wpsimp wp: assms)
+
+crunches setNotification
+  for tcbSchedNexts_of[wp]: "\<lambda>s. P (tcbSchedNexts_of s)"
+  and tcbSchedPrevs_of[wp]: "\<lambda>s. P (tcbSchedPrevs_of s)"
+  and valid_sched_pointers[wp]: valid_sched_pointers
+  and ksReadyQueues[wp]: "\<lambda>s. P (ksReadyQueues s)"
+  and ksReadyQueuesL1Bitmap[wp]: "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
+  and ksReadyQueuesL2Bitmap[wp]: "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
+  (simp: updateObject_default_def)
+
 lemma set_ntfn_minor_invs':
   "\<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))
@@ -2002,9 +2051,10 @@ lemma set_ntfn_minor_invs':
          and (\<lambda>s. ptr \<noteq> ksIdleThread s) \<rbrace>
      setNotification ptr val
    \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (clarsimp simp add: invs'_def valid_state'_def cteCaps_of_def)
-  apply (wp irqs_masked_lift valid_irq_node_lift untyped_ranges_zero_lift,
-    simp_all add: o_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')+
@@ -2089,21 +2139,17 @@ crunch typ_at'[wp]: doMachineOp "\<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>"
+  "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
-                valid_pspace'_def valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs
-       | wp cur_tcb_lift sch_act_wf_lift tcb_in_cur_domain'_lift
-       | fastforce elim: state_refs_of'_pspaceI)+
+      | wp
+      | fastforce elim: state_refs_of'_pspaceI)+
 
 crunch obj_at'[wp]: doMachineOp "\<lambda>s. P (obj_at' P' p s)"
 
@@ -2132,5 +2178,28 @@ lemma obj_at'_is_canonical:
   apply (clarsimp simp: obj_at'_def pspace_canonical'_def)
   by (drule_tac x=t in bspec) clarsimp+
 
+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 project_inject pspace_distinct'_def pspace_aligned'_def)
+  apply (drule bspec, erule domI)+
+  apply (clarsimp simp: bit_simps objBits_simps' word_bits_def
+                 split: kernel_object.splits arch_kernel_object.splits)
+  done
+
+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
+
+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)
+
 end
 end
diff --git a/proof/refine/RISCV64/Refine.thy b/proof/refine/RISCV64/Refine.thy
index 55317f076d..b1411c393d 100644
--- a/proof/refine/RISCV64/Refine.thy
+++ b/proof/refine/RISCV64/Refine.thy
@@ -77,7 +77,7 @@ lemma typ_at_UserDataI:
   apply clarsimp
   apply (subst mask_lower_twice [where n = pageBits, OF pbfs_atleast_pageBits, symmetric])
   apply (clarsimp simp: obj_relation_cuts_def2 pte_relation_def
-                        cte_relation_def other_obj_relation_def
+                        cte_relation_def other_obj_relation_def tcb_relation_cut_def
               split: Structures_A.kernel_object.split_asm
                      Structures_H.kernel_object.split_asm
                      if_split_asm arch_kernel_obj.split_asm)
@@ -106,7 +106,7 @@ lemma typ_at_DeviceDataI:
   apply clarsimp
   apply (subst mask_lower_twice [where n = pageBits, OF pbfs_atleast_pageBits, symmetric])
   apply (clarsimp simp: obj_relation_cuts_def2 pte_relation_def
-                        cte_relation_def other_obj_relation_def
+                        cte_relation_def other_obj_relation_def tcb_relation_cut_def
               split: Structures_A.kernel_object.split_asm
                      Structures_H.kernel_object.split_asm
                      if_split_asm arch_kernel_obj.split_asm)
@@ -496,6 +496,10 @@ qed
 definition
   "ex_abs G \<equiv> \<lambda>s'. \<exists>s. ((s :: (det_ext) state),s') \<in> state_relation \<and> G s"
 
+lemma ex_abs_ksReadyQueues_asrt:
+  "ex_abs P s \<Longrightarrow> ksReadyQueues_asrt s"
+  by (fastforce simp: ex_abs_def intro: ksReadyQueues_asrt_cross)
+
 lemma device_update_invs':
   "\<lbrace>invs'\<rbrace>doMachineOp (device_memory_update ds)
    \<lbrace>\<lambda>_. invs'\<rbrace>"
@@ -559,7 +563,7 @@ lemma kernel_corres':
            apply simp
            apply (rule handleInterrupt_corres[simplified dc_def])
           apply simp
-          apply (wp hoare_drop_imps hoare_vcg_all_lift)[1]
+          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>
@@ -635,7 +639,7 @@ lemma entry_corres:
     apply (rule corres_split[OF getCurThread_corres])
       apply (rule corres_split)
          apply simp
-         apply (rule threadset_corresT)
+         apply (rule threadset_corresT; simp?)
             apply (simp add: tcb_relation_def arch_tcb_relation_def
                              arch_tcb_context_set_def atcbContextSet_def)
            apply (clarsimp simp: tcb_cap_cases_def cteSizeBits_def)
diff --git a/proof/refine/RISCV64/Retype_R.thy b/proof/refine/RISCV64/Retype_R.thy
index 8ac1ba2fc3..f6006974a5 100644
--- a/proof/refine/RISCV64/Retype_R.thy
+++ b/proof/refine/RISCV64/Retype_R.thy
@@ -293,7 +293,7 @@ lemma state_relation_null_filterE:
      null_filter (caps_of_state t) = null_filter (caps_of_state s);
      null_filter' (ctes_of t') = null_filter' (ctes_of s');
      pspace_relation (kheap t) (ksPSpace t');
-     ekheap_relation (ekheap t) (ksPSpace t');
+     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';
@@ -979,7 +979,7 @@ lemma retype_ekheap_relation:
      apply (intro impI conjI)
       apply clarsimp
       apply (drule_tac x=a in bspec,force)
-      apply (clarsimp simp add: other_obj_relation_def split: if_split_asm)
+      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 RISCV64_H.object_type.splits
@@ -1157,6 +1157,11 @@ lemma ksMachineState_update_gs[simp]:
   by (simp add: update_gs_def
          split: aobject_type.splits Structures_A.apiobject_type.splits)
 
+lemma ksReadyQueues_update_gs[simp]:
+  "ksReadyQueues (update_gs tp us addrs s) = ksReadyQueues s"
+  by (simp add: update_gs_def
+         split: aobject_type.splits Structures_A.apiobject_type.splits)
+
 lemma update_gs_ksMachineState_update_swap:
   "update_gs tp us addrs (ksMachineState_update f s) =
    ksMachineState_update f (update_gs tp us addrs s)"
@@ -1179,6 +1184,144 @@ lemma update_gs_simps[simp]:
    gsUserPages_update (\<lambda>ups x. if x \<in> ptrs then Some RISCVHugePage else ups x)"
   by (simp_all add: update_gs_def)
 
+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 -
+  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_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>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 (fastforce simp: ptr_add_def p_assoc_help)
+    done
+qed
+
+lemma retype_tcbSchedPrevs_of:
+  assumes   vs': "pspace_aligned' s'" "pspace_distinct' s'"
+  assumes   pn': "pspace_no_overlap' ptr sz s'"
+  assumes    ko: "makeObjectKO dev ty = Some ko"
+  assumes 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
+    "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 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
+           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_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
+    "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 -
+  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
+           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
+    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
+    by (cases ty;
+        fastforce simp  add: makeObjectKO_def makeObject_tcb
+           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"
@@ -1207,7 +1350,7 @@ lemma retype_state_relation:
           \<in> state_relation"
   (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)
+  proof (rule state_relation_null_filterE[OF sr refl _ _ _ _ _ _ _ _ vs'], simp_all add: trans_state_update[symmetric] del: trans_state_update)
 
   have cover':"range_cover ptr sz (objBitsKO ko) m"
     by (rule range_cover_rel[OF cover objBits_le_obj_bits_api[OF ko] num_r])
@@ -1396,6 +1539,16 @@ lemma retype_state_relation:
                                    else cns x" in exI, simp)
       apply (rule_tac x=id in exI, simp)+
     done
+
+  have rdyqrel: "ready_queues_relation s s'"
+    using sr by (simp add: state_relation_def)
+
+  thus "ready_queues_relation_2 (ready_queues s) (ksReadyQueues s')
+                                (?ps' |> tcb_of' |> tcbSchedNext) (?ps' |> tcb_of' |> tcbSchedPrev)
+                                (\<lambda>d p. inQ d p |< (?ps' |> tcb_of'))"
+    using retype_ready_queues_relation[OF _ vs' pn' ko cover num_r]
+    by (clarsimp simp: ready_queues_relation_def Let_def)
+
 qed
 
 lemma new_cap_addrs_fold':
@@ -2369,7 +2522,6 @@ 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 :: Structures_H.notification)
-             | Structures_A.TCBObject \<Rightarrow> ko = injectKO (makeObject :: tcb)
              | _ \<Rightarrow> False \<rbrakk> \<Longrightarrow>
     obj_relation_retype (default_object ty dev n) ko"
   apply (rule obj_relation_retype_other_obj)
@@ -2390,6 +2542,13 @@ lemma other_objs_default_relation:
                  split: Structures_A.apiobject_type.split_asm)
   done
 
+lemma tcb_relation_retype:
+  "obj_relation_retype (default_object Structures_A.TCBObject dev n) (KOTCB makeObject)"
+  by (clarsimp simp: default_object_def obj_relation_retype_def tcb_relation_def default_tcb_def
+                     makeObject_tcb makeObject_cte new_context_def newContext_def
+                     fault_rel_optionation_def initContext_def default_arch_tcb_def newArchTCB_def
+                     arch_tcb_relation_def objBits_simps' tcb_relation_cut_def)
+
 lemma captable_relation_retype:
   "n < word_bits \<Longrightarrow>
    obj_relation_retype (default_object Structures_A.CapTableObject dev n) (KOCTE makeObject)"
@@ -3106,10 +3265,10 @@ proof (intro conjI impI)
        apply (rule_tac ptr="x + xa" in cte_wp_at_tcbI', assumption+)
         apply fastforce
        apply simp
-      apply (rename_tac thread_state mcp priority bool option nat cptr vptr bound user_context)
-      apply (case_tac thread_state, simp_all add: valid_tcb_state'_def
-                                                  valid_bound_ntfn'_def obj_at_disj'
-                                           split: option.splits)[2]
+      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)])
@@ -3817,16 +3976,6 @@ lemma sch_act_wf_lift_asm:
   apply auto
   done
 
-lemma valid_queues_lift_asm':
-  assumes tat: "\<And>d p t. \<lbrace>\<lambda>s. \<not> obj_at' (inQ d p) t s \<and> Q d p s\<rbrace> f \<lbrace>\<lambda>_ s. \<not> obj_at' (inQ d p) t s\<rbrace>"
-  and     prq: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueues s)\<rbrace>"
-  shows   "\<lbrace>\<lambda>s. valid_queues' s \<and> (\<forall>d p. Q d p s)\<rbrace> f \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp only: valid_queues'_def imp_conv_disj)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift
-            tat prq)
-  apply simp
-  done
-
 lemma createObjects'_ct[wp]:
   "\<lbrace>\<lambda>s. P (ksCurThread s)\<rbrace> createObjects' p n v us \<lbrace>\<lambda>rv s. P (ksCurThread s)\<rbrace>"
   by (rule createObjects_pspace_only, simp)
@@ -4168,34 +4317,150 @@ crunch irq_states' [wp]: createNewCaps valid_irq_states'
 crunch ksMachine[wp]: createObjects "\<lambda>s. P (ksMachineState s)"
   (simp: crunch_simps unless_def)
 
-lemma createNewCaps_valid_queues':
-  "\<lbrace>valid_queues' and pspace_no_overlap' ptr sz
-       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_queues'\<rbrace>"
-  apply (wp valid_queues_lift_asm' [OF createNewCaps_obj_at2])
-  apply (clarsimp)
-  apply (simp add: makeObjectKO_def
-            split: object_type.split_asm
-                   apiobject_type.split_asm)
-  apply (clarsimp simp: inQ_def)
-  apply (auto simp: makeObject_tcb
-             split: object_type.splits apiobject_type.splits)
-  done
-
-lemma createNewCaps_valid_queues:
-  "\<lbrace>valid_queues and pspace_no_overlap' ptr sz
-       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_queues\<rbrace>"
-  apply (rule hoare_gen_asm)
-  apply (wpsimp wp: valid_queues_lift_asm createNewCaps_obj_at2[where sz=sz])
-       apply (simp add: inQ_def)
-      apply (wp createNewCaps_pred_tcb_at'[where sz=sz] | simp)+
+lemma createObjects_valid_bitmaps:
+  "createObjects' ptr n val gbits \<lbrace>valid_bitmaps\<rbrace>"
+  apply (clarsimp simp: createObjects'_def alignError_def split_def)
+  apply (wp case_option_wp[where P="\<lambda>_. P" and P'=P for P, simplified] assert_inv
+         | clarsimp simp del: fun_upd_apply)+
+  apply (clarsimp simp: valid_bitmaps_def valid_bitmapQ_def bitmapQ_def bitmapQ_no_L2_orphans_def
+                        bitmapQ_no_L1_orphans_def)
+  done
+
+lemma valid_bitmaps_gsCNodes_update[simp]:
+  "valid_bitmaps (gsCNodes_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
+
+lemma valid_bitmaps_gsUserPages_update[simp]:
+  "valid_bitmaps (gsUserPages_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
+
+crunches curDomain
+  for valid_bitmaps[wp]: valid_bitmaps
+  and sched_pointers[wp]: "\<lambda>s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)"
+  and valid_sched_pointers[wp]: valid_sched_pointers
+
+lemma createNewCaps_valid_bitmaps:
+  "\<lbrace>\<lambda>s. valid_pspace' s \<and> pspace_no_overlap' ptr sz s \<and> valid_bitmaps s\<rbrace>
+   createNewCaps ty ptr n us dev
+   \<lbrace>\<lambda>_. valid_bitmaps\<rbrace>"
+  unfolding createNewCaps_def
+  apply (clarsimp simp: RISCV64_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 (wpsimp wp: createObjects_valid_bitmaps)
+           by (wpsimp wp: createObjects_valid_bitmaps[simplified o_def] mapM_x_wp
+               | simp add: makeObject_tcb objBits_def createObjects_def
+               | intro conjI impI)+
+
+lemma createObjects_sched_queues:
+  "\<lbrace>\<lambda>s. n \<noteq> 0
+        \<and> range_cover ptr sz (objBitsKO val + gbits) n
+        \<and> P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)
+        \<and> (case val of KOTCB tcb \<Rightarrow> tcbSchedNext tcb = None \<and> tcbSchedPrev tcb = None
+                     | _ \<Rightarrow> True)
+        \<and> pspace_aligned' s \<and> pspace_distinct' s
+        \<and> pspace_no_overlap' ptr sz s\<rbrace>
+   createObjects' ptr n val gbits
+   \<lbrace>\<lambda>_ s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)\<rbrace>"
+  (is "\<lbrace> \<lambda>s. _ \<and> _ \<and> ?Pre s \<rbrace> _ \<lbrace>\<lambda>_. _\<rbrace>")
+proof (rule hoare_grab_asm)+
+  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>_ s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)\<rbrace>"
+  proof -
+    have shiftr_not_zero:" 1 \<le> ((of_nat n)::machine_word) << gbits"
+      using range_cover_not_zero_shift[OF not_0 cover,where gbits = gbits]
+      by (simp add:word_le_sub1)
+    show ?thesis
+      apply (clarsimp simp: createObjects'_def unless_def alignError_def split_def)
+      apply (wp | clarsimp simp del: fun_upd_apply)+
+      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 (clarsimp simp: foldr_upd_app_if)
+      apply (rule_tac a="tcbSchedNexts_of s" and b="tcbSchedPrevs_of s"
+                   in rsubst2[rotated, OF sym sym, where P=P])
+        apply (rule ext)
+        apply (clarsimp simp: opt_map_def)
+        apply (frule (3) retype_ksPSpace_None[simplified mult.commute])
+          apply (fastforce intro: cover)
+         apply fastforce
+        apply (clarsimp split: kernel_object.splits option.splits)
+       apply (rule ext)
+       apply (clarsimp simp: opt_map_def)
+       apply (frule (3) retype_ksPSpace_None[simplified mult.commute])
+         apply (fastforce intro: cover)
+        apply fastforce
+       apply (clarsimp split: kernel_object.splits option.splits)
+      apply simp
+      done
+  qed
+qed
+
+lemma createNewCaps_sched_queues:
+  assumes cover: "range_cover ptr sz (APIType_capBits ty us) n"
+  assumes not_0: "n \<noteq> 0"
+  shows
+    "\<lbrace>\<lambda>s. valid_pspace' s \<and> pspace_no_overlap' ptr sz s
+          \<and> P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)\<rbrace>
+     createNewCaps ty ptr n us dev
+     \<lbrace>\<lambda>_ s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)\<rbrace>"
+  unfolding createNewCaps_def
+  apply (clarsimp simp: RISCV64_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)
+           apply (wpsimp wp: mapM_x_wp' createObjects_sched_queues
+                       simp: curDomain_def)
+           by (wpsimp wp: mapM_x_wp' createObjects_sched_queues[simplified o_def]
+                          threadSet_sched_pointers
+               | simp add: objBitsKO_def APIType_capBits_def valid_pspace'_def makeObject_tcb
+                           objBits_def pageBits_def archObjSize_def createObjects_def
+                           pt_bits_def pte_bits_def word_size_bits_def table_size_def
+                           ptTranslationBits_def
+               | intro conjI impI)+
+
+lemma createObjects_valid_sched_pointers:
+  "\<lbrace>\<lambda>s. valid_sched_pointers s
+        \<and> (case val of KOTCB tcb \<Rightarrow> tcbSchedNext tcb = None \<and> tcbSchedPrev tcb = None
+                     | _ \<Rightarrow> True)\<rbrace>
+   createObjects' ptr n val gbits
+   \<lbrace>\<lambda>_. valid_sched_pointers\<rbrace>"
+  apply (clarsimp simp: createObjects'_def unless_def alignError_def split_def)
+  apply (wp case_option_wp[where P="\<lambda>_. P" and P'=P for P, simplified] assert_inv
+         | clarsimp simp del: fun_upd_apply)+
+  apply (clarsimp simp: valid_sched_pointers_def foldr_upd_app_if opt_pred_def opt_map_def comp_def)
+  apply (cases "tcb_of' val"; clarsimp)
   done
 
+lemma createNewCaps_valid_sched_pointers:
+  "\<lbrace>\<lambda>s. valid_pspace' s \<and> pspace_no_overlap' ptr sz s \<and> valid_sched_pointers s\<rbrace>
+   createNewCaps ty ptr n us dev
+   \<lbrace>\<lambda>_. valid_sched_pointers\<rbrace>"
+  unfolding createNewCaps_def
+  apply (clarsimp simp: RISCV64_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 (wpsimp wp: createObjects_valid_sched_pointers)
+           by (wpsimp wp: createObjects_valid_sched_pointers[simplified o_def] mapM_x_wp
+                          threadSet_valid_sched_pointers
+               | simp add: makeObject_tcb objBits_def createObjects_def
+               | intro conjI impI)+
+
 lemma mapM_x_threadSet_valid_pspace:
   "\<lbrace>valid_pspace' and K (curdom \<le> maxDomain)\<rbrace>
       mapM_x (threadSet (tcbDomain_update (\<lambda>_. curdom))) addrs \<lbrace>\<lambda>y. valid_pspace'\<rbrace>"
@@ -4577,12 +4842,13 @@ proof (rule hoare_gen_asm, elim conjE)
                createNewCaps_valid_arch_state
                valid_irq_node_lift_asm [unfolded pred_conj_def, OF _ createNewCaps_obj_at']
                createNewCaps_irq_handlers' createNewCaps_vms
-               createNewCaps_valid_queues
-               createNewCaps_valid_queues'
                createNewCaps_pred_tcb_at' cnc_ct_not_inQ
                createNewCaps_ct_idle_or_in_cur_domain'
                createNewCaps_sch_act_wf
                createNewCaps_urz[where sz=sz]
+               createNewCaps_sched_queues[OF cover not_0]
+               createNewCaps_valid_sched_pointers
+               createNewCaps_valid_bitmaps
            | simp)+
   using not_0
   apply (clarsimp simp: valid_pspace'_def)
@@ -4655,35 +4921,6 @@ lemma createObjects_sch:
   apply (wp sch_act_wf_lift_asm createObjects_pred_tcb_at' createObjects_orig_obj_at3 | force)+
   done
 
-lemma createObjects_queues:
-  "\<lbrace>\<lambda>s. valid_queues 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. valid_queues\<rbrace>"
-  apply (wpsimp wp: valid_queues_lift_asm [unfolded pred_conj_def, OF createObjects_orig_obj_at3]
-                    createObjects_pred_tcb_at' [unfolded pred_conj_def])
-      apply fastforce
-     apply wp+
-  apply fastforce
-  done
-
-lemma createObjects_queues':
-  assumes no_tcb: "\<And>t. projectKO_opt val \<noteq> Some (t::tcb)"
-  shows
-  "\<lbrace>\<lambda>s. valid_queues' 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. valid_queues'\<rbrace>"
-  apply (simp add: createObjects_def)
-  apply (wp valid_queues_lift_asm')
-    apply (wp createObjects_orig_obj_at2')
-    apply clarsimp
-    apply assumption
-   apply wp
-  using no_tcb
-  apply fastforce
-  done
-
 lemma createObjects_no_cte_ifunsafe':
   assumes no_cte: "\<And>c. projectKO_opt val \<noteq> Some (c::cte)"
   assumes no_tcb: "\<And>t. projectKO_opt val \<noteq> Some (t::tcb)"
@@ -4929,36 +5166,46 @@ proof -
    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 (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'
-             createObjects_queues' [OF no_tcb]
-             assms | simp add: objBits_def )+
+   apply (wp createObjects_no_cte_ifunsafe' assms)
   apply (rule hoare_vcg_conj_lift)
    apply (simp add: createObjects_def)
    apply (wp createObjects_idle')
+   apply (wp irqs_masked_lift createObjects_no_cte_valid_global
+             createObjects_valid_arch createObjects_irq_state
+             createObjects_no_cte_irq_handlers assms
+         | 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'
-             createObjects_queues' [OF no_tcb] assms
+             assms
              createObjects_pspace_domain_valid co_ct_not_inQ
              createObjects_ct_idle_or_in_cur_domain'
              createObjects_untyped_ranges_zero'[OF moKO]
+             createObjects_sched_queues
          | simp)+
   apply clarsimp
   using no_cte no_tcb
   apply ((intro conjI; assumption?); simp add: valid_pspace'_def objBits_def)
   apply (fastforce simp add: split_def split: option.splits)
-  apply (clarsimp simp: invs'_def no_tcb valid_state'_def no_cte  split: option.splits)
+  apply (auto simp: invs'_def no_tcb valid_state'_def no_cte
+             split: option.splits kernel_object.splits)
   done
 qed
 
@@ -4995,7 +5242,7 @@ lemma gcd_corres: "corres (=) \<top> \<top> (gets cur_domain) curDomain"
 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. 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
@@ -5006,7 +5253,7 @@ lemma retype_region2_extra_ext_mapM_x_corres:
     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. tcb_at' t 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)
@@ -5014,8 +5261,10 @@ lemma retype_region2_extra_ext_mapM_x_corres:
             apply (case_tac tcb')
             apply simp
            apply fastforce
-          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
@@ -5048,10 +5297,11 @@ lemma retype_region2_obj_at:
   apply (auto simp: obj_at_def default_object_def is_tcb_def)
   done
 
-lemma createObjects_tcb_at':
+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\<rbrace>
-   createObjects ptr n (KOTCB makeObject) 0 \<lbrace>\<lambda>ptrs s. \<forall>addr\<in>set ptrs. tcb_at' addr 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 project_inject objBitsKO_def objBits_def makeObject_tcb)
   done
@@ -5116,8 +5366,9 @@ lemma corres_retype_region_createNewCaps:
               apply (rule corres_retype[where 'a = tcb],
                      simp_all add: obj_bits_api_def objBits_simps' pageBits_def
                                    APIType_map2_def makeObjectKO_def
-                                   other_objs_default_relation)[1]
+                                   tcb_relation_retype)[1]
               apply (fastforce simp: range_cover_def)
+                apply (simp add: tcb_relation_retype)
              apply (rule corres_split_nor)
                 apply (simp add: APIType_map2_def)
                 apply (rule retype_region2_extra_ext_mapM_x_corres)
@@ -5127,7 +5378,7 @@ lemma corres_retype_region_createNewCaps:
               apply wp
              apply wp
             apply ((wp retype_region2_obj_at | simp add: APIType_map2_def)+)[1]
-           apply ((wp createObjects_tcb_at'[where sz=sz]
+           apply ((wp createObjects_Not_tcbQueued[where sz=sz]
                    | simp add: APIType_map2_def objBits_simps' obj_bits_api_def)+)[1]
           apply simp
          apply simp
diff --git a/proof/refine/RISCV64/Schedule_R.thy b/proof/refine/RISCV64/Schedule_R.thy
index 4b28bcfbaf..8726445b59 100644
--- a/proof/refine/RISCV64/Schedule_R.thy
+++ b/proof/refine/RISCV64/Schedule_R.thy
@@ -15,11 +15,6 @@ declare hoare_weak_lift_imp[wp_split del]
 (* Levity: added (20090713 10:04:12) *)
 declare sts_rel_idle [simp]
 
-lemma invs_no_cicd'_queues:
-  "invs_no_cicd' s \<Longrightarrow> valid_queues s"
-  unfolding invs_no_cicd'_def
-  by simp
-
 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)"
@@ -89,275 +84,259 @@ lemma schedule_choose_new_thread_sched_act_rct[wp]:
   unfolding schedule_choose_new_thread_def
   by wp
 
+\<comment> \<open>This proof shares many similarities with the proof of @{thm tcbSchedEnqueue_corres}\<close>
 lemma tcbSchedAppend_corres:
-  notes trans_state_update'[symmetric, simp del]
-  shows
-  "corres dc (is_etcb_at t and tcb_at t and pspace_aligned and pspace_distinct)
-             (Invariants_H.valid_queues and valid_queues')
-             (tcb_sched_action (tcb_sched_append) t) (tcbSchedAppend t)"
-  apply (rule corres_cross_over_guard[where P'=Q and Q="tcb_at' t and Q" for Q])
-   apply (fastforce simp: tcb_at_cross state_relation_def)
-  apply (simp only: tcbSchedAppend_def tcb_sched_action_def)
-  apply (rule corres_symb_exec_r [OF _ _ threadGet_inv, 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, simp)
-   apply (rule no_fail_pre, wp, simp)
-  apply (case_tac queued)
-   apply (simp add: unless_def when_def)
-   apply (rule corres_no_failI)
-    apply wp+
-   apply (clarsimp simp: in_monad ethread_get_def gets_the_def bind_assoc
-                         assert_opt_def exec_gets is_etcb_at_def get_etcb_def get_tcb_queue_def
-                         set_tcb_queue_def simpler_modify_def)
-
-   apply (subgoal_tac "tcb_sched_append t (ready_queues a (tcb_domain y) (tcb_priority y))
-                       = (ready_queues a (tcb_domain y) (tcb_priority y))")
-    apply (simp add: state_relation_def ready_queues_relation_def)
-   apply (clarsimp simp: tcb_sched_append_def state_relation_def
-                         valid_queues'_def ready_queues_relation_def
-                         ekheap_relation_def etcb_relation_def
-                         obj_at'_def inQ_def project_inject)
-   apply (drule_tac x=t in bspec,clarsimp)
+  "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_append tcb_ptr) (tcbSchedAppend 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_append_def get_tcb_queue_def
+                        tcbSchedAppend_def getQueue_def unless_def when_def)
+  apply (rule corres_symb_exec_l[OF _ _ ethread_get_sp]; (solves wpsimp)?)
+  apply (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]; 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)
+   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 (clarsimp simp: unless_def when_def cong: if_cong)
-  apply (rule stronger_corres_guard_imp)
-    apply (rule corres_split[where r'="(=)"])
-       apply (rule ethreadget_corres)
-       apply (simp add: etcb_relation_def)
-      apply (rule corres_split[where r'="(=)"])
-         apply (rule ethreadget_corres)
-         apply (simp add: etcb_relation_def)
-        apply (rule corres_split[where r'="(=)"])
-           apply simp
-           apply (rule getQueue_corres)
-          apply (rule corres_split_noop_rhs2)
-             apply (simp add: tcb_sched_append_def)
-             apply (intro conjI impI)
-              apply (rule corres_guard_imp)
-                apply (rule setQueue_corres)
-               prefer 3
-               apply (rule_tac P=\<top> and Q="K (t \<notin> set queuea)" in corres_assume_pre)
-               apply simp
-              apply simp
-             apply simp
-            apply (rule corres_split_noop_rhs2)
-               apply (rule addToBitmap_if_null_noop_corres)
-              apply (rule threadSet_corres_noop, simp_all add: tcb_relation_def exst_same_def)[1]
-             apply wp+
-          apply (wp getObject_tcb_wp | simp add: threadGet_def)+
-  apply (fastforce simp: valid_queues_def valid_queues_no_bitmap_def obj_at'_def inQ_def
-                         project_inject)
-  done
+  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)?)
 
+  \<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'])
 
-crunches tcbSchedEnqueue, tcbSchedAppend, tcbSchedDequeue
-  for valid_pspace'[wp]: valid_pspace'
-  and valid_arch_state'[wp]: valid_arch_state'
-  (simp: unless_def)
+     apply wpsimp
+    apply (wpsimp wp: hoare_vcg_if_lift hoare_vcg_ex_lift)
+   apply (corres corres: addToBitmap_if_null_noop_corres)
+
+  apply (rule corres_from_valid_det)
+    apply (fastforce intro: det_wp_modify det_wp_pre simp: set_tcb_queue_def)
+   apply (wpsimp simp: tcbQueueAppend_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'_tcbQueueEnd_ksReadyQueues simp: obj_at'_def)
+
+  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 simp: setQueue_def tcbQueueAppend_def)
+  apply normalise_obj_at'
+  apply (frule (1) tcb_at_is_etcb_at)
+  apply (clarsimp simp: obj_at_def is_etcb_at_def etcb_at_def)
+  apply (rename_tac s d p s' tcb' tcb etcb)
+  apply (frule_tac t=tcbPtr in ekheap_relation_tcb_domain_priority)
+    apply (force simp: obj_at_def)
+   apply (force simp: obj_at'_def)
+  apply (clarsimp split: if_splits)
+  apply (cut_tac ts="ready_queues s d p" in list_queue_relation_nil)
+   apply (force dest!: spec simp: list_queue_relation_def)
+  apply (cut_tac ts="ready_queues s (tcb_domain etcb) (tcb_priority etcb)"
+              in obj_at'_tcbQueueEnd_ksReadyQueues)
+      apply fast
+     apply fast
+    apply fastforce
+   apply fastforce
+  apply (cut_tac xs="ready_queues s d p" in heap_path_head')
+   apply (force dest!: spec simp: list_queue_relation_def)
+  apply (clarsimp simp: list_queue_relation_def)
+
+  apply (case_tac "d \<noteq> tcb_domain etcb \<or> p \<noteq> tcb_priority etcb")
+   apply (cut_tac d=d and d'="tcb_domain etcb" and p=p and p'="tcb_priority etcb"
+               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)
+    apply (metis inQ_def option.simps(5) tcb_of'_TCB)
+   apply (intro conjI impI; clarsimp)
+
+    \<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 (tcbQueueEnd (ksReadyQueues s' (tcb_domain etcb, tcb_priority etcb)))
+                    \<notin> set (ready_queues s d p)")
+    apply (erule orthD2)
+    apply (drule_tac x="tcb_domain etcb" in spec)
+    apply (drule_tac x="tcb_priority etcb" in spec)
+    apply clarsimp
+    apply (drule_tac x="the (tcbQueueEnd (ksReadyQueues s' (tcb_domain etcb, tcb_priority etcb)))"
+                 in spec)
+    subgoal by (auto simp: in_opt_pred opt_map_red)
+   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";
+              clarsimp 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 split: if_splits)
+     apply (case_tac "t = the (tcbQueueEnd (ksReadyQueues s' (tcb_domain etcb, tcb_priority etcb)))")
+      apply (clarsimp simp: inQ_def opt_pred_def fun_upd_apply)
+     apply (clarsimp simp: inQ_def in_opt_pred opt_map_def fun_upd_apply)
+    apply (clarsimp simp: fun_upd_apply split: if_splits)
+   apply (clarsimp simp: fun_upd_apply split: if_splits)
+
+  \<comment> \<open>d = tcb_domain tcb \<and> p = tcb_priority tcb\<close>
+  apply clarsimp
+  apply (drule_tac x="tcb_domain etcb" in spec)
+  apply (drule_tac x="tcb_priority etcb" in spec)
+  apply (cut_tac ts="ready_queues s (tcb_domain etcb) (tcb_priority etcb)"
+              in tcbQueueHead_iff_tcbQueueEnd)
+   apply (force simp: list_queue_relation_def)
+  apply (frule valid_tcbs'_maxDomain[where t=tcbPtr], simp add: obj_at'_def)
+  apply (frule valid_tcbs'_maxPriority[where t=tcbPtr], simp add: obj_at'_def)
+  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)
+  apply (intro conjI; clarsimp)
+
+   \<comment> \<open>the ready queue was originally empty\<close>
+   apply (force simp: inQ_def in_opt_pred fun_upd_apply opt_map_def obj_at'_def
+                      queue_end_valid_def prev_queue_head_def
+               split: if_splits option.splits)
+
+   \<comment> \<open>the ready queue was not originally empty\<close>
+  apply (drule (2) heap_ls_append[where new=tcbPtr])
+  apply (rule conjI)
+   apply (clarsimp simp: fun_upd_apply queue_end_valid_def opt_map_def split: if_splits)
+  apply (rule conjI)
+   apply (clarsimp simp: fun_upd_apply queue_end_valid_def)
+  apply (rule conjI)
+   apply (subst opt_map_upd_triv)
+    apply (clarsimp simp: opt_map_def fun_upd_apply queue_end_valid_def split: if_splits)
+   apply (clarsimp simp: prev_queue_head_def fun_upd_apply split: if_splits)
+  by (clarsimp simp: inQ_def in_opt_pred fun_upd_apply queue_end_valid_def split: if_splits)
+
+lemma tcbQueueAppend_valid_objs'[wp]:
+  "\<lbrace>\<lambda>s. valid_objs' s \<and> tcb_at' tcbPtr s \<and> (\<forall>end. tcbQueueEnd queue = Some end \<longrightarrow> tcb_at' end s)\<rbrace>
+   tcbQueueAppend queue tcbPtr
+   \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
+  unfolding tcbQueueAppend_def
+  apply (wpsimp wp: hoare_vcg_if_lift2 hoare_vcg_imp_lift')
+  apply (clarsimp simp: tcbQueueEmpty_def valid_bound_tcb'_def split: option.splits)
+  done
+
+lemma tcbSchedAppend_valid_objs'[wp]:
+  "\<lbrace>valid_objs' and pspace_aligned' and pspace_distinct'\<rbrace>
+   tcbSchedAppend tcbPtr
+   \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
+  apply (clarsimp simp: tcbSchedAppend_def setQueue_def)
+  apply (wpsimp wp: threadSet_valid_objs' threadGet_wp hoare_vcg_all_lift)
+  apply (normalise_obj_at', rename_tac tcb "end")
+  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
+  apply (frule tcbQueueHead_iff_tcbQueueEnd)
+  apply (force dest!: obj_at'_tcbQueueEnd_ksReadyQueues simp: tcbQueueEmpty_def obj_at'_def)
+  done
 
 crunches tcbSchedAppend, tcbSchedDequeue
   for pred_tcb_at'[wp]: "pred_tcb_at' proj P t"
   (wp: threadSet_pred_tcb_no_state simp: unless_def tcb_to_itcb'_def)
 
-lemma removeFromBitmap_valid_queues_no_bitmap_except[wp]:
-  "\<lbrace> valid_queues_no_bitmap_except t \<rbrace>
-   removeFromBitmap d p
-   \<lbrace>\<lambda>_. valid_queues_no_bitmap_except t \<rbrace>"
-  unfolding bitmapQ_defs valid_queues_no_bitmap_except_def
-  by (wp| clarsimp simp: bitmap_fun_defs)+
-
-lemma removeFromBitmap_bitmapQ:
-  "\<lbrace> \<lambda>s. True \<rbrace> removeFromBitmap d p \<lbrace>\<lambda>_ s. \<not> bitmapQ d p s \<rbrace>"
-  unfolding bitmapQ_defs bitmap_fun_defs
-  by (wp| clarsimp simp: bitmap_fun_defs)+
-
-lemma removeFromBitmap_valid_bitmapQ[wp]:
-" \<lbrace> valid_bitmapQ_except d p and bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans and
-    (\<lambda>s. ksReadyQueues s (d,p) = []) \<rbrace>
-     removeFromBitmap d p
-  \<lbrace>\<lambda>_. valid_bitmapQ \<rbrace>"
-proof -
-  have "\<lbrace> valid_bitmapQ_except d p and bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans and
-            (\<lambda>s. ksReadyQueues s (d,p) = []) \<rbrace>
-         removeFromBitmap d p
-         \<lbrace>\<lambda>_. valid_bitmapQ_except d p and  bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans and
-              (\<lambda>s. \<not> bitmapQ d p s \<and> ksReadyQueues s (d,p) = []) \<rbrace>"
-    by (rule hoare_pre)
-       (wp removeFromBitmap_valid_queues_no_bitmap_except removeFromBitmap_valid_bitmapQ_except
-           removeFromBitmap_bitmapQ, simp)
-  thus ?thesis
-    by - (erule hoare_strengthen_post; fastforce elim: valid_bitmap_valid_bitmapQ_exceptE)
-qed
-
-(* this should be the actual weakest precondition to establish valid_queues
-   under tagging a thread as not queued *)
-lemma threadSet_valid_queues_dequeue_wp:
- "\<lbrace> valid_queues_no_bitmap_except t and
-        valid_bitmapQ and bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans and
-        (\<lambda>s. \<forall>d p. t \<notin> set (ksReadyQueues s (d,p))) \<rbrace>
-          threadSet (tcbQueued_update (\<lambda>_. False)) t
-       \<lbrace>\<lambda>rv. valid_queues \<rbrace>"
-  unfolding threadSet_def
-  apply (rule hoare_seq_ext[OF _ getObject_tcb_sp])
-  apply (rule hoare_pre)
-   apply (simp add: valid_queues_def valid_queues_no_bitmap_except_def valid_queues_no_bitmap_def)
-   apply (wp setObject_queues_unchanged_tcb hoare_Ball_helper hoare_vcg_all_lift
-             setObject_tcb_strongest)
-  apply (clarsimp simp: valid_queues_no_bitmap_except_def obj_at'_def valid_queues_no_bitmap_def)
-  done
-
 (* FIXME move *)
 lemmas obj_at'_conjI = obj_at_conj'
 
-lemma setQueue_valid_queues_no_bitmap_except_dequeue_wp:
-  "\<And>d p ts t.
-   \<lbrace> \<lambda>s. valid_queues_no_bitmap_except t s \<and>
-         (\<forall>t' \<in> set ts. obj_at' (inQ d p and runnable' \<circ> tcbState) t' s) \<and>
-         t \<notin> set ts \<and> distinct ts \<and> p \<le> maxPriority \<and> d \<le> maxDomain \<rbrace>
-       setQueue d p ts
-   \<lbrace>\<lambda>rv. valid_queues_no_bitmap_except t \<rbrace>"
-  unfolding setQueue_def valid_queues_no_bitmap_except_def null_def
-  by wp force
-
-definition (* if t is in a queue, it should be tagged with right priority and domain *)
-  "correct_queue t s \<equiv> \<forall>d p. t \<in> set(ksReadyQueues s (d, p)) \<longrightarrow>
-             (obj_at' (\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d \<and> tcbPriority tcb = p) t s)"
-
-lemma valid_queues_no_bitmap_correct_queueI[intro]:
-  "valid_queues_no_bitmap s \<Longrightarrow> correct_queue t s"
-  unfolding correct_queue_def valid_queues_no_bitmap_def
-  by (fastforce simp: obj_at'_def inQ_def)
-
-
-lemma tcbSchedDequeue_valid_queues_weak:
-  "\<lbrace> valid_queues_no_bitmap_except t and valid_bitmapQ and
-     bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans and
-     correct_queue t and
-     obj_at' (\<lambda>tcb. tcbDomain tcb \<le> maxDomain \<and> tcbPriority tcb \<le> maxPriority) t \<rbrace>
-   tcbSchedDequeue t
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-proof -
-  show ?thesis
-  unfolding tcbSchedDequeue_def null_def valid_queues_def
-  apply wp (* stops on threadSet *)
-          apply (rule hoare_post_eq[OF _ threadSet_valid_queues_dequeue_wp],
-                 simp add: valid_queues_def)
-         apply (wp hoare_vcg_if_lift hoare_vcg_conj_lift hoare_vcg_imp_lift)+
-             apply (wp hoare_vcg_imp_lift setQueue_valid_queues_no_bitmap_except_dequeue_wp
-                       setQueue_valid_bitmapQ threadGet_const_tcb_at hoare_vcg_if_lift)+
-  (* wp done *)
-  apply (normalise_obj_at')
-  apply (clarsimp simp: correct_queue_def)
-  apply (normalise_obj_at')
-  apply (fastforce simp add: valid_queues_no_bitmap_except_def valid_queues_no_bitmap_def elim: obj_at'_weaken)+
-  done
-qed
-
-lemma tcbSchedDequeue_valid_queues:
-  "\<lbrace>Invariants_H.valid_queues
-    and obj_at' (\<lambda>tcb. tcbDomain tcb \<le> maxDomain) t
-    and obj_at' (\<lambda>tcb. tcbPriority tcb \<le> maxPriority) t\<rbrace>
-     tcbSchedDequeue t
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (rule hoare_pre, rule tcbSchedDequeue_valid_queues_weak)
-  apply (fastforce simp: valid_queues_def valid_queues_no_bitmap_def obj_at'_def inQ_def)
-  done
-
-lemma tcbSchedAppend_valid_queues'[wp]:
-  (* most of this is identical to tcbSchedEnqueue_valid_queues' in TcbAcc_R *)
-  "\<lbrace>valid_queues' and tcb_at' t\<rbrace> tcbSchedAppend t \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp add: tcbSchedAppend_def)
-  apply (rule hoare_pre)
-   apply (rule_tac B="\<lambda>rv. valid_queues' and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"
-           in hoare_seq_ext)
-    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 inQ_def)
-       apply (wp setQueue_valid_queues' | simp | simp add: setQueue_def)+
-     apply (wp getObject_tcb_wp | simp add: threadGet_def)+
-     apply (clarsimp simp: obj_at'_def inQ_def valid_queues'_def)
-    apply (wp getObject_tcb_wp | simp add: threadGet_def)+
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-lemma threadSet_valid_queues'_dequeue: (* threadSet_valid_queues' is too weak for dequeue *)
-  "\<lbrace>\<lambda>s. (\<forall>d p t'. obj_at' (inQ d p) t' s \<and> t' \<noteq> t \<longrightarrow> t' \<in> set (ksReadyQueues s (d, p))) \<and>
-        obj_at' (inQ d p) t s \<rbrace>
-   threadSet (tcbQueued_update (\<lambda>_. False)) t
-   \<lbrace>\<lambda>rv. valid_queues' \<rbrace>"
-   unfolding valid_queues'_def
-   apply (rule hoare_pre)
-    apply (wp hoare_vcg_all_lift)
-    apply (simp only: imp_conv_disj not_obj_at')
-   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-   apply (simp add: not_obj_at')
-   apply (clarsimp simp: typ_at_tcb')
-   apply normalise_obj_at'
-   apply (fastforce elim: obj_at'_weaken simp: inQ_def)
-   done
-
-lemma setQueue_ksReadyQueues_lift:
-  "\<lbrace> \<lambda>s. P (s\<lparr>ksReadyQueues := (ksReadyQueues s)((d, p) := ts)\<rparr>) ts \<rbrace>
-   setQueue d p ts
-   \<lbrace> \<lambda>_ s. P s (ksReadyQueues s (d,p))\<rbrace>"
-  unfolding setQueue_def
-  by (wp, clarsimp simp: fun_upd_def cong: if_cong)
-
-lemma tcbSchedDequeue_valid_queues'[wp]:
-  "\<lbrace>valid_queues' and tcb_at' t\<rbrace>
-    tcbSchedDequeue t \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  unfolding tcbSchedDequeue_def
-  apply (rule_tac B="\<lambda>rv. valid_queues' and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"
-                in hoare_seq_ext)
-   prefer 2
-   apply (wp threadGet_const_tcb_at)
-   apply (fastforce simp: obj_at'_def)
-  apply clarsimp
-  apply (rename_tac queued)
-  apply (case_tac queued, simp_all)
-   apply wp
-        apply (rule_tac d=tdom and p=prio in threadSet_valid_queues'_dequeue)
-       apply (rule hoare_pre_post, assumption)
-       apply (wp | clarsimp simp: bitmap_fun_defs)+
-      apply (wp hoare_vcg_all_lift setQueue_ksReadyQueues_lift)
-     apply clarsimp
-     apply (wp threadGet_obj_at' threadGet_const_tcb_at)+
-   apply clarsimp
-   apply (rule context_conjI, clarsimp simp: obj_at'_def)
-   apply (clarsimp simp: valid_queues'_def obj_at'_def inQ_def|wp)+
-  done
+crunches tcbSchedAppend, tcbSchedDequeue, tcbSchedEnqueue
+  for tcb_at'[wp]: "tcb_at' t"
+  and cap_to'[wp]: "ex_nonz_cap_to' p"
+  and ifunsafe'[wp]: if_unsafe_then_cap'
+  (wp: crunch_wps simp: crunch_simps)
 
 lemma tcbSchedAppend_iflive'[wp]:
-  "\<lbrace>if_live_then_nonz_cap' and ex_nonz_cap_to' tcb\<rbrace>
-    tcbSchedAppend tcb \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
-  apply (simp add: tcbSchedAppend_def unless_def)
-  apply (wp threadSet_iflive' hoare_drop_imps | simp add: crunch_simps)+
+  "\<lbrace>if_live_then_nonz_cap' and pspace_aligned' and pspace_distinct'\<rbrace>
+   tcbSchedAppend tcbPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  unfolding tcbSchedAppend_def
+  apply (wpsimp wp: tcbQueueAppend_if_live_then_nonz_cap' threadGet_wp simp: bitmap_fun_defs)
+  apply (frule_tac p=tcbPtr in if_live_then_nonz_capE')
+   apply (fastforce simp: ko_wp_at'_def st_tcb_at'_def obj_at'_def runnable_eq_active')
+  apply (clarsimp simp: tcbQueueEmpty_def)
+  apply (erule if_live_then_nonz_capE')
+  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 (fastforce dest!: obj_at'_tcbQueueEnd_ksReadyQueues
+                    simp: ko_wp_at'_def inQ_def obj_at'_def tcbQueueEmpty_def)
   done
 
 lemma tcbSchedDequeue_iflive'[wp]:
-  "\<lbrace>if_live_then_nonz_cap'\<rbrace> tcbSchedDequeue tcb \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  "\<lbrace>if_live_then_nonz_cap' and valid_objs' and sym_heap_sched_pointers\<rbrace>
+   tcbSchedDequeue tcbPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
   apply (simp add: tcbSchedDequeue_def)
-  apply (wp threadSet_iflive' hoare_when_weak_wp | simp add: crunch_simps)+
-       apply ((wp | clarsimp simp: bitmap_fun_defs)+)[1] (* deal with removeFromBitmap *)
-      apply (wp threadSet_iflive' hoare_when_weak_wp | simp add: crunch_simps)+
-      apply (rule_tac Q="\<lambda>rv. \<top>" in hoare_post_imp, fastforce)
-      apply (wp | simp add: crunch_simps)+
+  apply (wpsimp wp: tcbQueueRemove_if_live_then_nonz_cap' threadGet_wp)
+  apply (fastforce elim: if_live_then_nonz_capE' simp: obj_at'_def ko_wp_at'_def)
   done
 
 crunches tcbSchedAppend, tcbSchedDequeue, tcbSchedEnqueue
@@ -403,19 +382,87 @@ lemma ct_idle_or_in_cur_domain'_lift2:
   apply simp+
   done
 
+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>"
+  apply (wpsimp wp: setObject_tcb_mdb' getTCB_wp simp: threadSet_def obj_at'_def)
+  apply fastforce
+  done
+
+lemma tcbSchedNext_update_valid_mdb'[wp]:
+  "\<lbrace>valid_mdb' and tcb_at' tcbPtr\<rbrace> threadSet (tcbSchedNext_update f) tcbPtr \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  apply (wpsimp wp: threadSet_mdb')
+  apply (fastforce simp: obj_at'_def valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)
+  done
+
+lemma tcbSchedPrev_update_valid_mdb'[wp]:
+  "\<lbrace>valid_mdb' and tcb_at' tcbPtr\<rbrace> threadSet (tcbSchedPrev_update f) tcbPtr \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  apply (wpsimp wp: threadSet_mdb')
+  apply (fastforce simp: obj_at'_def valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)
+  done
+
+lemma tcbQueueRemove_valid_mdb':
+  "\<lbrace>\<lambda>s. valid_mdb' s \<and> valid_objs' s\<rbrace> tcbQueueRemove q tcbPtr \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  unfolding tcbQueueRemove_def
+  apply (wpsimp wp: getTCB_wp)
+  apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+  apply (fastforce simp: valid_tcb'_def obj_at'_def)
+  done
+
+lemma tcbQueuePrepend_valid_mdb':
+  "\<lbrace>valid_mdb' and tcb_at' tcbPtr
+    and (\<lambda>s. \<not> tcbQueueEmpty queue \<longrightarrow> tcb_at' (the (tcbQueueHead queue)) s)\<rbrace>
+   tcbQueuePrepend queue tcbPtr
+   \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  unfolding tcbQueuePrepend_def
+  by (wpsimp wp: hoare_vcg_if_lift2 hoare_vcg_imp_lift')
+
+lemma tcbQueueAppend_valid_mdb':
+  "\<lbrace>\<lambda>s. valid_mdb' s \<and> tcb_at' tcbPtr s
+        \<and> (\<not> tcbQueueEmpty queue \<longrightarrow> tcb_at' (the (tcbQueueEnd queue)) s)\<rbrace>
+   tcbQueueAppend queue tcbPtr
+   \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  unfolding tcbQueueAppend_def
+  by (wpsimp wp: hoare_vcg_if_lift2 hoare_vcg_imp_lift')
+
+lemma tcbQueued_update_valid_mdb'[wp]:
+  "\<lbrace>valid_mdb' and tcb_at' tcbPtr\<rbrace> threadSet (tcbQueued_update f) tcbPtr \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  apply (wpsimp wp: threadSet_mdb')
+  apply (fastforce simp: obj_at'_def valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)
+  done
+
+lemma valid_mdb'_ksReadyQueuesL1Bitmap_update[simp]:
+  "valid_mdb' (ksReadyQueuesL1Bitmap_update f s) = valid_mdb' s"
+  by (simp add: valid_mdb'_def)
+
+lemma valid_mdb'_ksReadyQueuesL2Bitmap_update[simp]:
+  "valid_mdb' (ksReadyQueuesL2Bitmap_update f s) = valid_mdb' s"
+  by (simp add: valid_mdb'_def)
+
+lemma tcbSchedEnqueue_valid_mdb'[wp]:
+  "\<lbrace>valid_mdb' and valid_objs' and pspace_aligned' and pspace_distinct'\<rbrace>
+   tcbSchedEnqueue tcbPtr
+   \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  apply (clarsimp simp: tcbSchedEnqueue_def setQueue_def)
+  apply (wpsimp wp: tcbQueuePrepend_valid_mdb' threadGet_wp simp: bitmap_fun_defs)
+  apply normalise_obj_at'
+  apply (fastforce dest!: obj_at'_tcbQueueHead_ksReadyQueues
+                    simp: ready_queue_relation_def ksReadyQueues_asrt_def obj_at'_def)
+  done
+
+crunches tcbSchedEnqueue
+  for cur_tcb'[wp]: cur_tcb'
+  (wp: threadSet_cur)
+
 lemma tcbSchedEnqueue_invs'[wp]:
-  "\<lbrace>invs'
-    and st_tcb_at' runnable' t
-    and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t)\<rbrace>
-     tcbSchedEnqueue t
+  "\<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_state'_def)
-  apply (rule hoare_pre)
-   apply (wp tcbSchedEnqueue_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 tcbSchedEnqueue_ct_not_inQ
+              simp: cteCaps_of_def o_def)
   done
 
 crunch ksMachine[wp]: tcbSchedAppend "\<lambda>s. P (ksMachineState s)"
@@ -424,7 +471,7 @@ crunch ksMachine[wp]: tcbSchedAppend "\<lambda>s. P (ksMachineState s)"
 lemma tcbSchedAppend_vms'[wp]:
   "\<lbrace>valid_machine_state'\<rbrace> tcbSchedAppend t \<lbrace>\<lambda>_. valid_machine_state'\<rbrace>"
   apply (simp add: valid_machine_state'_def pointerInUserData_def pointerInDeviceData_def)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift tcbSchedAppend_ksMachine)
+  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
   done
 
 crunch pspace_domain_valid[wp]: tcbSchedAppend "pspace_domain_valid"
@@ -439,21 +486,27 @@ crunch ksIdleThread[wp]: tcbSchedAppend "\<lambda>s. P (ksIdleThread s)"
 crunch ksDomSchedule[wp]: tcbSchedAppend "\<lambda>s. P (ksDomSchedule s)"
 (simp: unless_def)
 
+lemma tcbQueueAppend_tcbPriority_obj_at'[wp]:
+  "tcbQueueAppend queue tptr \<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
+  unfolding tcbQueueAppend_def
+  apply (wpsimp wp: threadSet_wp)
+  by (auto simp: obj_at'_def objBits_simps ps_clear_def split: if_splits)
+
+lemma tcbQueueAppend_tcbDomain_obj_at'[wp]:
+  "tcbQueueAppend queue tptr \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  unfolding tcbQueueAppend_def
+  apply (wpsimp wp: threadSet_wp)
+  by (auto simp: obj_at'_def objBits_simps ps_clear_def split: if_splits)
+
 lemma tcbSchedAppend_tcbDomain[wp]:
-  "\<lbrace> obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t' \<rbrace>
-     tcbSchedAppend t
-   \<lbrace> \<lambda>_. obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t' \<rbrace>"
+  "tcbSchedAppend t \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
   apply (clarsimp simp: tcbSchedAppend_def)
-  apply (wpsimp simp: unless_def)+
-  done
+  by wpsimp
 
 lemma tcbSchedAppend_tcbPriority[wp]:
-  "\<lbrace> obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t' \<rbrace>
-     tcbSchedAppend t
-   \<lbrace> \<lambda>_. obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t' \<rbrace>"
+  "tcbSchedAppend t \<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
   apply (clarsimp simp: tcbSchedAppend_def)
-  apply (wpsimp simp: unless_def)+
-  done
+  by wpsimp
 
 lemma tcbSchedAppend_tcb_in_cur_domain'[wp]:
   "\<lbrace>tcb_in_cur_domain' t'\<rbrace> tcbSchedAppend t \<lbrace>\<lambda>_. tcb_in_cur_domain' t' \<rbrace>"
@@ -472,28 +525,59 @@ crunches tcbSchedDequeue, tcbSchedAppend
   for arch'[wp]: "\<lambda>s. P (ksArchState s)"
 
 lemma tcbSchedAppend_sch_act_wf[wp]:
-  "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace> tcbSchedAppend thread
-  \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  apply (simp add:tcbSchedAppend_def bitmap_fun_defs)
-  apply (wp unless_wp setQueue_sch_act threadGet_wp|simp)+
-  apply (fastforce simp:typ_at'_def obj_at'_def)
+  "tcbSchedAppend thread \<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
+  by (wpsimp wp: sch_act_wf_lift)
+
+lemma tcbSchedAppend_valid_bitmapQ[wp]:
+  "\<lbrace>valid_bitmaps\<rbrace> tcbSchedAppend tcbPtr \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
+  supply if_split[split del]
+  unfolding tcbSchedAppend_def
+  apply (wpsimp simp: tcbQueueAppend_def
+                  wp: setQueue_valid_bitmapQ' addToBitmap_valid_bitmapQ_except addToBitmap_bitmapQ
+                      threadGet_wp hoare_vcg_if_lift2)
+  apply (clarsimp simp: ksReadyQueues_asrt_def split: if_splits)
+  apply normalise_obj_at'
+  apply (force dest: tcbQueueHead_iff_tcbQueueEnd
+               simp: valid_bitmaps_def valid_bitmapQ_def tcbQueueEmpty_def)
+  done
+
+lemma tcbSchedAppend_valid_mdb'[wp]:
+  "\<lbrace>valid_mdb' and valid_tcbs' and pspace_aligned' and pspace_distinct'\<rbrace>
+   tcbSchedAppend tcbPtr
+   \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  apply (clarsimp simp: tcbSchedAppend_def setQueue_def)
+  apply (wpsimp wp: tcbQueueAppend_valid_mdb' threadGet_wp simp: bitmap_fun_defs)
+  apply (fastforce dest: obj_at'_tcbQueueEnd_ksReadyQueues
+                   simp: ready_queue_relation_def ksReadyQueues_asrt_def obj_at'_def)
+  done
+
+lemma tcbSchedAppend_valid_bitmaps[wp]:
+  "tcbSchedAppend tcbPtr \<lbrace>valid_bitmaps\<rbrace>"
+  unfolding valid_bitmaps_def
+  apply wpsimp
+  apply (clarsimp simp: valid_bitmaps_def)
   done
 
 lemma tcbSchedAppend_invs'[wp]:
-  "\<lbrace>invs'
-    and st_tcb_at' runnable' t
-    and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t)\<rbrace>
-     tcbSchedAppend t
+  "\<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_state'_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:
@@ -522,7 +606,7 @@ crunch ksMachine[wp]: tcbSchedDequeue "\<lambda>s. P (ksMachineState s)"
 lemma tcbSchedDequeue_vms'[wp]:
   "\<lbrace>valid_machine_state'\<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>_. valid_machine_state'\<rbrace>"
   apply (simp add: valid_machine_state'_def pointerInUserData_def pointerInDeviceData_def)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift tcbSchedDequeue_ksMachine)
+  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
   done
 
 crunch pspace_domain_valid[wp]: tcbSchedDequeue "pspace_domain_valid"
@@ -540,46 +624,89 @@ lemma tcbSchedDequeue_tcb_in_cur_domain'[wp]:
   "\<lbrace>tcb_in_cur_domain' t'\<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>_. tcb_in_cur_domain' t' \<rbrace>"
   apply (rule tcb_in_cur_domain'_lift)
    apply wp
-  apply (clarsimp simp: tcbSchedDequeue_def)
-  apply (wp hoare_when_weak_wp | simp)+
-  done
-
-lemma tcbSchedDequeue_tcbDomain[wp]:
-  "\<lbrace> obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t' \<rbrace>
-     tcbSchedDequeue t
-   \<lbrace> \<lambda>_. obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t' \<rbrace>"
-  apply (clarsimp simp: tcbSchedDequeue_def)
-  apply (wp hoare_when_weak_wp | simp)+
-  done
-
-lemma tcbSchedDequeue_tcbPriority[wp]:
-  "\<lbrace> obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t' \<rbrace>
-     tcbSchedDequeue t
-   \<lbrace> \<lambda>_. obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t' \<rbrace>"
-  apply (clarsimp simp: tcbSchedDequeue_def)
-  apply (wp hoare_when_weak_wp | simp)+
+  apply (clarsimp simp: tcbSchedDequeue_def tcbQueueRemove_def)
+  apply (wpsimp wp: hoare_when_weak_wp getObject_tcb_wp threadGet_wp)
   done
 
 crunch ksDomScheduleIdx[wp]: tcbSchedDequeue "\<lambda>s. P (ksDomScheduleIdx s)"
   (simp: unless_def)
 
+lemma tcbSchedDequeue_valid_mdb'[wp]:
+  "\<lbrace>valid_mdb' and valid_objs'\<rbrace> tcbSchedDequeue tcbPtr \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  unfolding tcbSchedDequeue_def
+  apply (wpsimp simp: bitmap_fun_defs setQueue_def wp: threadSet_mdb' tcbQueueRemove_valid_mdb')
+      apply (rule_tac Q="\<lambda>_. tcb_at' tcbPtr" in hoare_post_imp)
+       apply (fastforce simp: tcb_cte_cases_def cteSizeBits_def)
+      apply (wpsimp wp: threadGet_wp)+
+  apply (fastforce simp: obj_at'_def)
+  done
+
 lemma tcbSchedDequeue_invs'[wp]:
-  "\<lbrace>invs' and tcb_at' t\<rbrace>
-     tcbSchedDequeue t
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  unfolding invs'_def valid_state'_def
-  apply (rule hoare_pre)
-   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
-             tcbSchedDequeue_valid_queues
-             untyped_ranges_zero_lift
-        | simp add: cteCaps_of_def o_def)+
-  apply (fastforce elim: valid_objs'_maxDomain valid_objs'_maxPriority simp: valid_pspace'_def)+
+  "tcbSchedDequeue t \<lbrace>invs'\<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 ct_idle_or_in_cur_domain'_lift2 cur_tcb_lift
+              simp: cteCaps_of_def o_def)
+  done
+
+lemma ready_qs_runnable_cross:
+  "\<lbrakk>(s, s') \<in> state_relation; pspace_aligned s; pspace_distinct s; valid_queues s\<rbrakk>
+   \<Longrightarrow> ready_qs_runnable s'"
+  apply (clarsimp simp: ready_qs_runnable_def)
+  apply normalise_obj_at'
+  apply (frule state_relation_ready_queues_relation)
+  apply (clarsimp simp: ready_queues_relation_def ready_queue_relation_def Let_def
+                        list_queue_relation_def)
+  apply (drule_tac x="tcbDomain ko" in spec)
+  apply (drule_tac x="tcbPriority ko" in spec)
+  apply (clarsimp simp: valid_queues_def)
+  apply (drule_tac x="tcbDomain ko" in spec)
+  apply (drule_tac x="tcbPriority ko" in spec)
+  apply clarsimp
+  apply (drule_tac x=t in bspec)
+   apply (fastforce simp: inQ_def in_opt_pred obj_at'_def opt_map_red)
+  apply (fastforce dest: st_tcb_at_runnable_cross simp: obj_at'_def st_tcb_at'_def)
+  done
+
+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_queues)?, (frule invs_psp_aligned)?, (frule invs_distinct)?,
+  fastforce dest: ready_qs_runnable_cross
+
+defs idleThreadNotQueued_def:
+  "idleThreadNotQueued s \<equiv> obj_at' (Not \<circ> tcbQueued) (ksIdleThread s) s"
+
+lemma idle_thread_not_queued:
+  "\<lbrakk>valid_idle s; valid_queues s; valid_etcbs s\<rbrakk>
+   \<Longrightarrow> \<not> (\<exists>d p. idle_thread s \<in> set (ready_queues s d p))"
+  apply (clarsimp simp: valid_queues_def)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply clarsimp
+  apply (drule_tac x="idle_thread s" in bspec)
+   apply fastforce
+  apply (clarsimp simp: valid_idle_def pred_tcb_at_def obj_at_def valid_etcbs_def)
   done
 
+lemma valid_idle_tcb_at:
+  "valid_idle s \<Longrightarrow> tcb_at (idle_thread s) s"
+  by (clarsimp simp: valid_idle_def pred_tcb_at_def obj_at_def is_tcb_def)
+
 lemma setCurThread_corres:
-  "corres dc \<top> \<top> (modify (cur_thread_update (\<lambda>_. t))) (setCurThread t)"
-  apply (unfold setCurThread_def)
+  "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 opt_pred_def opt_map_def)
   apply (rule corres_modify)
   apply (simp add: state_relation_def swp_def)
   done
@@ -606,49 +733,58 @@ qed
 crunches storeWordUser, setVMRoot, asUser, storeWordUser, Arch.switchToThread
   for ksQ[wp]: "\<lambda>s. P (ksReadyQueues s p)"
   and ksIdleThread[wp]: "\<lambda>s. P (ksIdleThread s)"
-  and valid_queues[wp]: "Invariants_H.valid_queues"
-  (wp: crunch_wps simp: crunch_simps)
+  and sym_heap_sched_pointers[wp]: sym_heap_sched_pointers
+  and valid_objs'[wp]: valid_objs'
+  (wp: crunch_wps threadSet_sched_pointers simp: crunch_simps)
 
-crunches arch_switch_to_thread
+crunches arch_switch_to_thread, arch_switch_to_idle_thread
   for pspace_aligned[wp]: pspace_aligned
   and pspace_distinct[wp]: pspace_distinct
+  and ready_qs_distinct[wp]: ready_qs_distinct
+  and valid_idle[wp]: valid_idle
+  (wp: ready_qs_distinct_lift)
+
+lemma valid_queues_in_correct_ready_q[elim!]:
+  "valid_queues s \<Longrightarrow> in_correct_ready_q s"
+  by (clarsimp simp: valid_queues_def in_correct_ready_q_def)
+
+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)
 
 lemma switchToThread_corres:
   "corres dc (valid_arch_state and valid_objs
                 and valid_vspace_objs and pspace_aligned and pspace_distinct
                 and valid_vs_lookup and valid_global_objs
                 and unique_table_refs
-                and st_tcb_at runnable t and valid_etcbs)
-             (no_0_obj' and Invariants_H.valid_queues)
+                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')
              (switch_to_thread t) (switchToThread t)"
-  (is "corres _ ?PA ?PH _ _")
-proof -
-  have mainpart: "corres dc (?PA) (?PH)
-     (do y \<leftarrow> arch_switch_to_thread t;
-         y \<leftarrow> (tcb_sched_action tcb_sched_dequeue t);
-         modify (cur_thread_update (\<lambda>_. t))
-      od)
-     (do y \<leftarrow> Arch.switchToThread t;
-         y \<leftarrow> tcbSchedDequeue t;
-         setCurThread 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)
+  apply add_ready_qs_runnable
+  apply (simp add: switch_to_thread_def Thread_H.switchToThread_def)
+  apply (rule corres_symb_exec_l[OF _ _ get_sp]; (solves wpsimp)?)
+  apply (rule corres_symb_exec_l[OF _ _ assert_sp]; (solves wpsimp)?)
+  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_stateAssert_ignore)
+     apply (fastforce dest!: state_relation_ready_queues_relation intro: ksReadyQueues_asrt_cross)
+    apply (rule corres_stateAssert_add_assertion[rotated])
+     apply fastforce
     apply (rule corres_guard_imp)
       apply (rule corres_split[OF arch_switchToThread_corres])
         apply (rule corres_split[OF tcbSchedDequeue_corres setCurThread_corres])
-         apply (wp|clarsimp simp: tcb_at_is_etcb_at st_tcb_at_tcb_at)+
-    done
-
-  show ?thesis
-    apply -
-    apply (simp add: switch_to_thread_def Thread_H.switchToThread_def)
-    apply (rule corres_symb_exec_l [where Q = "\<lambda> s rv. (?PA and (=) rv) s",
-                                    OF corres_symb_exec_l [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
@@ -664,15 +800,21 @@ lemma arch_switchToIdleThread_corres:
   done
 
 lemma switchToIdleThread_corres:
-  "corres dc invs invs_no_cicd' switch_to_idle_thread switchToIdleThread"
+  "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 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_trivial, rule corres_modify)
-        apply (simp add: state_relation_def cdt_relation_def)
-       apply (wp+, simp+)
+        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)
@@ -707,11 +849,9 @@ proof -
     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 Invariants_H.valid_queues_def
-                              sch_act_wf ct_in_state'_def state_refs_of'_def
-                              ps_clear_def valid_irq_node'_def valid_queues'_def ct_not_inQ_ct
-                              ct_idle_or_in_cur_domain'_def
-                              bitmapQ_defs valid_queues_no_bitmap_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
@@ -725,100 +865,20 @@ lemma setCurThread_invs:
   by (rule hoare_pre, rule setCurThread_invs_no_cicd')
      (simp add: invs'_to_invs_no_cicd'_def)
 
-lemma valid_queues_not_runnable_not_queued:
-  fixes s
-  assumes vq:  "Invariants_H.valid_queues 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
-
-  with vq have "st_tcb_at' runnable' t s"
-    unfolding Invariants_H.valid_queues_def valid_queues_no_bitmap_def
-    apply -
-    apply clarsimp
-    apply (drule_tac x=d in spec)
-    apply (drule_tac x=p in spec)
-    apply (clarsimp simp add: st_tcb_at'_def)
-    apply (drule(1) bspec)
-    apply (erule obj_at'_weakenE)
-    apply (clarsimp)
-    done
-
-  with st show False
-    apply -
-    apply (drule(1) pred_tcb_at_conj')
-    apply (clarsimp)
-    done
-qed
-
-(*
- * The idle thread is not part of any ready queues.
- *)
-lemma idle'_not_tcbQueued':
- assumes vq:   "Invariants_H.valid_queues 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 add: valid_idle'_def pred_tcb_at'_def obj_at'_def idle_tcb'_def)
-  with vq vq' show ?thesis
-    by (rule valid_queues_not_runnable_not_queued)
-qed
-
 lemma setCurThread_invs_no_cicd'_idle_thread:
-  "\<lbrace>invs_no_cicd' and (\<lambda>s. t = ksIdleThread s) \<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
-  have idle'_activatable': "\<And> s t. st_tcb_at' idle' t s \<Longrightarrow> st_tcb_at' activatable' t s"
-    apply (clarsimp simp: st_tcb_at'_def o_def obj_at'_def)
+  "\<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 st_tcb_at'_def
+                        idleThreadNotQueued_def)
   done
-  show ?thesis
-    apply (simp add: setCurThread_def)
-    apply wp
-    apply (clarsimp simp: all_invs_but_ct_idle_or_in_cur_domain'_def)
-    apply (frule (2) idle'_not_tcbQueued'[simplified o_def])
-    apply (clarsimp simp add: ct_not_inQ_ct idle'_activatable'
-                              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_queues_no_bitmap_def valid_queues'_def
-                              pred_tcb_at'_def
-                        cong: option.case_cong)
-    apply (clarsimp simp: obj_at'_def idle_tcb'_def )
-    done
-qed
 
 lemma setCurThread_invs_idle_thread:
   "\<lbrace>invs' and (\<lambda>s. t = ksIdleThread s) \<rbrace> setCurThread t \<lbrace>\<lambda>rv. invs'\<rbrace>"
@@ -853,13 +913,13 @@ lemma Arch_switchToThread_tcb_in_cur_domain'[wp]:
   done
 
 lemma tcbSchedDequeue_not_tcbQueued:
-  "\<lbrace> tcb_at' t \<rbrace> tcbSchedDequeue t \<lbrace> \<lambda>_. obj_at' (\<lambda>x. \<not> tcbQueued x) t \<rbrace>"
+  "\<lbrace>\<top>\<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>_. obj_at' (\<lambda>x. \<not> tcbQueued x) t\<rbrace>"
   apply (simp add: tcbSchedDequeue_def)
   apply (wp|clarsimp)+
   apply (rule_tac Q="\<lambda>queued. obj_at' (\<lambda>x. tcbQueued x = queued) t" in hoare_post_imp)
-   apply (clarsimp simp: obj_at'_def)
-  apply (wp threadGet_obj_at')
-  apply (simp)
+     apply (clarsimp simp: obj_at'_def)
+    apply (wpsimp wp: threadGet_wp)+
+  apply (clarsimp simp: obj_at'_def)
   done
 
 lemma asUser_tcbState_inv[wp]:
@@ -883,10 +943,6 @@ crunch valid_irq_states'[wp]: asUser "valid_irq_states'"
 crunch valid_machine_state'[wp]: asUser "valid_machine_state'"
 (wp: crunch_wps simp: crunch_simps)
 
-crunch valid_queues'[wp]: asUser "valid_queues'"
-(wp: crunch_wps simp: crunch_simps)
-
-
 lemma asUser_valid_irq_node'[wp]:
   "\<lbrace>\<lambda>s. valid_irq_node' (irq_node' s) s\<rbrace> asUser t (setRegister f r)
           \<lbrace>\<lambda>_ s. valid_irq_node' (irq_node' s) s\<rbrace>"
@@ -946,55 +1002,38 @@ lemma asUser_utr[wp]:
   done
 
 lemma threadSet_invs_no_cicd'_trivialT:
-  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 \<and> tcbDomain (F tcb) = tcbDomain tcb"
-  assumes w: "\<forall>tcb. is_aligned (tcbIPCBuffer tcb) msg_align_bits \<longrightarrow> is_aligned (tcbIPCBuffer (F tcb)) msg_align_bits"
-  assumes a: "\<forall>tcb. tcbBoundNotification (F tcb) = tcbBoundNotification tcb"
-  assumes w: "\<forall>tcb. is_aligned (tcbIPCBuffer tcb) msg_align_bits \<longrightarrow> is_aligned (tcbIPCBuffer (F tcb)) msg_align_bits"
-  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 \<and> tcbDomain (F tcb) = tcbDomain tcb"
+    "\<forall>tcb. is_aligned (tcbIPCBuffer tcb) msg_align_bits \<longrightarrow> is_aligned (tcbIPCBuffer (F tcb)) msg_align_bits"
+    "\<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 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_no_cicd' 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. \<not> tcbQueued tcb \<and> tcbQueued (F tcb)) \<longrightarrow> ex_nonz_cap_to' t s \<and> t \<noteq> ksCurThread s) \<and>
-       (\<forall>tcb. tcbQueued (F tcb) \<and> ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> tcbQueued tcb \<or> t \<noteq> ksCurThread s)\<rbrace>
-   threadSet F t
-   \<lbrace>\<lambda>rv. invs_no_cicd'\<rbrace>"
-proof -
-  from z have domains: "\<And>tcb. tcbDomain (F tcb) = tcbDomain tcb" by blast
-  note threadSet_sch_actT_P[where P=False, simplified]
-  have y: "\<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_no_cicd'_def valid_state'_def split del: if_split)
-    apply (rule hoare_pre)
-     apply (wp x w v u b
-              threadSet_valid_pspace'T
-              threadSet_sch_actT_P[where P=False, simplified]
-              threadSet_valid_queues
-              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_cur
-              untyped_ranges_zero_lift
-           |clarsimp simp: y z a domains cteCaps_of_def |rule refl)+
-   apply (clarsimp simp: obj_at'_def pred_tcb_at'_def)
-   apply (clarsimp simp: cur_tcb'_def valid_irq_node'_def valid_queues'_def o_def)
-   by (fastforce simp: domains ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def z a)
-qed
+  "threadSet F t \<lbrace>invs_no_cicd'\<rbrace>"
+  apply (simp add: invs_no_cicd'_def valid_state'_def)
+  apply (wp threadSet_valid_pspace'T
+            threadSet_sch_actT_P[where P=False, simplified]
+            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_sched_pointers threadSet_valid_sched_pointers
+            threadSet_cur
+            untyped_ranges_zero_lift
+         | clarsimp simp: assms cteCaps_of_def | rule refl)+
+  by (auto simp: o_def)
 
 lemmas threadSet_invs_no_cicd'_trivial =
     threadSet_invs_no_cicd'_trivialT [OF all_tcbI all_tcbI all_tcbI all_tcbI, OF ball_tcb_cte_casesI]
@@ -1013,22 +1052,17 @@ lemma Arch_switchToThread_invs_no_cicd':
   done
 
 lemma tcbSchedDequeue_invs_no_cicd'[wp]:
-  "\<lbrace>invs_no_cicd' and tcb_at' t\<rbrace>
-     tcbSchedDequeue t
-   \<lbrace>\<lambda>_. invs_no_cicd'\<rbrace>"
-  unfolding all_invs_but_ct_idle_or_in_cur_domain'_def valid_state'_def
+  "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
-            tcbSchedDequeue_valid_queues_weak
             untyped_ranges_zero_lift
         | simp add: cteCaps_of_def o_def)+
   apply clarsimp
-  apply (fastforce simp: valid_pspace'_def valid_queues_def
-                   elim: valid_objs'_maxDomain valid_objs'_maxPriority intro: obj_at'_conjI)
   done
 
 lemma switchToThread_invs_no_cicd':
-  "\<lbrace>invs_no_cicd' and st_tcb_at' runnable' t and tcb_in_cur_domain' t \<rbrace> ThreadDecls_H.switchToThread t \<lbrace>\<lambda>rv. invs' \<rbrace>"
+  "\<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')
@@ -1036,7 +1070,7 @@ lemma switchToThread_invs_no_cicd':
   done
 
 lemma switchToThread_invs[wp]:
-  "\<lbrace>invs' and st_tcb_at' runnable' t and tcb_in_cur_domain' t \<rbrace> switchToThread t \<lbrace>\<lambda>rv. invs' \<rbrace>"
+  "\<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 threadSet_timeslice_invs setCurThread_invs
              Arch_switchToThread_invs dmo_invs'
@@ -1111,61 +1145,6 @@ 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 invs'_not_runnable_not_queued:
-  fixes s
-  assumes inv: "invs' s"
-      and st: "st_tcb_at' (Not \<circ> runnable') t s"
-  shows "obj_at' (Not \<circ> tcbQueued) t s"
-  apply (insert assms)
-  apply (rule valid_queues_not_runnable_not_queued)
-    apply (clarsimp simp add: invs'_def valid_state'_def)+
-  done
-
-lemma valid_queues_not_tcbQueued_not_ksQ:
-  fixes s
-  assumes   vq: "Invariants_H.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"
-    unfolding Invariants_H.valid_queues_def valid_queues_no_bitmap_def
-    apply clarify
-    apply (drule_tac x=d in spec)
-    apply (drule_tac x=p in spec)
-    apply (clarsimp)
-    apply (drule(1) bspec)
-    apply (erule obj_at'_weakenE)
-    apply (simp)
-    done
-  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 valid_state'_def)
-  apply (drule(1) valid_queues_not_tcbQueued_not_ksQ)
-  apply (clarsimp)
-  done
-
-lemma ct_not_ksQ:
-  "\<lbrakk> invs' s; ksSchedulerAction s = ResumeCurrentThread \<rbrakk>
-   \<Longrightarrow> \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)"
-  apply (clarsimp simp: invs'_def valid_state'_def ct_not_inQ_def)
-  apply (frule(1) valid_queues_not_tcbQueued_not_ksQ)
-  apply (fastforce)
-  done
-
 lemma setThreadState_rct:
   "\<lbrace>\<lambda>s. (runnable' st \<or> ksCurThread s \<noteq> t)
         \<and> ksSchedulerAction s = ResumeCurrentThread\<rbrace>
@@ -1237,21 +1216,24 @@ lemma bitmapQ_from_bitmap_lookup:
   done
 
 lemma lookupBitmapPriority_obj_at':
-  "\<lbrakk>ksReadyQueuesL1Bitmap s (ksCurDomain s) \<noteq> 0; valid_queues_no_bitmap s; valid_bitmapQ s;
-         bitmapQ_no_L1_orphans s\<rbrakk>
-        \<Longrightarrow> obj_at' (inQ (ksCurDomain s) (lookupBitmapPriority (ksCurDomain s) s) and runnable' \<circ> tcbState)
-             (hd (ksReadyQueues s (ksCurDomain s, lookupBitmapPriority (ksCurDomain s) s))) s"
+  "\<lbrakk>ksReadyQueuesL1Bitmap s d \<noteq> 0; valid_bitmapQ s; bitmapQ_no_L1_orphans s;
+    ksReadyQueues_asrt s; ready_qs_runnable s; pspace_aligned' s; pspace_distinct' s\<rbrakk>
+   \<Longrightarrow> obj_at' (inQ d (lookupBitmapPriority d s) and runnable' \<circ> tcbState)
+               (the (tcbQueueHead (ksReadyQueues s (d, lookupBitmapPriority d s)))) s"
   apply (drule (2) bitmapQ_from_bitmap_lookup)
   apply (simp add: valid_bitmapQ_bitmapQ_simp)
-  apply (case_tac "ksReadyQueues s (ksCurDomain s, lookupBitmapPriority (ksCurDomain s) s)", simp)
-  apply (clarsimp, rename_tac t ts)
-  apply (drule cons_set_intro)
-  apply (drule (2) valid_queues_no_bitmap_objD)
+  apply (clarsimp simp: ready_queue_relation_def ksReadyQueues_asrt_def tcbQueueEmpty_def)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x="lookupBitmapPriority d s" in spec)
+  apply clarsimp
+  apply (frule (3) obj_at'_tcbQueueHead_ksReadyQueues)
+  apply (fastforce simp: obj_at'_and ready_qs_runnable_def obj_at'_def st_tcb_at'_def inQ_def
+                         tcbQueueEmpty_def)
   done
 
 lemma bitmapL1_zero_ksReadyQueues:
   "\<lbrakk> valid_bitmapQ s ; bitmapQ_no_L1_orphans s \<rbrakk>
-   \<Longrightarrow> (ksReadyQueuesL1Bitmap s d = 0) = (\<forall>p. ksReadyQueues s (d,p) = [])"
+   \<Longrightarrow> (ksReadyQueuesL1Bitmap s d = 0) = (\<forall>p. tcbQueueEmpty (ksReadyQueues s (d, p)))"
   apply (cases "ksReadyQueuesL1Bitmap s d = 0")
    apply (force simp add: bitmapQ_def valid_bitmapQ_def)
   apply (fastforce dest: bitmapQ_from_bitmap_lookup simp: valid_bitmapQ_bitmapQ_simp)
@@ -1322,7 +1304,7 @@ lemma bitmapL1_highest_lookup:
   done
 
 lemma bitmapQ_ksReadyQueuesI:
-  "\<lbrakk> bitmapQ d p s ; valid_bitmapQ s \<rbrakk> \<Longrightarrow> ksReadyQueues s (d, p) \<noteq> []"
+  "\<lbrakk> bitmapQ d p s ; valid_bitmapQ s \<rbrakk> \<Longrightarrow> \<not> tcbQueueEmpty (ksReadyQueues s (d, p))"
   unfolding valid_bitmapQ_def by simp
 
 lemma getReadyQueuesL2Bitmap_inv[wp]:
@@ -1331,24 +1313,22 @@ lemma getReadyQueuesL2Bitmap_inv[wp]:
 
 lemma switchToThread_lookupBitmapPriority_wp:
   "\<lbrace>\<lambda>s. invs_no_cicd' s \<and> bitmapQ (ksCurDomain s) (lookupBitmapPriority (ksCurDomain s) s) s \<and>
-        t = hd (ksReadyQueues s (ksCurDomain s, lookupBitmapPriority (ksCurDomain s) s)) \<rbrace>
+        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 ; 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 elim: obj_at'_weaken simp: inQ_def tcb_in_cur_domain'_def st_tcb_at'_def)
-    done
-  thus ?thesis
-    by (wp switchToThread_invs_no_cicd') (fastforce dest: invs_no_cicd'_queues)
-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_no_cicd':
   "\<lbrace>invs_no_cicd'\<rbrace> switchToIdleThread \<lbrace>\<lambda>rv. invs'\<rbrace>"
@@ -1447,8 +1427,8 @@ 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
-                and st_tcb_at runnable t and valid_etcbs)
-             (no_0_obj' and Invariants_H.valid_queues)
+                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')
              (guarded_switch_to t) (switchToThread t)"
   apply (simp add: guarded_switch_to_def)
   apply (rule corres_guard_imp)
@@ -1493,7 +1473,7 @@ lemma curDomain_corres: "corres (=) \<top> \<top> (gets cur_domain) (curDomain)"
 
 lemma curDomain_corres':
   "corres (=) \<top> (\<lambda>s. ksCurDomain s \<le> maxDomain)
-    (gets cur_domain) (if 1 < numDomains then curDomain else return 0)"
+    (gets cur_domain) (if Suc 0 < numDomains then curDomain else return 0)"
   apply (case_tac "1 < numDomains"; simp)
    apply (rule corres_guard_imp[OF curDomain_corres]; solves simp)
   (* if we have only one domain, then we are in it *)
@@ -1503,27 +1483,32 @@ lemma curDomain_corres':
 
 lemma lookupBitmapPriority_Max_eqI:
   "\<lbrakk> valid_bitmapQ s ; bitmapQ_no_L1_orphans s ; ksReadyQueuesL1Bitmap s d \<noteq> 0 \<rbrakk>
-   \<Longrightarrow> lookupBitmapPriority d s = (Max {prio. ksReadyQueues s (d, prio) \<noteq> []})"
+   \<Longrightarrow> lookupBitmapPriority d s = (Max {prio. \<not> tcbQueueEmpty (ksReadyQueues s (d, prio))})"
   apply (rule Max_eqI[simplified eq_commute]; simp)
    apply (fastforce simp: bitmapL1_highest_lookup valid_bitmapQ_bitmapQ_simp)
   apply (metis valid_bitmapQ_bitmapQ_simp bitmapQ_from_bitmap_lookup)
   done
 
 lemma corres_gets_queues_getReadyQueuesL1Bitmap:
-  "corres (\<lambda>qs l1. ((l1 = 0) = (\<forall>p. qs p = []))) \<top> valid_queues
+  "corres (\<lambda>qs l1. (l1 = 0) = (\<forall>p. qs p = [])) \<top> valid_bitmaps
     (gets (\<lambda>s. ready_queues s d)) (getReadyQueuesL1Bitmap d)"
-  unfolding state_relation_def valid_queues_def getReadyQueuesL1Bitmap_def
-  by (clarsimp simp: bitmapL1_zero_ksReadyQueues ready_queues_relation_def)
+  unfolding state_relation_def valid_bitmaps_def getReadyQueuesL1Bitmap_def
+  apply (clarsimp simp: ready_queues_relation_def ready_queue_relation_def Let_def)
+  apply (drule_tac x=d in spec)
+  apply (fastforce simp: bitmapL1_zero_ksReadyQueues list_queue_relation_def tcbQueueEmpty_def)
+  done
 
 lemma guarded_switch_to_chooseThread_fragment_corres:
   "corres dc
     (P and st_tcb_at runnable t and invs and valid_sched)
-    (P' and st_tcb_at' runnable' t and invs_no_cicd')
-          (guarded_switch_to t)
-          (do runnable \<leftarrow> isRunnable t;
-              y \<leftarrow> assert runnable;
-              ThreadDecls_H.switchToThread t
-           od)"
+    (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)
@@ -1538,35 +1523,50 @@ lemma guarded_switch_to_chooseThread_fragment_corres:
               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'
+   \<Longrightarrow> Max {prio. ready_queues s d prio \<noteq> []}
+       = Max {prio. \<not> tcbQueueEmpty (ksReadyQueues s' (d, prio))}"
+  apply (clarsimp simp: ready_queues_relation_def ready_queue_relation_def Let_def
+                        list_queue_relation_def tcbQueueEmpty_def)
+  apply (rule Max_eq_if)
+     apply fastforce
+    apply fastforce
+   apply (fastforce dest: heap_path_head)
+  apply clarsimp
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=b in spec)
+  apply force
+  done
+
 lemma bitmap_lookup_queue_is_max_non_empty:
-  "\<lbrakk> valid_queues s'; (s, s') \<in> state_relation; invs s;
+  "\<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 all_invs_but_ct_idle_or_in_cur_domain'_def 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 \<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 (simp add: valid_queues_no_bitmap_def)
-   apply (erule_tac x="ksCurDomain s" in allE)
-   apply (erule_tac x="lookupBitmapPriority (ksCurDomain s) s" in allE)
-   apply (clarsimp simp: st_tcb_at'_def)
-   apply (erule obj_at'_weaken)
-   apply simp
-   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>"
@@ -1578,52 +1578,72 @@ lemma invs_no_cicd_ksCurDomain_maxDomain':
   "invs_no_cicd' s \<Longrightarrow> ksCurDomain s \<le> maxDomain"
   unfolding invs_no_cicd'_def by simp
 
+crunches curDomain
+  for valid_bitmaps[wp]: valid_bitmaps
+
 lemma chooseThread_corres:
-  "corres dc (invs and valid_sched) (invs_no_cicd')
-     choose_thread chooseThread" (is "corres _ ?PREI ?PREH _ _")
+  "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
-  unfolding choose_thread_def chooseThread_def
-  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> 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 dest!: invs_no_cicd'_queues simp: bitmap_lookup_queue_is_max_non_empty)
-              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 (clarsimp simp: if_apply_def2)
-      apply (wp hoare_vcg_conj_lift hoare_vcg_imp_lift ksReadyQueuesL1Bitmap_return_wp)
-     apply (wpsimp wp: curDomain_or_return_0 simp: curDomain_def)+
-    apply (fastforce simp: invs_no_cicd'_def)
-   apply (clarsimp simp: valid_sched_def DetSchedInvs_AI.valid_queues_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 (simp add: invs_no_cicd_ksCurDomain_maxDomain')
-  apply (clarsimp dest!: invs_no_cicd'_queues)
-  apply (fastforce intro: ksReadyQueuesL1Bitmap_st_tcb_at')
-  done
+    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 (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 =
@@ -1712,7 +1732,7 @@ lemma isHighestPrio_corres:
   assumes "d' = d"
   assumes "p' = p"
   shows
-    "corres ((=)) \<top> valid_queues
+    "corres ((=)) \<top> valid_bitmaps
       (gets (is_highest_prio d p))
       (isHighestPrio d' p')"
   using assms
@@ -1722,18 +1742,16 @@ lemma isHighestPrio_corres:
     apply (rule corres_split[OF corres_gets_queues_getReadyQueuesL1Bitmap])
       apply (rule corres_if_r'[where P'="\<lambda>_. True",rotated])
        apply (rule_tac corres_symb_exec_r)
-              apply (rule_tac
-                       P="\<lambda>s. q = ready_queues s d
-                              " and
-                       P'="\<lambda>s. valid_queues s \<and>
-                               l1 = ksReadyQueuesL1Bitmap s d \<and>
-                               l1 \<noteq> 0 \<and> hprio = lookupBitmapPriority d s" and
-                       F="hprio = Max {prio. q prio \<noteq> []}" in corres_req)
-              apply (elim conjE)
-              apply (clarsimp simp: valid_queues_def)
-              apply (subst lookupBitmapPriority_Max_eqI; blast?)
-              apply (fastforce simp: ready_queues_relation_def dest!: state_relationD)
-             apply fastforce
+          apply (rule_tac P="\<lambda>s. q = ready_queues s d"
+                      and P'="\<lambda>s. valid_bitmaps s \<and> l1 = ksReadyQueuesL1Bitmap s d \<and>
+                                  l1 \<noteq> 0 \<and> hprio = lookupBitmapPriority d s"
+                      and F="hprio = Max {prio. q prio \<noteq> []}" in corres_req)
+           apply (elim conjE)
+           apply (clarsimp simp: valid_bitmaps_def)
+           apply (subst lookupBitmapPriority_Max_eqI; blast?)
+           apply (fastforce dest: state_relation_ready_queues_relation Max_prio_helper[where d=d]
+                            simp: tcbQueueEmpty_def)
+          apply fastforce
          apply (wpsimp simp: if_apply_def2 wp: hoare_drop_imps ksReadyQueuesL1Bitmap_return_wp)+
   done
 
@@ -1744,9 +1762,8 @@ crunch inv[wp]: curDomain P
 crunch inv[wp]: scheduleSwitchThreadFastfail P
 
 lemma setSchedulerAction_invs': (* not in wp set, clobbered by ssa_wp *)
-  "\<lbrace>\<lambda>s. invs' s \<rbrace> setSchedulerAction ChooseNewThread \<lbrace>\<lambda>_. invs' \<rbrace>"
+  "setSchedulerAction ChooseNewThread \<lbrace>invs' \<rbrace>"
   by (wpsimp simp: invs'_def cur_tcb'_def valid_state'_def valid_irq_node'_def ct_not_inQ_def
-                   valid_queues_def valid_queues_no_bitmap_def valid_queues'_def
                    ct_idle_or_in_cur_domain'_def)
 
 lemma scheduleChooseNewThread_corres:
@@ -1776,6 +1793,46 @@ lemma ethread_get_when_corres:
   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
+
+crunches 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)
+
+crunches 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)
+
 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]
@@ -1804,7 +1861,7 @@ lemma schedule_corres:
          apply (rule corres_split[OF thread_get_isRunnable_corres])
            apply (rule corres_split)
               apply (rule corres_when, simp)
-              apply (rule tcbSchedEnqueue_corres)
+              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)+
@@ -1813,7 +1870,7 @@ lemma schedule_corres:
                 rename_tac was_running wasRunning)
           apply (rule corres_split)
              apply (rule corres_when, simp)
-             apply (rule tcbSchedEnqueue_corres)
+             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)
@@ -1829,7 +1886,7 @@ lemma schedule_corres:
                     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])
+                         apply (rule corres_split[OF tcbSchedEnqueue_corres], simp)
                            apply (simp, fold dc_def)
                            apply (rule corres_split)
                               apply (rule setSchedulerAction_corres; simp)
@@ -1843,7 +1900,7 @@ lemma schedule_corres:
                           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])
+                         apply (rule corres_split[OF tcbSchedAppend_corres], simp)
                            apply (simp, fold dc_def)
                            apply (rule corres_split)
                               apply (rule setSchedulerAction_corres; simp)
@@ -1875,7 +1932,8 @@ lemma schedule_corres:
                     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)+
+                     del: gets_wp
+                  | strengthen valid_objs'_valid_tcbs')+
        apply (clarsimp simp: conj_ac if_apply_def2 cong: imp_cong conj_cong del: hoare_gets)
        apply (wp gets_wp)+
 
@@ -1898,18 +1956,17 @@ lemma schedule_corres:
                                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 (clarsimp simp add: pred_tcb_at_def obj_at_def is_tcb valid_idle_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)+
-     apply (simp add: valid_sched_def valid_blocked_def valid_blocked_except_def)
      done
 
   (* haskell final subgoal *)
-  apply (clarsimp simp: if_apply_def2 invs'_def valid_state'_def
+  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
@@ -1923,11 +1980,8 @@ proof -
     apply (simp add: setSchedulerAction_def)
     apply wp
     apply (clarsimp simp add: invs'_def valid_state'_def cur_tcb'_def
-                              Invariants_H.valid_queues_def
-                              state_refs_of'_def ps_clear_def
-                              valid_irq_node'_def valid_queues'_def
-                              tcb_in_cur_domain'_def ct_idle_or_in_cur_domain'_def
-                              bitmapQ_defs valid_queues_no_bitmap_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
@@ -1967,7 +2021,7 @@ lemma switchToThread_ct_not_queued_2:
   apply (simp add: Thread_H.switchToThread_def)
   apply (wp)
     apply (simp add: RISCV64_H.switchToThread_def setCurThread_def)
-    apply (wp tcbSchedDequeue_not_tcbQueued | simp )+
+    apply (wp tcbSchedDequeue_not_tcbQueued hoare_drop_imp | simp )+
   done
 
 lemma setCurThread_obj_at':
@@ -1981,11 +2035,12 @@ proof -
 qed
 
 lemma switchToIdleThread_ct_not_queued_no_cicd':
-  "\<lbrace> invs_no_cicd' \<rbrace> switchToIdleThread \<lbrace>\<lambda>rv s. obj_at' (Not \<circ> tcbQueued) (ksCurThread s) s \<rbrace>"
+  "\<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 (rule idle'_not_tcbQueued')
-  apply (simp add: invs_no_cicd'_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]:
@@ -2002,7 +2057,7 @@ lemma switchToThread_tcb_in_cur_domain':
    ThreadDecls_H.switchToThread thread
    \<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)
+  apply (wpsimp wp: tcbSchedDequeue_not_tcbQueued hoare_drop_imps)
   done
 
 lemma chooseThread_invs_no_cicd'_posts: (* generic version *)
@@ -2024,11 +2079,14 @@ proof -
     by (simp add: all_invs_but_ct_idle_or_in_cur_domain'_def maxDomain_def)
 
   show ?thesis
-    unfolding chooseThread_def Let_def curDomain_def
+    apply (clarsimp simp: chooseThread_def Let_def curDomain_def)
+    apply (rule hoare_seq_ext[OF _ stateAssert_sp])+
     apply (simp only: return_bind, simp)
-    apply (rule hoare_seq_ext[where B="\<lambda>rv s. invs_no_cicd' s \<and> rv = ksCurDomain s"])
+    apply (rule hoare_seq_ext[where B="\<lambda>rv s. invs_no_cicd' s \<and> rv = ksCurDomain s
+                                              \<and> ksReadyQueues_asrt s \<and> ready_qs_runnable s"])
      apply (rule_tac B="\<lambda>rv s. invs_no_cicd' s \<and> curdom = ksCurDomain s \<and>
-                               rv = ksReadyQueuesL1Bitmap s curdom" in hoare_seq_ext)
+                               rv = ksReadyQueuesL1Bitmap s curdom \<and>
+                               ksReadyQueues_asrt s \<and> ready_qs_runnable s" in hoare_seq_ext)
       apply (rename_tac l1)
       apply (case_tac "l1 = 0")
        (* switch to idle thread *)
@@ -2042,12 +2100,10 @@ proof -
       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
-      apply (clarsimp dest!: invs_no_cicd'_queues
-                      simp: valid_queues_def lookupBitmapPriority_def[symmetric])
-      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 (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
@@ -2086,11 +2142,14 @@ proof -
 
   (* FIXME this is almost identical to the chooseThread_invs_no_cicd'_posts proof, can generalise? *)
   show ?thesis
-    unfolding chooseThread_def Let_def curDomain_def
+    apply (clarsimp simp: chooseThread_def Let_def curDomain_def)
+    apply (rule hoare_seq_ext[OF _ stateAssert_sp])+
     apply (simp only: return_bind, simp)
-    apply (rule hoare_seq_ext[where B="\<lambda>rv s. invs_no_cicd' s \<and> rv = ksCurDomain s"])
+    apply (rule hoare_seq_ext[where B="\<lambda>rv s. invs_no_cicd' s \<and> rv = ksCurDomain s
+                                              \<and> ksReadyQueues_asrt s \<and> ready_qs_runnable s"])
      apply (rule_tac B="\<lambda>rv s. invs_no_cicd' s \<and> curdom = ksCurDomain s \<and>
-                               rv = ksReadyQueuesL1Bitmap s curdom" in hoare_seq_ext)
+                               rv = ksReadyQueuesL1Bitmap s curdom \<and>
+                               ksReadyQueues_asrt s \<and> ready_qs_runnable s" in hoare_seq_ext)
       apply (rename_tac l1)
       apply (case_tac "l1 = 0")
        (* switch to idle thread *)
@@ -2098,7 +2157,10 @@ proof -
       (* we have a thread to switch to *)
       apply (clarsimp simp: bitmap_fun_defs)
       apply (wp assert_inv)
-      apply (clarsimp dest!: invs_no_cicd'_queues simp: valid_queues_def)
+      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
@@ -2248,12 +2310,15 @@ lemma sbn_sch_act_sane:
 
 lemma possibleSwitchTo_corres:
   "corres dc
-          (valid_etcbs and weak_valid_sched_action and cur_tcb and st_tcb_at runnable t
-            and pspace_aligned and pspace_distinct)
-          (valid_queues and valid_queues' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
-            and valid_objs')
-          (possible_switch_to t)
-          (possibleSwitchTo t)"
+     (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)
@@ -2266,12 +2331,12 @@ lemma possibleSwitchTo_corres:
          apply (clarsimp simp: etcb_relation_def)
         apply (rule corres_split[OF getSchedulerAction_corres])
           apply (rule corres_if, simp)
-           apply (rule tcbSchedEnqueue_corres)
+           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)
-            apply (wp rescheduleRequired_valid_queues'_weak)+
+             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])+
@@ -2280,7 +2345,7 @@ lemma possibleSwitchTo_corres:
    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 (simp add: tcb_at_is_etcb_at)
+  apply (fastforce simp: tcb_at_is_etcb_at)
   done
 
 end
diff --git a/proof/refine/RISCV64/StateRelation.thy b/proof/refine/RISCV64/StateRelation.thy
index 18b70fc2b3..c02b8cbbb0 100644
--- a/proof/refine/RISCV64/StateRelation.thy
+++ b/proof/refine/RISCV64/StateRelation.thy
@@ -155,13 +155,20 @@ definition tcb_relation :: "Structures_A.tcb \<Rightarrow> Structures_H.tcb \<Ri
    \<and> tcb_bound_notification tcb = tcbBoundNotification tcb'
    \<and> tcb_mcpriority tcb = tcbMCP tcb'"
 
+\<comment> \<open>
+  A pair of objects @{term "(obj, obj')"} should satisfy the following relation when, under further
+  mild assumptions, a @{term corres_underlying} lemma for @{term "set_object obj"}
+  and @{term "setObject obj'"} can be stated: see setObject_other_corres in KHeap_R.
+
+  TCBs do not satisfy this relation because the tcbSchedPrev and tcbSchedNext fields of a TCB are
+  used to model the ready queues, and so an update to such a field would correspond to an update
+  to a ready queue (see ready_queues_relation below).\<close>
 definition
   other_obj_relation :: "Structures_A.kernel_object \<Rightarrow> Structures_H.kernel_object \<Rightarrow> bool"
 where
   "other_obj_relation obj obj' \<equiv>
    (case (obj, obj') of
-      (TCB tcb, KOTCB tcb') \<Rightarrow> tcb_relation tcb tcb'
-    | (Endpoint ep, KOEndpoint ep') \<Rightarrow> ep_relation ep ep'
+      (Endpoint ep, KOEndpoint ep') \<Rightarrow> ep_relation ep ep'
     | (Notification ntfn, KONotification ntfn') \<Rightarrow> ntfn_relation ntfn ntfn'
     | (ArchObj (RISCV64_A.ASIDPool ap), KOArch (KOASIDPool ap')) \<Rightarrow> asid_pool_relation ap ap'
     | _ \<Rightarrow> False)"
@@ -188,22 +195,28 @@ primrec aobj_relation_cuts :: "RISCV64_A.arch_kernel_obj \<Rightarrow> machine_w
 | "aobj_relation_cuts (PageTable pt) x =
      (\<lambda>y. (x + (ucast y << pteBits), pte_relation y)) ` UNIV"
 
+definition tcb_relation_cut :: "Structures_A.kernel_object \<Rightarrow> kernel_object \<Rightarrow> bool" where
+  "tcb_relation_cut obj obj' \<equiv>
+   case (obj, obj') of
+       (TCB t, KOTCB t') \<Rightarrow> tcb_relation t t'
+     | _ \<Rightarrow> False"
+
 primrec obj_relation_cuts :: "Structures_A.kernel_object \<Rightarrow> machine_word \<Rightarrow> obj_relation_cuts" where
   "obj_relation_cuts (CNode sz cs) x =
      (if well_formed_cnode_n sz cs
       then {(cte_map (x, y), cte_relation y) | y. y \<in> dom cs}
       else {(x, \<bottom>\<bottom>)})"
-| "obj_relation_cuts (TCB tcb) x = {(x, other_obj_relation)}"
+| "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 (ArchObj ao) x = aobj_relation_cuts ao x"
 
-
 lemma obj_relation_cuts_def2:
   "obj_relation_cuts ko x =
    (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>)}
+             | TCB tcb \<Rightarrow> {(x, tcb_relation_cut)}
              | ArchObj (PageTable pt) \<Rightarrow> (\<lambda>y. (x + (ucast y << pteBits), pte_relation y)) ` UNIV
              | ArchObj (DataPage dev sz) \<Rightarrow>
                  {(x + (n << pageBits),  \<lambda>_ obj. obj =(if dev then KOUserDataDevice else KOUserData))
@@ -216,6 +229,7 @@ lemma obj_relation_cuts_def3:
   "obj_relation_cuts ko x =
    (case a_type ko of
       ACapTable n \<Rightarrow> {(cte_map (x, y), cte_relation y) | y. length y = n}
+    | ATCB \<Rightarrow> {(x, tcb_relation_cut)}
     | AArch APageTable \<Rightarrow> (\<lambda>y. (x + (ucast y << pteBits), pte_relation y)) ` UNIV
     | AArch (AUserData sz) \<Rightarrow> {(x + (n << pageBits), \<lambda>_ obj. obj = KOUserData)
                                | n . n < 2 ^ (pageBitsForSize sz - pageBits) }
@@ -230,6 +244,7 @@ definition is_other_obj_relation_type :: "a_type \<Rightarrow> bool" where
  "is_other_obj_relation_type tp \<equiv>
     case tp of
       ACapTable n \<Rightarrow> False
+    | ATCB \<Rightarrow> False
     | AArch APageTable \<Rightarrow> False
     | AArch (AUserData _) \<Rightarrow> False
     | AArch (ADeviceData _) \<Rightarrow> False
@@ -240,6 +255,10 @@ 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_TCB:
+  "\<not> is_other_obj_relation_type ATCB"
+  by (simp add: is_other_obj_relation_type_def)
+
 lemma is_other_obj_relation_type_UserData:
   "\<not> is_other_obj_relation_type (AArch (AUserData sz))"
   unfolding is_other_obj_relation_type_def by simp
@@ -279,10 +298,55 @@ primrec sched_act_relation :: "Deterministic_A.scheduler_action \<Rightarrow> sc
   "sched_act_relation choose_new_thread a' = (a' = ChooseNewThread)" |
   "sched_act_relation (switch_thread x) a' = (a' = SwitchToThread x)"
 
-definition ready_queues_relation ::
-  "(Deterministic_A.domain \<Rightarrow> Structures_A.priority \<Rightarrow> Deterministic_A.ready_queue) \<Rightarrow>
-   (domain \<times> priority \<Rightarrow> KernelStateData_H.ready_queue) \<Rightarrow> bool" where
-  "ready_queues_relation qs qs' \<equiv> \<forall>d p. (qs d p = qs' (d, p))"
+definition queue_end_valid :: "obj_ref list \<Rightarrow> tcb_queue \<Rightarrow> bool" where
+  "queue_end_valid ts q \<equiv>
+     (ts = [] \<longrightarrow> tcbQueueEnd q = None) \<and> (ts \<noteq> [] \<longrightarrow> tcbQueueEnd q = Some (last ts))"
+
+definition prev_queue_head :: "tcb_queue \<Rightarrow> (obj_ref \<rightharpoonup> 'a) \<Rightarrow> bool" where
+  "prev_queue_head q prevs \<equiv> \<forall>head. tcbQueueHead q = Some head \<longrightarrow> prevs head = None"
+
+lemma prev_queue_head_heap_upd:
+  "\<lbrakk>prev_queue_head q prevs; Some r \<noteq> tcbQueueHead q\<rbrakk> \<Longrightarrow> prev_queue_head q (prevs(r := x))"
+  by (clarsimp simp: prev_queue_head_def)
+
+definition list_queue_relation ::
+  "obj_ref list \<Rightarrow> tcb_queue \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> bool"
+  where
+  "list_queue_relation ts q nexts prevs \<equiv>
+     heap_ls nexts (tcbQueueHead q) ts \<and> queue_end_valid ts q \<and> prev_queue_head q prevs"
+
+lemma list_queue_relation_nil:
+  "list_queue_relation ts q nexts prevs \<Longrightarrow> ts = [] \<longleftrightarrow> tcbQueueEmpty q"
+  by (fastforce dest: heap_path_head simp: tcbQueueEmpty_def list_queue_relation_def)
+
+definition ready_queue_relation ::
+  "Deterministic_A.domain \<Rightarrow> Structures_A.priority
+   \<Rightarrow> Deterministic_A.ready_queue \<Rightarrow> ready_queue
+   \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref)
+   \<Rightarrow> (obj_ref \<Rightarrow> bool) \<Rightarrow> bool"
+  where
+  "ready_queue_relation d p q q' nexts prevs flag \<equiv>
+     list_queue_relation q q' nexts prevs
+     \<and> (\<forall>t. flag t \<longleftrightarrow> t \<in> set q)
+     \<and> (d > maxDomain \<or> p > maxPriority \<longrightarrow> tcbQueueEmpty q')"
+
+definition ready_queues_relation_2 ::
+  "(Deterministic_A.domain \<Rightarrow> Structures_A.priority \<Rightarrow> Deterministic_A.ready_queue)
+   \<Rightarrow> (domain \<times> priority \<Rightarrow> ready_queue)
+   \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref)
+   \<Rightarrow> (domain \<Rightarrow> priority \<Rightarrow> obj_ref \<Rightarrow> bool) \<Rightarrow> bool"
+  where
+  "ready_queues_relation_2 qs qs' nexts prevs inQs \<equiv>
+     \<forall>d p. let q = qs d p; q' = qs' (d, p); flag = inQs d p in
+           ready_queue_relation d p q q' nexts prevs flag"
+
+abbreviation ready_queues_relation :: "det_state \<Rightarrow> kernel_state \<Rightarrow> bool" where
+  "ready_queues_relation s s' \<equiv>
+     ready_queues_relation_2
+      (ready_queues s) (ksReadyQueues s') (tcbSchedNexts_of s') (tcbSchedPrevs_of s')
+      (\<lambda>d p. inQ d p |< tcbs_of' s')"
+
+lemmas ready_queues_relation_def = ready_queues_relation_2_def
 
 definition ghost_relation ::
   "Structures_A.kheap \<Rightarrow> (machine_word \<rightharpoonup> vmpage_size) \<Rightarrow> (machine_word \<rightharpoonup> nat) \<Rightarrow> bool" where
@@ -337,6 +401,8 @@ lemma obj_relation_cutsE:
      \<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>tcb tcb'. \<lbrakk> y = x; ko = TCB tcb; ko' = KOTCB tcb'; tcb_relation tcb tcb' \<rbrakk>
+               \<Longrightarrow> R;
      \<And>pt (z :: pt_index) pte'. \<lbrakk> ko = ArchObj (PageTable pt); y = x + (ucast z << pteBits);
                                  ko' = KOArch (KOPTE pte'); pte_relation' (pt z) pte' \<rbrakk>
               \<Longrightarrow> R;
@@ -346,8 +412,9 @@ lemma obj_relation_cutsE:
             \<lbrakk> y = x; other_obj_relation ko ko'; is_other_obj_relation_type (a_type ko) \<rbrakk> \<Longrightarrow> R
     \<rbrakk> \<Longrightarrow> R"
   by (force simp: obj_relation_cuts_def2 is_other_obj_relation_type_def a_type_def
-                  cte_relation_def pte_relation_def
-            split: Structures_A.kernel_object.splits if_splits RISCV64_A.arch_kernel_obj.splits)
+                  tcb_relation_cut_def cte_relation_def pte_relation_def
+            split: Structures_A.kernel_object.splits kernel_object.splits if_splits
+                   RISCV64_A.arch_kernel_obj.splits)
 
 lemma eq_trans_helper:
   "\<lbrakk> x = y; P y = Q \<rbrakk> \<Longrightarrow> P x = Q"
@@ -414,7 +481,7 @@ definition state_relation :: "(det_state \<times> kernel_state) set" where
          pspace_relation (kheap s) (ksPSpace s')
        \<and> ekheap_relation (ekheap s) (ksPSpace s')
        \<and> sched_act_relation (scheduler_action s) (ksSchedulerAction s')
-       \<and> ready_queues_relation (ready_queues s) (ksReadyQueues s')
+       \<and> ready_queues_relation s 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')
@@ -436,6 +503,10 @@ lemma curthread_relation:
   "(a, b) \<in> state_relation \<Longrightarrow> ksCurThread b = cur_thread a"
   by (simp add: state_relation_def)
 
+lemma curdomain_relation[elim!]:
+  "(s, s') \<in> state_relation \<Longrightarrow> cur_domain s = ksCurDomain s'"
+  by (clarsimp simp: state_relation_def)
+
 lemma state_relation_pspace_relation[elim!]:
   "(s,s') \<in> state_relation \<Longrightarrow> pspace_relation (kheap s) (ksPSpace s')"
   by (simp add: state_relation_def)
@@ -444,12 +515,24 @@ lemma state_relation_ekheap_relation[elim!]:
   "(s,s') \<in> state_relation \<Longrightarrow> ekheap_relation (ekheap s) (ksPSpace s')"
   by (simp add: state_relation_def)
 
+lemma state_relation_sched_act_relation[elim!]:
+  "(s,s') \<in> state_relation \<Longrightarrow> sched_act_relation (scheduler_action s) (ksSchedulerAction s')"
+  by (clarsimp simp: state_relation_def)
+
+lemma state_relation_ready_queues_relation[elim!]:
+  "(s, s') \<in> state_relation \<Longrightarrow> ready_queues_relation s s'"
+  by (simp add: state_relation_def)
+
+lemma state_relation_idle_thread[elim!]:
+  "(s, s') \<in> state_relation \<Longrightarrow> idle_thread s = ksIdleThread s'"
+  by (clarsimp simp: state_relation_def)
+
 lemma state_relationD:
   "(s, s') \<in> state_relation \<Longrightarrow>
    pspace_relation (kheap s) (ksPSpace s') \<and>
    ekheap_relation (ekheap s) (ksPSpace s') \<and>
    sched_act_relation (scheduler_action s) (ksSchedulerAction s') \<and>
-   ready_queues_relation (ready_queues s) (ksReadyQueues s') \<and>
+   ready_queues_relation s 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>
@@ -471,7 +554,7 @@ lemma state_relationE [elim?]:
   and rl: "\<lbrakk> pspace_relation (kheap s) (ksPSpace s');
              ekheap_relation (ekheap s) (ksPSpace s');
              sched_act_relation (scheduler_action s) (ksSchedulerAction s');
-             ready_queues_relation (ready_queues s) (ksReadyQueues s');
+             ready_queues_relation s 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');
diff --git a/proof/refine/RISCV64/Syscall_R.thy b/proof/refine/RISCV64/Syscall_R.thy
index b4efb3eac8..0cc5baccd4 100644
--- a/proof/refine/RISCV64/Syscall_R.thy
+++ b/proof/refine/RISCV64/Syscall_R.thy
@@ -351,15 +351,13 @@ lemma threadSet_tcbDomain_update_sch_act_wf[wp]:
 lemma setDomain_corres:
   "corres dc
      (valid_etcbs and valid_sched and tcb_at tptr and pspace_aligned and pspace_distinct)
-     (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)"
+     (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 corres_guard_imp)
     apply (rule corres_split[OF getCurThread_corres])
-      apply (rule corres_split[OF tcbSchedDequeue_corres])
+      apply (rule corres_split[OF tcbSchedDequeue_corres], simp)
         apply (rule corres_split)
            apply (rule ethread_set_corres; simp)
            apply (clarsimp simp: etcb_relation_def)
@@ -368,26 +366,38 @@ lemma setDomain_corres:
             apply (rule corres_split)
                apply clarsimp
                apply (rule corres_when[OF refl])
-               apply (rule tcbSchedEnqueue_corres)
+               apply (rule tcbSchedEnqueue_corres, simp)
               apply (rule corres_when[OF refl])
               apply (rule rescheduleRequired_corres)
-             apply ((wp hoare_drop_imps hoare_vcg_conj_lift | clarsimp| assumption)+)[5]
-        apply clarsimp
-        apply (rule_tac Q="\<lambda>_. valid_objs' and valid_queues' and valid_queues and
-          (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and tcb_at' tptr"
-          in hoare_strengthen_post[rotated])
-         apply (auto simp: invs'_def valid_state'_def sch_act_wf_weak st_tcb_at'_def o_def)[1]
-        apply (wp threadSet_valid_objs' threadSet_valid_queues'_no_state
-          threadSet_valid_queues_no_state
-          threadSet_pred_tcb_no_state | simp)+
-      apply (rule_tac Q = "\<lambda>r s. invs' s \<and> (\<forall>p. tptr \<notin> set (ksReadyQueues s p)) \<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)
-       apply (drule(1) bspec)
-       apply (clarsimp simp:tcb_cte_cases_def cteSizeBits_def)
+             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 Tcb_R.tcbSchedDequeue_not_in_queue)+
+      apply (wp hoare_vcg_all_lift tcbSchedDequeue_not_queued)+
    apply clarsimp
    apply (frule tcb_at_is_etcb_at)
     apply simp+
@@ -395,7 +405,6 @@ lemma setDomain_corres:
                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> (=))
@@ -762,90 +771,71 @@ 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>rv. invs'\<rbrace>"
+   doReplyTransfer t' t slot grant
+   \<lbrace>\<lambda>_. invs'\<rbrace>"
   apply (simp add: doReplyTransfer_def liftM_def)
   apply (rule hoare_seq_ext [OF _ gts_sp'])
   apply (rule hoare_seq_ext [OF _ assert_sp])
   apply (rule hoare_seq_ext [OF _ getCTE_sp])
   apply (wp, wpc)
-        apply (wp)
+        apply wp
           apply (wp (once) sts_invs_minor'')
-          apply (simp)
+          apply simp
           apply (wp (once) sts_st_tcb')
-          apply (wp)[1]
-         apply (rule_tac Q="\<lambda>rv s. invs' s
-                                   \<and> t \<noteq> ksIdleThread s
-                                   \<and> st_tcb_at' awaiting_reply' t s"
+          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 (frule_tac t=t in invs'_not_runnable_not_queued)
-           apply (erule pred_tcb'_weakenE, case_tac st, clarsimp+)
+          apply clarsimp
           apply (rule conjI, erule pred_tcb'_weakenE, case_tac st, clarsimp+)
-          apply (rule conjI, rule impI, erule pred_tcb'_weakenE, case_tac st)
-                  apply (clarsimp | drule(1) obj_at_conj')+
           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 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 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])
+                               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 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>rv 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 (frule_tac t=t in invs'_not_runnable_not_queued)
-               apply (erule pred_tcb'_weakenE, case_tac st, clarsimp+)
+             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 (rule conjI, rule impI, erule pred_tcb'_weakenE, case_tac st)
-                      apply (clarsimp | drule(1) obj_at_conj')+
               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 clarsimp
               apply (erule_tac P="\<lambda>st. awaiting_reply' st \<and> activatable' st"
-                      in pred_tcb'_weakenE)
+                            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 clarsimp
             apply (rule conjI)
-             apply (clarsimp simp: invs'_def valid_state'_def valid_idle'_def)
-             apply (rule conjI)
-              apply clarsimp
-             apply (clarsimp simp: obj_at'_def idle_tcb'_def pred_tcb_at'_def)
+             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 (rule conjI)
              apply (clarsimp simp : invs'_def valid_state'_def valid_idle'_def pred_tcb_at'_def
                                     obj_at'_def idle_tcb'_def)
-            apply (rule conjI)
-             apply clarsimp
-             apply (frule invs'_not_runnable_not_queued)
-              apply (erule pred_tcb'_weakenE, clarsimp)
-             apply (frule (1) not_tcbQueued_not_ksQ)
-             apply simp
-            apply clarsimp
            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)
@@ -855,35 +845,9 @@ lemma ct_active_runnable' [simp]:
   "ct_active' s \<Longrightarrow> ct_in_state' runnable' s"
   by (fastforce simp: ct_in_state'_def elim!: pred_tcb'_weakenE)
 
-lemma valid_irq_node_tcbSchedEnqueue[wp]:
-  "\<lbrace>\<lambda>s. valid_irq_node' (irq_node' s) s \<rbrace> tcbSchedEnqueue ptr
-  \<lbrace>\<lambda>rv s'. valid_irq_node' (irq_node' s') s'\<rbrace>"
-  apply (rule hoare_pre)
-  apply (simp add:valid_irq_node'_def )
-  apply (wp unless_wp hoare_vcg_all_lift | wps)+
-  apply (simp add:tcbSchedEnqueue_def)
-  apply (wp unless_wp| simp)+
-  apply (simp add:valid_irq_node'_def)
-  done
-
-lemma rescheduleRequired_valid_queues_but_ct_domain:
-  "\<lbrace>\<lambda>s. Invariants_H.valid_queues s \<and> valid_objs' s
-     \<and> (\<forall>x. ksSchedulerAction s = SwitchToThread x \<longrightarrow> st_tcb_at' runnable' x s) \<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | wpc | simp)+
-  done
-
-lemma rescheduleRequired_valid_queues'_but_ct_domain:
-  "\<lbrace>\<lambda>s. valid_queues' s
-     \<and> (\<forall>x. ksSchedulerAction s = SwitchToThread x \<longrightarrow> st_tcb_at' runnable' x s)
-   \<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | wpc | simp | fastforce simp: valid_queues'_def)+
-  done
+crunches tcbSchedEnqueue
+  for valid_irq_node[wp]: "\<lambda>s. valid_irq_node' (irq_node' s) s"
+  (rule: valid_irq_node_lift)
 
 lemma tcbSchedEnqueue_valid_action:
   "\<lbrace>\<lambda>s. \<forall>x. ksSchedulerAction s = SwitchToThread x \<longrightarrow> st_tcb_at' runnable' x s\<rbrace>
@@ -894,9 +858,10 @@ lemma tcbSchedEnqueue_valid_action:
   done
 
 abbreviation (input) "all_invs_but_sch_extra \<equiv>
-    \<lambda>s. valid_pspace' s \<and> Invariants_H.valid_queues s \<and>
+    \<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>
@@ -908,7 +873,7 @@ abbreviation (input) "all_invs_but_sch_extra \<equiv>
     valid_machine_state' s \<and>
     cur_tcb' s \<and>
     untyped_ranges_zero' s \<and>
-    valid_queues' s \<and> pspace_domain_valid 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)"
 
@@ -917,18 +882,13 @@ 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 (rule hoare_pre)
-  apply (wp add:rescheduleRequired_ct_not_inQ
-    rescheduleRequired_sch_act'
-    rescheduleRequired_valid_queues_but_ct_domain
-    rescheduleRequired_valid_queues'_but_ct_domain
-    valid_irq_node_lift valid_irq_handlers_lift''
-    irqs_masked_lift cur_tcb_lift)
+  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 (\<lambda>s. (\<forall>p. t \<notin> set (ksReadyQueues s p))) and
+  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
@@ -948,13 +908,11 @@ lemma threadSet_all_invs_but_sch_extra:
      valid_irq_handlers_lift''
      threadSet_ctes_ofT
      threadSet_not_inQ
-     threadSet_valid_queues'_no_state
      threadSet_tcbDomain_update_ct_idle_or_in_cur_domain'
-     threadSet_valid_queues
      threadSet_valid_dom_schedule'
      threadSet_iflive'T
      threadSet_ifunsafe'T
-     untyped_ranges_zero_lift
+     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)
@@ -982,9 +940,7 @@ lemma setDomain_invs':
       \<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 (erule st_tcb_ex_cap'')
        apply simp
-      apply (case_tac st,simp_all)[1]
      apply (rule hoare_strengthen_post[OF hoare_vcg_conj_lift])
        apply (rule threadSet_all_invs_but_sch_extra)
       prefer 2
@@ -1002,17 +958,14 @@ lemma setDomain_invs':
   done
 
 lemma performInv_invs'[wp]:
-  "\<lbrace>invs' and sch_act_simple
-          and (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))
-          and ct_active' and valid_invocation' i\<rbrace>
-     RetypeDecls_H.performInvocation block call i \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  "\<lbrace>invs' and sch_act_simple and ct_active' and valid_invocation' i\<rbrace>
+   RetypeDecls_H.performInvocation block call i
+   \<lbrace>\<lambda>_. invs'\<rbrace>"
   unfolding performInvocation_def
   apply (cases i)
-  apply ((clarsimp simp: simple_sane_strg sch_act_simple_def
-                         ct_not_ksQ sch_act_sane_def
-                  | wp tcbinv_invs' arch_performInvocation_invs'
-                       setDomain_invs'
-                  | rule conjI | erule active_ex_cap')+)
+  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]:
@@ -1240,7 +1193,6 @@ lemma handleInvocation_corres:
                                       and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)"
                          in hoare_post_imp)
                apply (clarsimp simp: ct_in_state'_def)
-               apply (frule(1) ct_not_ksQ)
                apply (clarsimp)
               apply (wp setThreadState_nonqueued_state_update
                         setThreadState_st_tcb setThreadState_rct)[1]
@@ -1252,14 +1204,13 @@ lemma handleInvocation_corres:
                          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)
+   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)
   apply (frule tcb_at_invs')
   apply (clarsimp simp: invs'_def valid_state'_def
                         ct_in_state'_def ct_not_inQ_def)
-  apply (frule(1) valid_queues_not_tcbQueued_not_ksQ)
   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)
@@ -1319,11 +1270,8 @@ lemma hinv_invs'[wp]:
                                 and st_tcb_at' active' thread"
                   in hoare_post_imp)
         apply (clarsimp simp: ct_in_state'_def)
-        apply (frule(1) ct_not_ksQ)
-        apply (clarsimp)
        apply (wp sts_invs_minor' setThreadState_st_tcb setThreadState_rct | simp)+
     apply (clarsimp)
-    apply (frule(1) ct_not_ksQ)
     apply (fastforce simp add: tcb_at_invs' ct_in_state'_def
                               simple_sane_strg
                               sch_act_simple_def
@@ -1467,7 +1415,6 @@ lemma handleRecv_isBlocking_corres':
                     and (\<lambda>s. ex_nonz_cap_to (cur_thread s) s))
               (invs' and ct_in_state' simple'
                      and sch_act_sane
-                     and (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))
                      and (\<lambda>s. ex_nonz_cap_to' (ksCurThread s) s))
                     (handle_recv isBlocking) (handleRecv isBlocking)"
   (is "corres dc (?pre1) (?pre2) (handle_recv _) (handleRecv _)")
@@ -1530,8 +1477,7 @@ lemma handleRecv_isBlocking_corres':
 
 lemma handleRecv_isBlocking_corres:
   "corres dc (einvs and ct_active)
-             (invs' and ct_active' and sch_act_sane and
-                    (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)))
+             (invs' and ct_active' and sch_act_sane)
             (handle_recv isBlocking) (handleRecv isBlocking)"
   apply (rule corres_guard_imp)
     apply (rule handleRecv_isBlocking_corres')
@@ -1546,42 +1492,27 @@ lemma lookupCap_refs[wp]:
   "\<lbrace>invs'\<rbrace> lookupCap t ref \<lbrace>\<lambda>rv s. \<forall>r\<in>zobj_refs' rv. ex_nonz_cap_to' r s\<rbrace>,-"
   by (simp add: lookupCap_def split_def | wp | simp add: o_def)+
 
-lemma deleteCallerCap_ksQ_ct':
-  "\<lbrace>invs' and ct_in_state' simple' and sch_act_sane and
-     (\<lambda>s. ksCurThread s \<notin> set (ksReadyQueues s p) \<and> thread = ksCurThread s)\<rbrace>
-      deleteCallerCap thread
-   \<lbrace>\<lambda>rv s. thread \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (rule_tac Q="\<lambda>rv s. thread = ksCurThread s \<and> ksCurThread s \<notin> set (ksReadyQueues s p)"
-            in hoare_strengthen_post)
-   apply (wp deleteCallerCap_ct_not_ksQ)
-    apply auto
-  done
-
 lemma hw_invs'[wp]:
   "\<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)
-          and (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))\<rbrace>
+          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
-                           deleteCallerCap_ksQ_ct'
                            hoare_lift_Pf2[OF deleteCallerCap_simple
                            deleteCallerCap_ct']
                       | wpc | simp)+)[1]
                apply simp
                apply (wp deleteCallerCap_nonz_cap hoare_vcg_all_lift
-                         deleteCallerCap_ksQ_ct'
                          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> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))
                              \<and> thread = ksCurThread s
                              \<and> ct_in_state' simple' s
                              \<and> ex_nonz_cap_to' thread s
@@ -1605,34 +1536,45 @@ lemma setSchedulerAction_obj_at'[wp]:
   by (wp, clarsimp elim!: obj_at'_pspaceI)
 
 lemma handleYield_corres:
-  "corres dc einvs (invs' and ct_active' and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)) handle_yield handleYield"
+  "corres dc
+     (einvs and ct_active)
+     (invs' and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread))
+     handle_yield handleYield"
   apply (clarsimp simp: handle_yield_def handleYield_def)
   apply (rule corres_guard_imp)
     apply (rule corres_split[OF getCurThread_corres])
       apply simp
-      apply (rule corres_split[OF tcbSchedDequeue_corres])
-        apply (rule corres_split[OF tcbSchedAppend_corres])
+      apply (rule corres_split[OF tcbSchedDequeue_corres], simp)
+        apply (rule corres_split[OF tcbSchedAppend_corres], simp)
           apply (rule rescheduleRequired_corres)
-         apply (wp weak_sch_act_wf_lift_linear tcbSchedDequeue_valid_queues | simp add: )+
+         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)
-  apply clarsimp
-  apply (frule ct_active_runnable')
-  apply (clarsimp simp: invs'_def valid_state'_def ct_in_state'_def sch_act_wf_weak 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)
-  apply (erule(1) valid_objs_valid_tcbE[OF valid_pspace_valid_objs'])
-  apply (simp add:valid_tcb'_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 hy_invs':
   "\<lbrace>invs' and ct_active'\<rbrace> handleYield \<lbrace>\<lambda>r. invs' and ct_active'\<rbrace>"
   apply (simp add: handleYield_def)
-  apply (wp ct_in_state_thread_state_lift'
-            rescheduleRequired_all_invs_but_ct_not_inQ
-            tcbSchedAppend_invs_but_ct_not_inQ' | simp)+
-  apply (clarsimp simp add: 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
-                   )
+  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
 
@@ -1828,7 +1770,7 @@ 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 haskell_assert_wp doReplyTransfer_sane getCTE_wp'| wpc)+
+   apply (wp doReplyTransfer_sane getCTE_wp'| wpc)+
   apply (clarsimp simp: cte_wp_at_ctes_of)
   done
 
@@ -1844,74 +1786,6 @@ lemma handleReply_nonz_cap_to_ct:
 
 crunch ksQ[wp]: handleFaultReply "\<lambda>s. P (ksReadyQueues s p)"
 
-lemma doReplyTransfer_ct_not_ksQ:
-  "\<lbrace> invs' and sch_act_simple
-           and tcb_at' thread and tcb_at' word
-           and ct_in_state' simple'
-           and (\<lambda>s. ksCurThread s \<noteq> word)
-           and (\<lambda>s. \<forall>p. ksCurThread s \<notin> set(ksReadyQueues s p))\<rbrace>
-   doReplyTransfer thread word callerSlot g
-   \<lbrace>\<lambda>rv s. \<forall>p. ksCurThread s \<notin> set(ksReadyQueues s p)\<rbrace>"
-proof -
-  have astct: "\<And>t p.
-       \<lbrace>(\<lambda>s. ksCurThread s \<notin> set(ksReadyQueues s p) \<and> sch_act_sane s)
-             and (\<lambda>s. ksCurThread s \<noteq> t)\<rbrace>
-       possibleSwitchTo t \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set(ksReadyQueues s p)\<rbrace>"
-    apply (rule hoare_weaken_pre)
-     apply (wps possibleSwitchTo_ct')
-     apply (wp possibleSwitchTo_ksQ')
-    apply (clarsimp simp: sch_act_sane_def)
-    done
-  have stsct: "\<And>t st p.
-       \<lbrace>(\<lambda>s. ksCurThread s \<notin> set(ksReadyQueues s p)) and sch_act_simple\<rbrace>
-       setThreadState st t
-       \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set(ksReadyQueues s p)\<rbrace>"
-    apply (rule hoare_weaken_pre)
-     apply (wps setThreadState_ct')
-     apply (wp hoare_vcg_all_lift sts_ksQ)
-    apply (clarsimp)
-    done
-  show ?thesis
-    apply (simp add: doReplyTransfer_def)
-    apply (wp, wpc)
-            apply (wp astct stsct hoare_vcg_all_lift
-                      cteDeleteOne_ct_not_ksQ hoare_drop_imp
-                      hoare_lift_Pf2 [OF cteDeleteOne_sch_act_not cteDeleteOne_ct']
-                      hoare_lift_Pf2 [OF doIPCTransfer_pred_tcb_at' doIPCTransfer_ct']
-                      hoare_lift_Pf2 [OF doIPCTransfer_ksQ doIPCTransfer_ct']
-                      hoare_lift_Pf2 [OF threadSet_ksQ threadSet_ct]
-                      hoare_lift_Pf2 [OF handleFaultReply_ksQ handleFaultReply_ct']
-                   | simp add: ct_in_state'_def)+
-     apply (fastforce simp: sch_act_simple_def sch_act_sane_def ct_in_state'_def)+
-    done
-qed
-
-lemma handleReply_ct_not_ksQ:
-  "\<lbrace>invs' and sch_act_simple
-           and ct_in_state' simple'
-           and (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))\<rbrace>
-   handleReply
-   \<lbrace>\<lambda>rv s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: handleReply_def del: split_paired_All)
-  apply (subst haskell_assert_def)
-  apply (wp | wpc)+
-  apply (wp doReplyTransfer_ct_not_ksQ getThreadCallerSlot_inv)+
-    apply (rule_tac Q="\<lambda>cap.
-                              (\<lambda>s. \<forall>p. ksCurThread s \<notin> set(ksReadyQueues s p))
-                          and invs'
-                          and sch_act_simple
-                          and (\<lambda>s. thread = ksCurThread s)
-                          and tcb_at' thread
-                          and ct_in_state' simple'
-                          and cte_wp_at' (\<lambda>c. cteCap c = cap) callerSlot"
-             in hoare_post_imp)
-     apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def
-                           cte_wp_at_ctes_of valid_cap'_def
-                    dest!: ctes_of_valid')
-    apply (wp getSlotCap_cte_wp_at getThreadCallerSlot_inv)+
-  apply (clarsimp)
-  done
-
 crunch valid_etcbs[wp]: handle_recv "valid_etcbs"
   (wp: crunch_wps simp: crunch_simps)
 
@@ -1924,11 +1798,10 @@ lemma handleReply_handleRecv_corres:
     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 handleReply_ct_not_ksQ handle_reply_valid_sched)+
+               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 (frule(1) ct_not_ksQ)
   apply (fastforce elim: pred_tcb'_weakenE)
   done
 
@@ -1936,7 +1809,6 @@ lemma handleHypervisorFault_corres:
   "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 (\<lambda>s. \<forall>p. thread \<notin> set(ksReadyQueues s p))
                     and st_tcb_at' simple' thread and ex_nonz_cap_to' thread)
           (handle_hypervisor_fault w fault) (handleHypervisorFault w fault)"
   apply (cases fault; clarsimp simp add: handleHypervisorFault_def returnOk_def2)
@@ -1952,14 +1824,13 @@ lemma handleEvent_corres:
   (is "?handleEvent_corres")
 proof -
   have hw:
-    "\<And>isBlocking. corres dc (einvs and ct_running and (\<lambda>s. scheduler_action s = resume_cur_thread))
+    "\<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
-                     dest!: ct_not_ksQ)+
+                     elim!: st_tcb_weakenE pred_tcb'_weakenE)+
     done
     show ?thesis
       apply (case_tac event)
@@ -1974,7 +1845,7 @@ proof -
                                      corres_guard_imp[OF handleCall_corres]
                                      corres_guard_imp[OF handleYield_corres]
                                      active_from_running active_from_running'
-                              simp: simple_sane_strg)[8]
+                              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)
@@ -1985,7 +1856,6 @@ proof -
                             simp: ct_in_state_def)
           apply wp
           apply (clarsimp)
-          apply (frule(1) ct_not_ksQ)
           apply (auto simp: ct_in_state'_def sch_act_simple_def
                             sch_act_sane_def
                       elim: pred_tcb'_weakenE st_tcb_ex_cap'')[1]
@@ -1998,12 +1868,11 @@ proof -
                            simp: ct_in_state_def valid_fault_def)
          apply wp
          apply clarsimp
-         apply (frule(1) ct_not_ksQ)
          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>rv. einvs"
+          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)
@@ -2013,7 +1882,6 @@ proof -
             apply (rule handleInterrupt_corres)
            apply (wp hoare_vcg_all_lift
                      doMachineOp_getActiveIRQ_IRQ_active'
-                    | simp
                     | simp add: imp_conjR | wp (once) hoare_drop_imps)+
         apply (simp add: invs'_def valid_state'_def)
        apply (rule_tac corres_underlying_split)
@@ -2030,7 +1898,6 @@ proof -
         apply (fastforce elim!: st_tcb_ex_cap st_tcb_weakenE simp: ct_in_state_def)
        apply wp
        apply (clarsimp)
-       apply (frule(1) ct_not_ksQ)
        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)
@@ -2042,7 +1909,6 @@ proof -
                         simp: ct_in_state_def)
       apply wp
       apply (clarsimp)
-      apply (frule(1) ct_not_ksQ)
       apply (auto simp: ct_in_state'_def sch_act_simple_def
                         sch_act_sane_def
                   elim: pred_tcb'_weakenE st_tcb_ex_cap'')[1]
@@ -2129,10 +1995,8 @@ proof -
         apply (rename_tac syscall)
         apply (case_tac syscall,
                (wp handleReply_sane handleReply_nonz_cap_to_ct handleReply_ksCurThread
-                   handleReply_ct_not_ksQ
                 | clarsimp simp: active_from_running' simple_from_running' simple_sane_strg simp del: split_paired_All
                 | rule conjI active_ex_cap'
-                | drule ct_not_ksQ[rotated]
                 | strengthen nidle)+)
         apply (rule hoare_strengthen_post,
                rule hoare_weaken_pre,
@@ -2144,7 +2008,6 @@ proof -
                  | 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'
-                 | drule ct_not_ksQ[rotated]
                  | wpc | wp (once) hoare_drop_imps)+
   done
 qed
diff --git a/proof/refine/RISCV64/TcbAcc_R.thy b/proof/refine/RISCV64/TcbAcc_R.thy
index f2d9fbb4e4..c86796f3bb 100644
--- a/proof/refine/RISCV64/TcbAcc_R.thy
+++ b/proof/refine/RISCV64/TcbAcc_R.thy
@@ -58,10 +58,8 @@ lemma getHighestPrio_inv[wp]:
   unfolding bitmap_fun_defs by simp
 
 lemma valid_bitmapQ_bitmapQ_simp:
-  "\<lbrakk> valid_bitmapQ s \<rbrakk> \<Longrightarrow>
-   bitmapQ d p s = (ksReadyQueues s (d, p) \<noteq> [])"
-   unfolding valid_bitmapQ_def
-   by simp
+  "valid_bitmapQ s \<Longrightarrow> bitmapQ d p s = (\<not> tcbQueueEmpty (ksReadyQueues s (d, p)))"
+  by (simp add: valid_bitmapQ_def)
 
 lemma prioToL1Index_l1IndexToPrio_or_id:
   "\<lbrakk> unat (w'::priority) < 2 ^ wordRadix ; w < 2^(size w' - wordRadix) \<rbrakk>
@@ -84,34 +82,18 @@ 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 :: "machine_word \<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 and runnable' \<circ> tcbState) t s)
-    \<and>  distinct (ksReadyQueues s (d, p))
-    \<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
-
 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 objBits_simps)
-  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
-                        RISCV64_A.arch_kernel_obj.split_asm)+
-  apply fastforce
-  done
+  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"
@@ -132,10 +114,11 @@ lemma pspace_relation_tcb_at':
   assumes t: "tcb_at t a"
   assumes aligned: "pspace_aligned' c"
   assumes distinct: "pspace_distinct' c"
-  shows "tcb_at' t c" using assms
+  shows "tcb_at' t c"
+  using assms
   apply (clarsimp simp: obj_at_def)
   apply (drule(1) pspace_relation_absD)
-  apply (clarsimp simp: is_tcb other_obj_relation_def)
+  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)
@@ -143,13 +126,24 @@ lemma pspace_relation_tcb_at':
   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'"
+  "\<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 is_tcb_def
+              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'"
@@ -166,24 +160,82 @@ lemma cur_tcb_cross:
   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"
+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"
+  using assms
   apply (clarsimp simp add: 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)
   done
 
-lemma valid_objs'_maxDomain:
-  "\<And>s t. \<lbrakk> valid_objs' s; tcb_at' t s \<rbrakk> \<Longrightarrow> obj_at' (\<lambda>tcb. tcbDomain tcb \<le> maxDomain) t s"
-  apply (erule (1) valid_objs_valid_tcbE)
-  apply (clarsimp simp: valid_tcb'_def)
+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
+  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 objBits_simps')
+  done
+
+definition valid_tcbs' :: "kernel_state \<Rightarrow> bool" where
+  "valid_tcbs' s' \<equiv> \<forall>ptr tcb. ksPSpace s' ptr = Some (KOTCB tcb) \<longrightarrow> valid_tcb' tcb s'"
+
+lemma valid_objs'_valid_tcbs'[elim!]:
+  "valid_objs' s \<Longrightarrow> valid_tcbs' s"
+  by (auto simp: valid_objs'_def valid_tcbs'_def valid_obj'_def split: kernel_object.splits)
+
+lemma invs'_valid_tcbs'[elim!]:
+  "invs' s \<Longrightarrow> valid_tcbs' s"
+  by (fastforce intro: valid_objs'_valid_tcbs')
+
+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 valid_tcb'_def)
+  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 valid_tcb'_def)
   done
 
-lemma valid_objs'_maxPriority:
-  "\<And>s t. \<lbrakk> valid_objs' s; tcb_at' t s \<rbrakk> \<Longrightarrow> obj_at' (\<lambda>tcb. tcbPriority tcb \<le> maxPriority) t s"
-  apply (erule (1) valid_objs_valid_tcbE)
-  apply (clarsimp simp: valid_tcb'_def)
+lemmas valid_objs'_maxPriority = valid_tcbs'_maxPriority[OF valid_objs'_valid_tcbs']
+
+lemma valid_tcbs'_obj_at':
+  assumes "valid_tcbs' 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"
+  using assms
+  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)
   done
 
+lemma update_valid_tcb'[simp]:
+  "\<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"
+  "\<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_valid_tcbs'[simp]:
+  "\<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':
   assumes masks: "\<And>P. \<lbrace>\<lambda>s. P (irq_masks s)\<rbrace> f \<lbrace>\<lambda>_ s. P (irq_masks s)\<rbrace>"
   shows "\<lbrace>valid_irq_states'\<rbrace> doMachineOp f \<lbrace>\<lambda>rv. valid_irq_states'\<rbrace>"
@@ -281,49 +333,109 @@ lemma updateObject_tcb_inv:
   by simp (rule updateObject_default_inv)
 
 lemma setObject_update_TCB_corres':
-  assumes tcbs: "tcb_relation tcb tcb' \<Longrightarrow> tcb_relation tcbu tcbu'"
-  assumes tables: "\<forall>(getF, v) \<in> ran tcb_cap_cases. getF tcbu = getF tcb"
-  assumes tables': "\<forall>(getF, v) \<in> ran tcb_cte_cases. getF tcbu' = getF tcb'"
+  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"
+  assumes tables': "\<forall>(getF, v) \<in> ran tcb_cte_cases. getF new_tcb' = getF tcb'"
+  assumes sched_pointers: "tcbSchedPrev new_tcb' = tcbSchedPrev tcb'"
+                          "tcbSchedNext new_tcb' = tcbSchedNext tcb'"
+  assumes flag: "tcbQueued new_tcb' = tcbQueued tcb'"
   assumes r: "r () ()"
-  assumes exst: "exst_same tcb' tcbu'"
-  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' \<and> exst_same tcb' tcbu'" 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: other_obj_relation_def exst)
-  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
-                           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: 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)
+  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
+                  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 () (); exst_same tcb' tcbu'\<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 fastforce
-  apply (clarsimp simp: getObject_def in_monad split_def obj_at'_def
-                        loadObject_default_def objBits_simps' in_magnitude_check)
+    apply (erule (7) setObject_update_TCB_corres')
+   apply (clarsimp simp: getObject_def in_monad split_def obj_at'_def
+                         loadObject_default_def objBits_simps' in_magnitude_check)+
   done
 
 lemma getObject_TCB_corres:
@@ -363,7 +475,8 @@ lemma ball_tcb_cte_casesI:
   by (simp add: tcb_cte_cases_def cteSizeBits_def)
 
 lemma all_tcbI:
-  "\<lbrakk> \<And>a b c d e f g h i j k l m n p q. P (Thread a b c d e f g h i j k l m n p q) \<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:
@@ -372,6 +485,9 @@ 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"
+  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>
@@ -380,10 +496,13 @@ lemma threadset_corresT:
   apply (rule corres_guard_imp)
     apply (rule corres_split[OF getObject_TCB_corres])
       apply (rule setObject_update_TCB_corres')
-          apply (erule x)
-         apply (rule y)
-        apply (clarsimp simp: bspec_split [OF spec [OF z]])
-        apply fastforce
+             apply (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+
@@ -413,6 +532,9 @@ lemma threadSet_corres_noopT:
                          tcb_relation tcb (fn tcb')"
   assumes y: "\<forall>tcb. \<forall>(getF, setF) \<in> ran tcb_cte_cases.
                  getF (fn tcb) = getF tcb"
+  assumes s: "\<forall>tcb'. tcbSchedPrev (fn tcb') = tcbSchedPrev tcb'"
+             "\<forall>tcb'. tcbSchedNext (fn tcb') = tcbSchedNext tcb'"
+  assumes f: "\<And>tcb'. tcbQueued (fn tcb') = tcbQueued tcb'"
   assumes e: "\<And>tcb'. exst_same tcb' (fn tcb')"
   shows      "corres dc (tcb_at t and pspace_aligned and pspace_distinct) \<top>
                         (return v) (threadSet fn t)"
@@ -431,9 +553,12 @@ proof -
        defer
        apply (subst bind_return [symmetric],
               rule corres_underlying_split [OF threadset_corresT])
-             apply (simp add: x)
-            apply simp
-           apply (rule y)
+                apply (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
@@ -452,14 +577,20 @@ 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>"
+  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)+
@@ -686,16 +817,23 @@ lemma threadSet_valid_pspace'T_P:
   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 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)\<rbrace>
-     threadSet F t
-   \<lbrace>\<lambda>rv. valid_pspace'\<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>_. valid_pspace'\<rbrace>"
   apply (simp add: valid_pspace'_def threadSet_def)
   apply (rule hoare_pre,
          wp setObject_tcb_valid_objs getObject_tcb_wp)
@@ -703,7 +841,7 @@ lemma threadSet_valid_pspace'T_P:
   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 v w')
+                            split_paired_Ball y u w v w' p n)
   done
 
 lemmas threadSet_valid_pspace'T =
@@ -777,6 +915,10 @@ lemma threadSet_iflive'T:
               \<and> tcbState (F tcb) \<noteq> Inactive
               \<and> tcbState (F tcb) \<noteq> IdleThreadState
               \<and> ko_at' tcb t s) \<longrightarrow> ex_nonz_cap_to' t s)
+      \<and> ((\<exists>tcb. tcbSchedNext tcb = None \<and> tcbSchedNext (F tcb) \<noteq> None
+              \<and> ko_at' tcb t s) \<longrightarrow> ex_nonz_cap_to' t s)
+      \<and> ((\<exists>tcb. tcbSchedPrev tcb = None \<and> tcbSchedPrev (F tcb) \<noteq> None
+              \<and> ko_at' tcb t s) \<longrightarrow> ex_nonz_cap_to' t s)
       \<and> ((\<exists>tcb. \<not> tcbQueued tcb \<and> tcbQueued (F tcb)
               \<and> ko_at' tcb t s) \<longrightarrow> ex_nonz_cap_to' t s)\<rbrace>
      threadSet F t
@@ -784,8 +926,7 @@ lemma threadSet_iflive'T:
   apply (simp add: threadSet_def)
   apply (wp setObject_tcb_iflive' getObject_tcb_wp)
   apply (clarsimp simp: obj_at'_def)
-  apply (subst conj_assoc[symmetric], subst imp_disjL[symmetric])
-  apply (subst conj_assoc[symmetric], subst imp_disjL[symmetric])
+  apply (subst conj_assoc[symmetric], subst imp_disjL[symmetric])+
   apply (rule conjI)
    apply (rule impI, clarsimp)
    apply (erule if_live_then_nonz_capE')
@@ -831,6 +972,12 @@ lemmas threadSet_ctes_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)
+  \<Longrightarrow> threadSet f tptr \<lbrace>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 objBits_simps')
+
 lemma threadSet_idle'T:
   assumes x: "\<forall>tcb. \<forall>(getF, setF) \<in> ran tcb_cte_cases. getF (F tcb) = getF tcb"
   shows
@@ -868,30 +1015,6 @@ lemma set_tcb_bitmapQ_no_L2_orphans[wp]:
   apply (wp hoare_Ball_helper hoare_vcg_all_lift updateObject_default_inv | simp add: bitmapQ_def)+
   done
 
-lemma threadSet_valid_queues_no_bitmap:
-  "\<lbrace> valid_queues_no_bitmap and
-    (\<lambda>s. \<forall>d p. (\<exists>tcb. (inQ d p tcb \<and> runnable' (tcbState tcb)) \<and>
-                     \<not>(inQ d p (f tcb) \<and> runnable' (tcbState (f tcb))))
-                \<longrightarrow> obj_at' (\<lambda>tcb. (inQ d p tcb \<and> runnable' (tcbState tcb)) \<and>
-                                 \<not>(inQ d p (f tcb) \<and> runnable' (tcbState (f tcb)))) t s
-                \<longrightarrow> t \<notin> set (ksReadyQueues s (d, p))
-    )\<rbrace>
-     threadSet f t
-   \<lbrace>\<lambda>rv. valid_queues_no_bitmap \<rbrace>"
-  apply (simp add: threadSet_def)
-  apply wp
-   apply (simp add: Invariants_H.valid_queues_no_bitmap_def' pred_tcb_at'_def)
-
-   apply (wp setObject_queues_unchanged_tcb
-             hoare_Ball_helper
-             hoare_vcg_all_lift
-             setObject_tcb_strongest)[1]
-  apply (wp getObject_tcb_wp)
-  apply (clarsimp simp: valid_queues_no_bitmap_def' pred_tcb_at'_def)
-  apply (clarsimp simp: obj_at'_def)
-  apply (fastforce)
-  done
-
 lemma threadSet_valid_bitmapQ[wp]:
   "\<lbrace> valid_bitmapQ \<rbrace> threadSet f t \<lbrace> \<lambda>rv. valid_bitmapQ \<rbrace>"
   unfolding bitmapQ_defs threadSet_def
@@ -910,72 +1033,6 @@ lemma threadSet_valid_bitmapQ_no_L2_orphans[wp]:
   by (clarsimp simp: setObject_def split_def)
      (wp | simp add: updateObject_default_def)+
 
-lemma threadSet_valid_queues:
-  "\<lbrace>Invariants_H.valid_queues and
-    (\<lambda>s. \<forall>d p. (\<exists>tcb. (inQ d p tcb \<and> runnable' (tcbState tcb)) \<and>
-                     \<not>(inQ d p (f tcb) \<and> runnable' (tcbState (f tcb))))
-                \<longrightarrow> obj_at' (\<lambda>tcb. (inQ d p tcb \<and> runnable' (tcbState tcb)) \<and>
-                                 \<not>(inQ d p (f tcb) \<and> runnable' (tcbState (f tcb)))) t s
-                \<longrightarrow> t \<notin> set (ksReadyQueues s (d, p))
-    )\<rbrace>
-     threadSet f t
-   \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  unfolding valid_queues_def
-  by (wp threadSet_valid_queues_no_bitmap;simp)
-
-definition
-  addToQs :: "(Structures_H.tcb \<Rightarrow> Structures_H.tcb)
-                       \<Rightarrow> machine_word \<Rightarrow> (domain \<times> priority \<Rightarrow> machine_word list)
-                       \<Rightarrow> (domain \<times> priority \<Rightarrow> machine_word list)"
-where
- "addToQs F t \<equiv> \<lambda>qs (qdom, prio). if (\<forall>ko. \<not> inQ qdom prio (F ko))
-                             then t # qs (qdom, prio)
-                             else qs (qdom, prio)"
-
-lemma addToQs_set_def:
-  "(t' \<in> set (addToQs F t qs (qdom, prio))) = (t' \<in> set (qs (qdom, prio))
-      \<or> (t' = t \<and> (\<forall>ko. \<not> inQ qdom prio (F ko))))"
-  by (auto simp add: addToQs_def)
-
-lemma threadSet_valid_queues_addToQs:
-  "\<lbrace>\<lambda>s. (\<forall>ko qdom prio. ko_at' ko t s \<and> inQ qdom prio (F ko) \<and> \<not> inQ qdom prio ko
-            \<longrightarrow> t \<in> set (ksReadyQueues s (qdom, prio)))
-             \<and> valid_queues' (ksReadyQueues_update (addToQs F t) s)\<rbrace>
-     threadSet F t
-   \<lbrace>\<lambda>rv. 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 objBits_simps addToQs_set_def
-             split del: if_split cong: if_cong)
-  apply (fastforce split: if_split_asm)
-  done
-
-lemma threadSet_valid_queues_Qf:
-  "\<lbrace>\<lambda>s. (\<forall>ko qdom prio. ko_at' ko t s \<and> inQ qdom prio (F ko) \<and> \<not> inQ qdom prio ko
-            \<longrightarrow> t \<in> set (ksReadyQueues s (qdom, prio)))
-             \<and> valid_queues' (ksReadyQueues_update Qf s)
-             \<and> (\<forall>prio. set (Qf (ksReadyQueues s) prio)
-                        \<subseteq> set (addToQs F t (ksReadyQueues s) prio))\<rbrace>
-     threadSet F t
-   \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (wp threadSet_valid_queues_addToQs)
-  apply (clarsimp simp: valid_queues'_def subset_iff)
-  done
-
-lemma addToQs_subset:
-  "set (qs p) \<subseteq> set (addToQs F t qs p)"
-by (clarsimp simp: addToQs_def split_def)
-
-lemmas threadSet_valid_queues'
-  = threadSet_valid_queues_Qf
-       [where Qf=id, simplified ksReadyQueues_update_id
-                                id_apply addToQs_subset simp_thms]
-
 lemma threadSet_cur:
   "\<lbrace>\<lambda>s. cur_tcb' s\<rbrace> threadSet f t \<lbrace>\<lambda>rv s. cur_tcb' s\<rbrace>"
   apply (simp add: threadSet_def cur_tcb'_def)
@@ -991,7 +1048,7 @@ lemma modifyReadyQueuesL1Bitmap_obj_at[wp]:
 
 crunches setThreadState, setBoundNotification
   for valid_arch' [wp]: valid_arch_state'
-  (simp: unless_def crunch_simps)
+  (simp: unless_def crunch_simps wp: crunch_wps)
 
 crunch ksInterrupt'[wp]: threadSet "\<lambda>s. P (ksInterruptState s)"
   (wp: setObject_ksInterrupt updateObject_default_inv)
@@ -1244,56 +1301,103 @@ lemma threadSet_valid_dom_schedule':
   unfolding threadSet_def
   by (wp setObject_ksDomSchedule_inv hoare_Ball_helper)
 
+lemma threadSet_wp:
+  "\<lbrace>\<lambda>s. \<forall>tcb. ko_at' tcb t s \<longrightarrow> P (s\<lparr>ksPSpace := (ksPSpace s)(t \<mapsto> injectKO (f tcb))\<rparr>)\<rbrace>
+   threadSet f t
+   \<lbrace>\<lambda>_. P\<rbrace>"
+  unfolding threadSet_def setObject_def
+  apply (wpsimp wp: getObject_tcb_wp simp: updateObject_default_def)
+  apply (auto simp: obj_at'_def split: if_splits)
+  apply (erule rsubst[where P=P])
+  apply (clarsimp simp: fun_upd_def)
+  apply (prop_tac "\<forall>ptr. psMap (ksPSpace s) ptr = ksPSpace s ptr")
+   apply fastforce
+  apply metis
+  done
+
+lemma threadSet_sched_pointers:
+  "\<lbrakk>\<And>tcb. tcbSchedNext (F tcb) = tcbSchedNext tcb; \<And>tcb. tcbSchedPrev (F tcb) = tcbSchedPrev tcb\<rbrakk>
+   \<Longrightarrow> threadSet F tcbPtr \<lbrace>\<lambda>s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)\<rbrace>"
+  apply (wpsimp wp: threadSet_wp getObject_tcb_wp)
+  apply (erule rsubst2[where P=P])
+   apply (fastforce simp: opt_map_def obj_at'_def)
+  apply (fastforce simp: opt_map_def obj_at'_def)
+  done
+
+lemma threadSet_valid_sched_pointers:
+  "\<lbrakk>\<And>tcb. tcbSchedNext (F tcb) = tcbSchedNext tcb; \<And>tcb. tcbSchedPrev (F tcb) = tcbSchedPrev tcb;
+    \<And>tcb. tcbQueued (F tcb) = tcbQueued tcb\<rbrakk>
+   \<Longrightarrow> threadSet F tcbPtr \<lbrace>valid_sched_pointers\<rbrace>"
+  unfolding valid_sched_pointers_def
+  apply (wpsimp wp: threadSet_wp getObject_tcb_wp)
+  by (fastforce simp: opt_pred_def opt_map_def obj_at'_def split: option.splits if_splits)
+
+lemma threadSet_tcbSchedNexts_of:
+  "(\<And>tcb. tcbSchedNext (F tcb) = tcbSchedNext tcb) \<Longrightarrow>
+   threadSet F t \<lbrace>\<lambda>s. P (tcbSchedNexts_of s)\<rbrace>"
+  apply (wpsimp wp: threadSet_wp getObject_tcb_wp)
+  apply (erule rsubst[where P=P])
+  apply (fastforce simp: opt_map_def obj_at'_def)
+  done
+
+lemma threadSet_tcbSchedPrevs_of:
+  "(\<And>tcb. tcbSchedPrev (F tcb) = tcbSchedPrev tcb) \<Longrightarrow>
+   threadSet F t \<lbrace>\<lambda>s. P (tcbSchedPrevs_of s)\<rbrace>"
+  apply (wpsimp wp: threadSet_wp getObject_tcb_wp)
+  apply (erule rsubst[where P=P])
+  apply (fastforce simp: opt_map_def obj_at'_def)
+  done
+
+lemma threadSet_tcbQueued:
+  "(\<And>tcb. tcbQueued (F tcb) = tcbQueued tcb) \<Longrightarrow>
+   threadSet F t \<lbrace>\<lambda>s. P (tcbQueued |< tcbs_of' s)\<rbrace>"
+  apply (wpsimp wp: threadSet_wp getObject_tcb_wp)
+  apply (erule rsubst[where P=P])
+  apply (fastforce simp: opt_pred_def opt_map_def obj_at'_def)
+  done
+
+crunches threadSet
+  for ksReadyQueues[wp]: "\<lambda>s. P (ksReadyQueues s)"
+  and ksReadyQueuesL1Bitmap[wp]: "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
+  and ksReadyQueuesL2Bitmap[wp]: "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
+
 lemma threadSet_invs_trivialT:
-  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 \<and> tcbDomain (F tcb) = tcbDomain tcb"
-  assumes w: "\<forall>tcb. is_aligned (tcbIPCBuffer tcb) msg_align_bits \<longrightarrow> is_aligned (tcbIPCBuffer (F tcb)) msg_align_bits"
-  assumes a: "\<forall>tcb. tcbBoundNotification (F tcb) = tcbBoundNotification tcb"
-  assumes w: "\<forall>tcb. is_aligned (tcbIPCBuffer tcb) msg_align_bits \<longrightarrow> is_aligned (tcbIPCBuffer (F tcb)) msg_align_bits"
-  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"
-  shows
-  "\<lbrace>\<lambda>s. invs' 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. \<not> tcbQueued tcb \<and> tcbQueued (F tcb)) \<longrightarrow> ex_nonz_cap_to' t s \<and> t \<noteq> ksCurThread s) \<and>
-       (\<forall>tcb. tcbQueued (F tcb) \<and> ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> tcbQueued tcb \<or> t \<noteq> ksCurThread s)\<rbrace>
-   threadSet F t
-   \<lbrace>\<lambda>rv. invs'\<rbrace>"
-proof -
-  from z have domains: "\<And>tcb. tcbDomain (F tcb) = tcbDomain tcb" by blast
-  note threadSet_sch_actT_P[where P=False, simplified]
-  have y: "\<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 valid_state'_def split del: if_split)
-    apply (rule hoare_pre)
-     apply (wp x w v u b
-              threadSet_valid_pspace'T
-              threadSet_sch_actT_P[where P=False, simplified]
-              threadSet_valid_queues
-              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_cur
-              untyped_ranges_zero_lift
-           |clarsimp simp: y z a domains cteCaps_of_def |rule refl)+
-   apply (clarsimp simp: obj_at'_def pred_tcb_at'_def)
-   apply (clarsimp simp: cur_tcb'_def valid_irq_node'_def valid_queues'_def o_def)
-   by (fastforce simp: domains ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def z a)
-qed
+  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. is_aligned (tcbIPCBuffer tcb) msg_align_bits
+           \<longrightarrow> is_aligned (tcbIPCBuffer (F tcb)) msg_align_bits"
+    "\<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. tcbMCP tcb \<le> maxPriority \<longrightarrow> tcbMCP (F tcb) \<le> maxPriority"
+  shows "threadSet F t \<lbrace>invs'\<rbrace>"
+  apply (simp add: invs'_def valid_state'_def split del: if_split)
+  apply (wp threadSet_valid_pspace'T
+            threadSet_sch_actT_P[where P=False, simplified]
+            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_cur
+            untyped_ranges_zero_lift
+            sym_heap_sched_pointers_lift threadSet_valid_sched_pointers
+            threadSet_tcbQueued
+            threadSet_tcbSchedPrevs_of threadSet_tcbSchedNexts_of valid_bitmaps_lift
+         | clarsimp simp: assms cteCaps_of_def | rule refl)+
+  apply (clarsimp simp: o_def)
+  by (auto simp: assms obj_at'_def)
 
 lemmas threadSet_invs_trivial =
     threadSet_invs_trivialT [OF all_tcbI all_tcbI all_tcbI all_tcbI, OF ball_tcb_cte_casesI]
@@ -1333,6 +1437,70 @@ lemma threadSet_valid_objs':
   apply (clarsimp elim!: obj_at'_weakenE)
   done
 
+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']
+
+lemma setObject_valid_tcbs':
+  assumes preserve_valid_tcb': "\<And>s s' ko ko' x n tcb tcb'.
+            \<lbrakk> (ko', s') \<in> fst (updateObject val ko ptr x n s); P s;
+              lookupAround2 ptr (ksPSpace s) = (Some (x, ko), n);
+              projectKO_opt ko = Some tcb; projectKO_opt ko' = Some tcb';
+              valid_tcb' tcb s \<rbrakk> \<Longrightarrow> valid_tcb' tcb' s"
+  shows "\<lbrace>valid_tcbs' and P\<rbrace> setObject ptr val \<lbrace>\<lambda>rv. valid_tcbs'\<rbrace>"
+  unfolding valid_tcbs'_def
+  apply (clarsimp simp: valid_def)
+  apply (rename_tac s s' ptr' tcb)
+  apply (prop_tac "\<forall>tcb'. valid_tcb' tcb s \<longrightarrow> valid_tcb' tcb s'")
+   apply clarsimp
+   apply (erule (1) use_valid[OF _ setObject_valid_tcb'])
+  apply (drule spec, erule mp)
+  apply (clarsimp simp: setObject_def in_monad split_def lookupAround2_char1)
+  apply (rename_tac s ptr' new_tcb' ptr'' old_tcb_ko' s' f)
+  apply (case_tac "ptr'' = ptr'"; clarsimp)
+  apply (prop_tac "\<exists>old_tcb' :: tcb. projectKO_opt old_tcb_ko' = Some old_tcb'")
+   apply (frule updateObject_type)
+   apply (case_tac old_tcb_ko'; clarsimp simp: project_inject)
+  apply (erule exE)
+  apply (rule preserve_valid_tcb', assumption+)
+     apply (simp add: prod_eqI lookupAround2_char1)
+    apply force
+   apply (clarsimp simp: project_inject)
+  apply (clarsimp simp: project_inject)
+  done
+
+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 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>_. valid_tcb' tcb\<rbrace>"
+  apply (simp add: threadSet_def)
+  apply (wpsimp wp: setObject_valid_tcb')
+  done
+
+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>_. valid_tcbs'\<rbrace>"
+  apply (simp add: threadSet_def)
+  apply (rule hoare_seq_ext[OF _ getObject_tcb_sp])
+  apply (wpsimp wp: setObject_tcb_valid_tcbs')
+  apply (clarsimp simp: obj_at'_def valid_tcbs'_def)
+  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 objBits_simps')
+  done
+
 lemma asUser_corres':
   assumes y: "corres_underlying Id False True r \<top> \<top> f g"
   shows      "corres r (tcb_at t and pspace_aligned and pspace_distinct) \<top>
@@ -1472,14 +1640,6 @@ lemma asUser_valid_pspace'[wp]:
   apply (wp threadSet_valid_pspace' hoare_drop_imps | simp)+
   done
 
-lemma asUser_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> asUser t m \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: asUser_def split_def)
-  apply (wp hoare_drop_imps | simp)+
-
-  apply (wp threadSet_valid_queues hoare_drop_imps | simp)+
-  done
-
 lemma asUser_ifunsafe'[wp]:
   "\<lbrace>if_unsafe_then_cap'\<rbrace> asUser t m \<lbrace>\<lambda>rv. if_unsafe_then_cap'\<rbrace>"
   apply (simp add: asUser_def split_def)
@@ -1756,19 +1916,22 @@ lemma ethreadget_corres:
   apply (simp add: x)
   done
 
-lemma setQueue_corres:
-  "corres dc \<top> \<top> (set_tcb_queue d p q) (setQueue d p q)"
-  apply (rule corres_no_failI)
-   apply wp
-  apply (clarsimp simp: setQueue_def in_monad set_tcb_queue_def return_def simpler_modify_def)
-  apply (fastforce simp: state_relation_def ready_queues_relation_def)
-  done
-
-
-lemma getQueue_corres: "corres (=) \<top> \<top> (get_tcb_queue qdom prio) (getQueue qdom prio)"
-  apply (clarsimp simp add: getQueue_def state_relation_def ready_queues_relation_def get_tcb_queue_def gets_def)
-  apply (fold gets_def)
-  apply simp
+lemma getQueue_corres:
+  "corres (\<lambda>ls q. (ls = [] \<longleftrightarrow> tcbQueueEmpty q) \<and> (ls \<noteq> [] \<longrightarrow> tcbQueueHead q = Some (hd ls))
+                  \<and> queue_end_valid ls q)
+     \<top> \<top> (get_tcb_queue qdom prio) (getQueue qdom prio)"
+  apply (clarsimp simp: get_tcb_queue_def getQueue_def tcbQueueEmpty_def)
+  apply (rule corres_bind_return2)
+  apply (rule corres_symb_exec_l[OF _ _ gets_sp])
+    apply (rule corres_symb_exec_r[OF _ gets_sp])
+      apply clarsimp
+      apply (drule state_relation_ready_queues_relation)
+      apply (clarsimp simp: ready_queues_relation_def ready_queue_relation_def Let_def
+                            list_queue_relation_def)
+      apply (drule_tac x=qdom in spec)
+      apply (drule_tac x=prio in spec)
+      apply (fastforce dest: heap_path_head)
+     apply wpsimp+
   done
 
 lemma no_fail_return:
@@ -1783,8 +1946,8 @@ lemma addToBitmap_noop_corres:
      (wp | simp add: state_relation_def | rule no_fail_pre)+
 
 lemma addToBitmap_if_null_noop_corres: (* used this way in Haskell code *)
-  "corres dc \<top> \<top> (return ()) (if null queue then addToBitmap d p else return ())"
-  by (cases "null queue", simp_all add: addToBitmap_noop_corres)
+  "corres dc \<top> \<top> (return ()) (if tcbQueueEmpty queue then addToBitmap d p else return ())"
+  by (cases "tcbQueueHead queue", simp_all add: addToBitmap_noop_corres)
 
 lemma removeFromBitmap_corres_noop:
   "corres dc \<top> \<top> (return ()) (removeFromBitmap tdom prioa)"
@@ -1801,56 +1964,701 @@ crunch typ_at'[wp]: removeFromBitmap "\<lambda>s. P (typ_at' T p s)"
 lemmas addToBitmap_typ_ats [wp] = typ_at_lifts [OF addToBitmap_typ_at']
 lemmas removeFromBitmap_typ_ats [wp] = typ_at_lifts [OF removeFromBitmap_typ_at']
 
+lemma ekheap_relation_tcb_domain_priority:
+  "\<lbrakk>ekheap_relation (ekheap s) (ksPSpace s'); ekheap s t = Some (tcb);
+    ksPSpace s' t = Some (KOTCB tcb')\<rbrakk>
+   \<Longrightarrow> tcbDomain tcb' = tcb_domain tcb \<and> tcbPriority tcb' = tcb_priority tcb"
+  apply (clarsimp simp: ekheap_relation_def)
+  apply (drule_tac x=t in bspec, blast)
+  apply (clarsimp simp: other_obj_relation_def etcb_relation_def)
+  done
+
+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
+
+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)
+  apply (frule (1) pspace_relation_tcb_relation)
+   apply (fastforce simp: obj_at'_def)
+  apply (fastforce dest!: tcb_rel)
+  done
+
+lemma ekheap_relation_update_tcbs:
+  "\<lbrakk> ekheap_relation (ekheap s) (ksPSpace s'); ekheap s x = Some oetcb;
+     ksPSpace s' x = Some (KOTCB otcb'); etcb_relation etcb tcb' \<rbrakk>
+   \<Longrightarrow> ekheap_relation ((ekheap s)(x \<mapsto> etcb)) ((ksPSpace s')(x \<mapsto> KOTCB tcb'))"
+  by (simp add: ekheap_relation_def)
+
+lemma ekheap_relation_update_concrete_tcb:
+  "\<lbrakk>ekheap_relation (ekheap s) (ksPSpace s'); ekheap s ptr = Some etcb;
+    ksPSpace s' ptr = Some (KOTCB otcb');
+    etcb_relation etcb tcb'\<rbrakk>
+   \<Longrightarrow> ekheap_relation (ekheap s) ((ksPSpace s')(ptr \<mapsto> KOTCB tcb'))"
+  by (fastforce dest: ekheap_relation_update_tcbs simp: map_upd_triv)
+
+lemma ekheap_relation_etcb_relation:
+  "\<lbrakk>ekheap_relation (ekheap s) (ksPSpace s'); ekheap s ptr = Some etcb;
+    ksPSpace s' ptr = Some (KOTCB tcb')\<rbrakk>
+   \<Longrightarrow> etcb_relation etcb tcb'"
+  apply (clarsimp simp: ekheap_relation_def)
+  apply (drule_tac x=ptr in bspec)
+   apply (fastforce simp: obj_at_def)
+  apply (clarsimp simp: obj_at_def obj_at'_def)
+  done
+
+lemma threadSet_ekheap_relation:
+  fixes s :: det_state
+  assumes etcb_rel: "(\<And>etcb tcb'. etcb_relation etcb tcb' \<Longrightarrow> etcb_relation etcb (F tcb'))"
+  shows
+    "\<lbrace>\<lambda>s'. ekheap_relation (ekheap s) (ksPSpace s') \<and> pspace_relation (kheap s) (ksPSpace s')
+           \<and> valid_etcbs s\<rbrace>
+     threadSet F tcbPtr
+     \<lbrace>\<lambda>_ s'. ekheap_relation (ekheap s) (ksPSpace s')\<rbrace>"
+  supply fun_upd_apply[simp del]
+  unfolding threadSet_def setObject_def updateObject_default_def
+  apply (wpsimp wp: getObject_tcb_wp simp: updateObject_default_def)
+  apply (frule tcb_at'_cross)
+   apply (fastforce simp: obj_at'_def)
+  apply normalise_obj_at'
+  apply (frule (1) tcb_at_is_etcb_at)
+  apply (clarsimp simp: obj_at_def is_tcb_def is_etcb_at_def)
+  apply (rename_tac ko, case_tac ko; clarsimp)
+  apply (rule ekheap_relation_update_concrete_tcb)
+     apply fastforce
+    apply fastforce
+   apply (fastforce simp: obj_at'_def)
+  apply (frule (1) ekheap_relation_etcb_relation)
+   apply (fastforce simp: obj_at'_def)
+  apply (fastforce dest!: etcb_rel)
+  done
+
+lemma tcbQueued_update_pspace_relation[wp]:
+  fixes s :: det_state
+  shows "threadSet (tcbQueued_update f) tcbPtr \<lbrace>\<lambda>s'. pspace_relation (kheap s) (ksPSpace s')\<rbrace>"
+  by (wpsimp wp: threadSet_pspace_relation simp: tcb_relation_def)
+
+lemma tcbQueued_update_ekheap_relation[wp]:
+  fixes s :: det_state
+  shows
+    "\<lbrace>\<lambda>s'. ekheap_relation (ekheap s) (ksPSpace s') \<and> pspace_relation (kheap s) (ksPSpace s')
+           \<and> valid_etcbs s\<rbrace>
+     threadSet (tcbQueued_update f) tcbPtr
+     \<lbrace>\<lambda>_ s'. ekheap_relation (ekheap s) (ksPSpace s')\<rbrace>"
+  by (wpsimp wp: threadSet_ekheap_relation simp: etcb_relation_def)
+
+lemma tcbQueueRemove_pspace_relation[wp]:
+  fixes s :: det_state
+  shows "tcbQueueRemove queue tcbPtr \<lbrace>\<lambda>s'. pspace_relation (kheap s) (ksPSpace s')\<rbrace>"
+  unfolding tcbQueueRemove_def
+  by (wpsimp wp: threadSet_pspace_relation hoare_drop_imps simp: tcb_relation_def)
+
+lemma tcbQueueRemove_ekheap_relation[wp]:
+  fixes s :: det_state
+  shows
+    "\<lbrace>\<lambda>s'. ekheap_relation (ekheap s) (ksPSpace s') \<and> pspace_relation (kheap s) (ksPSpace s')
+           \<and> valid_etcbs s\<rbrace>
+     tcbQueueRemove queue tcbPtr
+     \<lbrace>\<lambda>_ s'. ekheap_relation (ekheap s) (ksPSpace s')\<rbrace>"
+  unfolding tcbQueueRemove_def
+  by (wpsimp wp: threadSet_ekheap_relation threadSet_pspace_relation hoare_drop_imps
+           simp: tcb_relation_def etcb_relation_def)
+
+lemma threadSet_ghost_relation[wp]:
+  "threadSet f tcbPtr \<lbrace>\<lambda>s'. ghost_relation (kheap s) (gsUserPages s') (gsCNodes s')\<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 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)
+
+crunches 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)
+
+crunches 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
+
+crunches 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)
+
+crunches 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 pspace_canonical'[wp]: pspace_canonical'
+  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 pspace_in_kernel_mappings'[wp]: pspace_in_kernel_mappings'
+  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 ready_queue_relation_def Let_def)
+  apply (wpsimp wp: threadSet_wp)
+  apply (clarsimp simp: list_queue_relation_def obj_at'_def)
+  apply (rename_tac tcb' d p)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply (clarsimp simp: 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 split: option.splits)
+  done
+
+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>
+   isRunnable tcb_ptr
+   \<lbrace>\<lambda>rv s. \<exists>tcb'. ko_at' tcb' tcb_ptr s
+                  \<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_def)
+  apply (fastforce simp: obj_at'_def split: Structures_H.thread_state.splits)
+  done
+
+crunch (no_fail) no_fail[wp]: isRunnable
+
+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)
+
+crunches 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 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 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_queues_relation_def ready_queue_relation_def Let_def)
+
+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_queues_relation_def ready_queue_relation_def Let_def inQ_def
+                         opt_pred_def
+                  split: option.splits)
+  done
+
 lemma tcbSchedEnqueue_corres:
-  "corres dc (tcb_at t and is_etcb_at t and pspace_aligned and pspace_distinct)
-             (Invariants_H.valid_queues and valid_queues')
-             (tcb_sched_action (tcb_sched_enqueue) t) (tcbSchedEnqueue t)"
-proof -
-  have ready_queues_helper:
-    "\<And>t tcb a b. \<lbrakk> ekheap a t = Some tcb;  obj_at' tcbQueued t b  ;  valid_queues' b  ;
-                   ekheap_relation (ekheap a) (ksPSpace b) \<rbrakk>
-                 \<Longrightarrow> t \<in> set (ksReadyQueues b (tcb_domain tcb, tcb_priority tcb))"
-  unfolding valid_queues'_def
-  by (fastforce dest: ekheap_relation_absD simp: obj_at'_def inQ_def etcb_relation_def)
-
-  show ?thesis unfolding tcbSchedEnqueue_def tcb_sched_action_def
-    apply (rule corres_cross_over_guard[where P'=Q and Q="tcb_at' t and Q" for Q])
-     apply (fastforce simp: tcb_at_cross state_relation_def)
-    apply (rule corres_symb_exec_r [OF _ _ threadGet_inv,
-             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 (rule no_fail_pre, wp, blast)
-    apply (case_tac queued; simp_all)
-     apply (rule corres_no_failI; simp add: no_fail_return)
-     apply (clarsimp simp: in_monad ethread_get_def gets_the_def bind_assoc
-                           assert_opt_def exec_gets is_etcb_at_def get_etcb_def get_tcb_queue_def
-                           set_tcb_queue_def simpler_modify_def ready_queues_relation_def
-                           state_relation_def tcb_sched_enqueue_def)
-     apply (rule ready_queues_helper; auto)
-    apply (clarsimp simp: when_def)
-    apply (rule stronger_corres_guard_imp)
-      apply (rule corres_split[where r'="(=)", OF ethreadget_corres])
-         apply (simp add: etcb_relation_def)
-        apply (rule corres_split[where r'="(=)", OF ethreadget_corres])
-           apply (simp add: etcb_relation_def)
-          apply (rule corres_split[where r'="(=)"])
-             apply simp
-             apply (rule getQueue_corres)
-            apply (rule corres_split_noop_rhs2)
-               apply simp
-               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
-               apply (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 exst_same_def)
-               apply (wp getObject_tcb_wp | simp add: threadGet_def)+
-    apply (fastforce simp: valid_queues_def valid_queues_no_bitmap_def obj_at'_def inQ_def
-                           project_inject)
-    done
-qed
+  "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)
+   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)?)
+
+  \<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)
+
+  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)
+
+  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)
+  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)
+    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 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 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)
+  apply (frule valid_tcbs'_maxPriority[where t=tcbPtr], simp add: obj_at'_def)
+  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)
+  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
+               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 fun_upd_apply split: if_splits)
+   apply (clarsimp simp: fun_upd_apply 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
+           split: if_splits option.splits)
 
 definition
   weak_sch_act_wf :: "scheduler_action \<Rightarrow> kernel_state \<Rightarrow> bool"
@@ -1877,8 +2685,10 @@ lemma getSchedulerAction_corres:
   done
 
 lemma rescheduleRequired_corres:
-  "corres dc (weak_valid_sched_action and valid_etcbs and pspace_aligned and pspace_distinct)
-             (Invariants_H.valid_queues and valid_queues')
+  "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)
@@ -1889,7 +2699,7 @@ lemma rescheduleRequired_corres:
          apply (case_tac action)
            apply simp
           apply simp
-          apply (rule tcbSchedEnqueue_corres)
+          apply (rule tcbSchedEnqueue_corres, simp)
          apply simp
         apply (rule setSchedulerAction_corres)
         apply simp
@@ -1964,20 +2774,18 @@ lemmas addToBitmap_weak_sch_act_wf[wp]
   = weak_sch_act_wf_lift[OF addToBitmap_nosch]
 
 crunch st_tcb_at'[wp]: removeFromBitmap "st_tcb_at' P t"
-crunch pred_tcb_at'[wp]: removeFromBitmap "pred_tcb_at' proj P t"
+crunch pred_tcb_at'[wp]: removeFromBitmap "\<lambda>s. Q (pred_tcb_at' proj P t s)"
 
 crunch not_st_tcb_at'[wp]: removeFromBitmap "\<lambda>s. \<not> (st_tcb_at' P' t) s"
-crunch not_pred_tcb_at'[wp]: removeFromBitmap "\<lambda>s. \<not> (pred_tcb_at' proj P' t) s"
 
 crunch st_tcb_at'[wp]: addToBitmap "st_tcb_at' P' t"
-crunch pred_tcb_at'[wp]: addToBitmap "pred_tcb_at' proj P' t"
+crunch pred_tcb_at'[wp]: addToBitmap "\<lambda>s. Q (pred_tcb_at' proj P t s)"
 
 crunch not_st_tcb_at'[wp]: addToBitmap "\<lambda>s. \<not> (st_tcb_at' P' t) s"
-crunch not_pred_tcb_at'[wp]: addToBitmap "\<lambda>s. \<not> (pred_tcb_at' proj P' t) s"
 
-crunch obj_at'[wp]: removeFromBitmap "obj_at' P t"
+crunch obj_at'[wp]: removeFromBitmap "\<lambda>s. Q (obj_at' P t s)"
 
-crunch obj_at'[wp]: addToBitmap "obj_at' P t"
+crunch obj_at'[wp]: addToBitmap "\<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>"
@@ -1994,9 +2802,11 @@ lemma addToBitmap_tcb_in_cur_domain'[wp]:
   done
 
 lemma tcbSchedDequeue_weak_sch_act_wf[wp]:
-  "\<lbrace> \<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s \<rbrace> tcbSchedDequeue a \<lbrace> \<lambda>_ s. weak_sch_act_wf (ksSchedulerAction s) s \<rbrace>"
-  apply (simp add: tcbSchedDequeue_def)
-  apply (wp threadSet_weak_sch_act_wf removeFromBitmap_weak_sch_act_wf | simp add: crunch_simps)+
+  "tcbSchedDequeue tcbPtr \<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
+  apply (simp add: tcbSchedDequeue_def tcbQueueRemove_def)
+  apply (wp threadSet_weak_sch_act_wf getObject_tcb_wp removeFromBitmap_weak_sch_act_wf
+         | simp add: crunch_simps threadGet_def)+
+  apply (clarsimp simp: obj_at'_def)
   done
 
 lemma dequeue_nothing_eq[simp]:
@@ -2012,47 +2822,342 @@ lemma gets_the_exec: "f s \<noteq> None \<Longrightarrow>  (do x \<leftarrow> ge
                    return_def assert_opt_def)
   done
 
+lemma tcbQueueRemove_no_fail:
+  "no_fail (\<lambda>s. tcb_at' tcbPtr s
+                \<and> (\<exists>ts. list_queue_relation ts queue (tcbSchedNexts_of s) (tcbSchedPrevs_of s)
+                        \<and> tcbPtr \<in> set ts)
+                \<and> sym_heap_sched_pointers s \<and> valid_objs' s)
+           (tcbQueueRemove queue tcbPtr)"
+  unfolding tcbQueueRemove_def
+  apply (wpsimp wp: getObject_tcb_wp)
+  apply normalise_obj_at'
+  apply (frule (1) ko_at_valid_objs')
+   apply fastforce
+  apply (clarsimp simp: list_queue_relation_def)
+  apply (prop_tac "tcbQueueHead queue \<noteq> Some tcbPtr \<longrightarrow> tcbSchedPrevs_of s tcbPtr \<noteq> None")
+   apply (rule impI)
+   apply (frule not_head_prev_not_None[where p=tcbPtr])
+      apply (fastforce simp: inQ_def opt_pred_def opt_map_def obj_at'_def)
+     apply (fastforce dest: heap_path_head)
+    apply fastforce
+   apply (fastforce simp: opt_map_def obj_at'_def valid_tcb'_def valid_bound_tcb'_def)
+  by (fastforce dest!: not_last_next_not_None[where p=tcbPtr]
+                 simp: queue_end_valid_def opt_map_def obj_at'_def valid_obj'_def valid_tcb'_def)
+
+crunch (no_fail) no_fail[wp]: removeFromBitmap
+
+crunches removeFromBitmap
+  for ready_queues_relation[wp]: "ready_queues_relation s"
+  and list_queue_relation[wp]:
+   "\<lambda>s'. list_queue_relation ts (P (ksReadyQueues s'))
+                             (tcbSchedNexts_of s') (tcbSchedPrevs_of s')"
+  (simp: bitmap_fun_defs ready_queues_relation_def)
+
+\<comment> \<open>
+  A direct analogue of tcbQueueRemove, used in tcb_sched_dequeue' below, so that within the proof of
+  tcbQueueRemove_corres, we may reason in terms of the list operations used within this function
+  rather than @{term filter}.\<close>
+definition tcb_queue_remove :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
+  "tcb_queue_remove a ls \<equiv>
+     if ls = [a]
+     then []
+     else if a = hd ls
+          then tl ls
+          else if a = last ls
+               then butlast ls
+               else list_remove ls a"
+
+definition tcb_sched_dequeue' :: "obj_ref \<Rightarrow> unit det_ext_monad" where
+  "tcb_sched_dequeue' tcb_ptr \<equiv> do
+     d \<leftarrow> ethread_get tcb_domain tcb_ptr;
+     prio \<leftarrow> ethread_get tcb_priority tcb_ptr;
+     queue \<leftarrow> get_tcb_queue d prio;
+     when (tcb_ptr \<in> set queue) $ set_tcb_queue d prio (tcb_queue_remove tcb_ptr queue)
+   od"
+
+lemma filter_tcb_queue_remove:
+  "\<lbrakk>a \<in> set ls; distinct ls \<rbrakk> \<Longrightarrow> filter ((\<noteq>) a) ls = tcb_queue_remove a ls"
+  apply (clarsimp simp: tcb_queue_remove_def)
+  apply (intro conjI impI)
+     apply (fastforce elim: filter_hd_equals_tl)
+    apply (fastforce elim: filter_last_equals_butlast)
+   apply (fastforce elim: filter_hd_equals_tl)
+  apply (frule split_list)
+  apply (clarsimp simp: list_remove_middle_distinct)
+  apply (subst filter_True | clarsimp simp: list_remove_none)+
+  done
+
+lemma tcb_sched_dequeue_monadic_rewrite:
+  "monadic_rewrite False True (is_etcb_at t and (\<lambda>s. \<forall>d p. distinct (ready_queues s d p)))
+     (tcb_sched_action tcb_sched_dequeue t) (tcb_sched_dequeue' t)"
+  supply if_split[split del]
+  apply (clarsimp simp: tcb_sched_dequeue'_def tcb_sched_dequeue_def tcb_sched_action_def
+                        set_tcb_queue_def)
+  apply (rule monadic_rewrite_bind_tail)+
+     apply (clarsimp simp: when_def)
+     apply (rule monadic_rewrite_if_r)
+      apply (rule_tac P="\<lambda>_. distinct queue" in monadic_rewrite_guard_arg_cong)
+      apply (frule (1) filter_tcb_queue_remove)
+      apply (metis (mono_tags, lifting) filter_cong)
+     apply (rule monadic_rewrite_modify_noop)
+    apply (wpsimp wp: thread_get_wp)+
+  apply (clarsimp simp: etcb_at_def split: option.splits)
+  apply (prop_tac "(\<lambda>d' p. if d' = tcb_domain x2 \<and> p = tcb_priority x2
+                           then filter (\<lambda>x. x \<noteq> t) (ready_queues s (tcb_domain x2) (tcb_priority x2))
+                           else ready_queues s d' p)
+                   = ready_queues s")
+   apply (subst filter_True)
+    apply fastforce
+   apply (clarsimp intro!: ext split: if_splits)
+  apply fastforce
+  done
+
+crunches removeFromBitmap
+  for ksReadyQueues[wp]: "\<lambda>s. P (ksReadyQueues s)"
+
+lemma list_queue_relation_neighbour_in_set:
+  "\<lbrakk>list_queue_relation ls q hp hp'; sym_heap hp hp'; p \<in> set ls\<rbrakk>
+   \<Longrightarrow> \<forall>nbr. (hp p = Some nbr \<longrightarrow> nbr \<in> set ls) \<and> (hp' p = Some nbr \<longrightarrow> nbr \<in> set ls)"
+  apply (rule heap_ls_neighbour_in_set)
+     apply (fastforce simp: list_queue_relation_def)
+    apply fastforce
+   apply (clarsimp simp: list_queue_relation_def prev_queue_head_def)
+  apply fastforce
+  done
+
+lemma in_queue_not_head_or_not_tail_length_gt_1:
+  "\<lbrakk>tcbPtr \<in> set ls; tcbQueueHead q \<noteq> Some tcbPtr \<or> tcbQueueEnd q \<noteq> Some tcbPtr;
+    list_queue_relation ls q nexts prevs\<rbrakk>
+   \<Longrightarrow> Suc 0 < length ls"
+  apply (clarsimp simp: list_queue_relation_def)
+  apply (cases ls; fastforce simp: queue_end_valid_def)
+  done
+
 lemma tcbSchedDequeue_corres:
-  "corres dc (is_etcb_at t and tcb_at t and pspace_aligned and pspace_distinct)
-             (Invariants_H.valid_queues)
-             (tcb_sched_action tcb_sched_dequeue t) (tcbSchedDequeue t)"
-  apply (rule corres_cross_over_guard[where P'=Q and Q="tcb_at' t and Q" for Q])
-   apply (fastforce simp: tcb_at_cross state_relation_def)
-  apply (simp only: tcbSchedDequeue_def tcb_sched_action_def)
-  apply (rule corres_symb_exec_r[OF _ _ threadGet_inv, where Q'="\<lambda>rv. tcb_at' t and Invariants_H.valid_queues and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"])
-    defer
-    apply (wp threadGet_obj_at', simp, simp)
-   apply (rule no_fail_pre, wp, simp)
-  apply (case_tac queued)
-   defer
-   apply (simp add: when_def)
-   apply (rule corres_no_failI)
-    apply (wp)
-   apply (clarsimp simp: in_monad ethread_get_def set_tcb_queue_def is_etcb_at_def state_relation_def)
-   apply (subgoal_tac "t \<notin> set (ready_queues a (tcb_domain y) (tcb_priority y))")
-    prefer 2
-    subgoal by (force simp: tcb_sched_dequeue_def Invariants_H.valid_queues_def valid_queues_no_bitmap_def
-                            ready_queues_relation_def obj_at'_def inQ_def project_inject)
-   apply (subst gets_the_exec)
-    apply (simp add: get_etcb_def)
-   apply (subst gets_the_exec)
-    apply (simp add: get_etcb_def)
-   apply (simp add: exec_gets simpler_modify_def get_etcb_def ready_queues_relation_def cong: if_cong get_tcb_queue_def)
-  apply (simp add: when_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[where r'="(=)"])
-       apply (rule ethreadget_corres, simp add: etcb_relation_def)
-      apply (rule corres_split[where r'="(=)"])
-         apply (rule ethreadget_corres, simp add: etcb_relation_def)
-        apply (rule corres_split[where r'="(=)"])
-           apply (simp, rule getQueue_corres)
-          apply (rule corres_split_noop_rhs2)
-             apply (simp add: tcb_sched_dequeue_def)
-             apply (rule setQueue_corres)
-            apply (rule corres_split_noop_rhs)
-              apply (clarsimp, rule removeFromBitmap_corres_noop)
-             apply (rule threadSet_corres_noop; simp_all add: tcb_relation_def exst_same_def)
-            apply (wp | simp)+
+  "tcb_ptr = tcbPtr \<Longrightarrow>
+   corres dc
+     (in_correct_ready_q and ready_qs_distinct and valid_etcbs and tcb_at tcb_ptr
+      and pspace_aligned and pspace_distinct)
+     (sym_heap_sched_pointers and valid_objs')
+     (tcb_sched_action tcb_sched_dequeue tcb_ptr) (tcbSchedDequeue tcbPtr)"
+  supply heap_path_append[simp del] fun_upd_apply[simp del] distinct_append[simp del]
+         list_remove_append[simp del]
+  apply (rule_tac Q'="tcb_at' tcbPtr" in corres_cross_add_guard)
+   apply (fastforce intro!: tcb_at_cross simp: obj_at_def is_tcb_def)
+  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 monadic_rewrite_corres_l[where P=P and Q=P for P, simplified])
+   apply (rule monadic_rewrite_guard_imp[OF tcb_sched_dequeue_monadic_rewrite])
+   apply (fastforce dest: tcb_at_is_etcb_at simp: in_correct_ready_q_def ready_qs_distinct_def)
+  apply (clarsimp simp: tcb_sched_dequeue'_def get_tcb_queue_def tcbSchedDequeue_def  getQueue_def
+                        unless_def when_def)
+  apply (rule corres_symb_exec_l[OF _ _ ethread_get_sp]; wpsimp?)
+  apply (rename_tac dom)
+  apply (rule corres_symb_exec_l[OF _ _ ethread_get_sp]; wpsimp?)
+  apply (rename_tac prio)
+  apply (rule corres_symb_exec_l[OF _ _ gets_sp]; (solves wpsimp)?)
+  apply (rule corres_stateAssert_ignore)
+   apply (fastforce intro: ksReadyQueues_asrt_cross)
+  apply (rule corres_symb_exec_r[OF _ threadGet_sp]; (solves wpsimp)?)
+  apply (rule corres_if_strong'; fastforce?)
+    apply (frule state_relation_ready_queues_relation)
+    apply (frule in_ready_q_tcbQueued_eq[where t=tcbPtr])
+    apply (fastforce simp: obj_at'_def opt_pred_def opt_map_def obj_at_def is_tcb_def
+                           in_correct_ready_q_def etcb_at_def is_etcb_at_def)
+  apply (rule corres_symb_exec_r[OF _ threadGet_sp]; wpsimp?)
+  apply (rule corres_symb_exec_r[OF _ threadGet_sp]; wpsimp?)
+  apply (rule corres_symb_exec_r[OF _ gets_sp]; wpsimp?)
+  apply (rule corres_from_valid_det)
+    apply (fastforce intro: det_wp_modify det_wp_pre simp: set_tcb_queue_def)
+   apply (wpsimp wp: tcbQueueRemove_no_fail)
+   apply (fastforce dest: state_relation_ready_queues_relation
+                    simp: ex_abs_underlying_def ready_queues_relation_def ready_queue_relation_def
+                          Let_def inQ_def opt_pred_def opt_map_def obj_at'_def)
+  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 tcbQueueRemove_def
+         split_del: if_split)
+  apply (frule (1) tcb_at_is_etcb_at)
+  apply (clarsimp simp: obj_at_def is_etcb_at_def etcb_at_def)
+  apply normalise_obj_at'
+  apply (rename_tac s d p s' tcb' tcb etcb)
+  apply (frule_tac t=tcbPtr in ekheap_relation_tcb_domain_priority)
+    apply (force simp: obj_at_def)
+   apply (force simp: obj_at'_def)
+
+  apply (case_tac "d \<noteq> tcb_domain etcb \<or> p \<noteq> tcb_priority etcb")
+   apply clarsimp
+   apply (cut_tac p=tcbPtr and ls="ready_queues s (tcb_domain etcb) (tcb_priority etcb)"
+               in list_queue_relation_neighbour_in_set)
+      apply (fastforce dest!: spec)
+     apply fastforce
+    apply fastforce
+   apply (cut_tac xs="ready_queues s d p" in heap_path_head')
+    apply (force dest!: spec simp: ready_queues_relation_def Let_def list_queue_relation_def)
+   apply (cut_tac d=d and d'="tcb_domain etcb" and p=p and p'="tcb_priority etcb"
+               in ready_queues_disjoint)
+      apply force
+     apply fastforce
+    apply fastforce
+   apply (cut_tac ts="ready_queues s d p" in list_queue_relation_nil)
+    apply fast
+   apply (clarsimp simp: tcbQueueEmpty_def)
+   apply (prop_tac "Some tcbPtr \<noteq> tcbQueueHead (ksReadyQueues s' (d, p))")
+    apply (metis hd_in_set not_emptyI option.sel option.simps(2))
+   apply (prop_tac "tcbPtr \<notin> set (ready_queues s d p)")
+    apply blast
+   apply (clarsimp simp: list_queue_relation_def)
+   apply (intro conjI; clarsimp)
+
+    \<comment> \<open>the ready queue is the singleton consisting of tcbPtr\<close>
+    apply (intro conjI)
+         apply (force intro!: heap_path_heap_upd_not_in simp: fun_upd_apply)
+        apply (clarsimp simp: queue_end_valid_def fun_upd_apply)
+       apply (force simp: prev_queue_head_heap_upd fun_upd_apply)
+      apply (clarsimp simp: inQ_def in_opt_pred fun_upd_apply)
+     apply (clarsimp simp: fun_upd_apply)
+    apply (clarsimp simp: fun_upd_apply)
+
+   apply (clarsimp simp: etcb_at_def obj_at'_def)
+   apply (intro conjI; clarsimp)
+
+    \<comment> \<open>tcbPtr is the head of the ready queue\<close>
+    apply (intro conjI)
+         apply (intro heap_path_heap_upd_not_in)
+           apply (force simp: fun_upd_apply)
+          apply (force simp: not_emptyI opt_map_red)
+         apply assumption
+        apply (clarsimp simp: queue_end_valid_def fun_upd_apply)
+       apply (clarsimp simp: prev_queue_head_def fun_upd_apply)
+      apply (clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply split: option.splits)
+     apply (clarsimp simp: fun_upd_apply)
+    apply (clarsimp simp: fun_upd_apply)
+   apply (intro conjI; clarsimp)
+
+    \<comment> \<open>tcbPtr is the end of the ready queue\<close>
+    apply (intro conjI)
+         apply (intro heap_path_heap_upd_not_in)
+           apply (simp add: fun_upd_apply split: if_splits)
+          apply (force simp: not_emptyI opt_map_red)
+         apply (clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply split: option.splits)
+        apply (clarsimp simp: queue_end_valid_def fun_upd_apply)
+       apply (force simp: prev_queue_head_def fun_upd_apply opt_map_red opt_map_upd_triv)
+      apply (clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply split: option.splits)
+     apply (clarsimp simp: fun_upd_apply)
+    apply (clarsimp simp: fun_upd_apply)
+
+   \<comment> \<open>tcbPtr is in the middle of the ready queue\<close>
+   apply (intro conjI)
+     apply (intro heap_path_heap_upd_not_in)
+        apply (simp add: fun_upd_apply)
+       apply (force simp: not_emptyI opt_map_red)
+      apply (force simp: not_emptyI opt_map_red)
+     apply fastforce
+    apply (clarsimp simp: opt_map_red opt_map_upd_triv)
+    apply (intro prev_queue_head_heap_upd)
+      apply (force dest!: spec)
+     apply (metis hd_in_set not_emptyI option.sel option.simps(2))
+    apply fastforce
+   subgoal
+     by (clarsimp simp: inQ_def opt_map_def opt_pred_def fun_upd_apply
+                 split: if_splits option.splits)
+
+  \<comment> \<open>d = tcb_domain tcb \<and> p = tcb_priority tcb\<close>
+  apply clarsimp
+  apply (drule_tac x="tcb_domain etcb" in spec)
+  apply (drule_tac x="tcb_priority etcb" in spec)
+  apply (clarsimp simp: list_queue_relation_def)
+  apply (frule heap_path_head')
+  apply (frule heap_ls_distinct)
+  apply (intro conjI; clarsimp simp: tcbQueueEmpty_def)
+
+   \<comment> \<open>the ready queue is the singleton consisting of tcbPtr\<close>
+   apply (intro conjI)
+      apply (simp add: fun_upd_apply tcb_queue_remove_def queue_end_valid_def heap_ls_unique
+                       heap_path_last_end)
+     apply (simp add: fun_upd_apply tcb_queue_remove_def queue_end_valid_def heap_ls_unique
+                      heap_path_last_end)
+    apply (simp add: fun_upd_apply prev_queue_head_def)
+   apply (case_tac "ready_queues s (tcb_domain etcb) (tcb_priority etcb)";
+          clarsimp simp: tcb_queue_remove_def inQ_def opt_pred_def fun_upd_apply)
+  apply (intro conjI; clarsimp)
+
+   \<comment> \<open>tcbPtr is the head of the ready queue\<close>
+   apply (frule set_list_mem_nonempty)
+   apply (frule in_queue_not_head_or_not_tail_length_gt_1)
+     apply fastforce
+    apply (fastforce simp: list_queue_relation_def)
+   apply (frule list_not_head)
+   apply (clarsimp simp: tcb_queue_remove_def)
+   apply (frule length_tail_nonempty)
+   apply (frule (2) heap_ls_next_of_hd)
+   apply (clarsimp simp: obj_at'_def)
+   apply (intro conjI impI allI)
+      apply (drule (1) heap_ls_remove_head_not_singleton)
+      apply (clarsimp simp: opt_map_red opt_map_upd_triv fun_upd_apply)
+     apply (clarsimp simp: queue_end_valid_def fun_upd_apply last_tl)
+    apply (clarsimp simp: prev_queue_head_def fun_upd_apply)
+   apply (case_tac "ready_queues s (tcb_domain etcb) (tcb_priority etcb)";
+          clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply split: option.splits)
+  apply (intro conjI; clarsimp)
+
+   \<comment> \<open>tcbPtr is the end of the ready queue\<close>
+   apply (frule set_list_mem_nonempty)
+   apply (frule in_queue_not_head_or_not_tail_length_gt_1)
+     apply fast
+    apply (force dest!: spec simp: list_queue_relation_def)
+   apply (clarsimp simp: queue_end_valid_def)
+   apply (frule list_not_last)
+   apply (clarsimp simp: tcb_queue_remove_def)
+   apply (frule length_gt_1_imp_butlast_nonempty)
+   apply (frule (3) heap_ls_prev_of_last)
+   apply (clarsimp simp: obj_at'_def)
+   apply (intro conjI impI; clarsimp?)
+      apply (drule (1) heap_ls_remove_last_not_singleton)
+      apply (force elim!: rsubst3[where P=heap_ls] simp: opt_map_def fun_upd_apply)
+     apply (clarsimp simp: opt_map_def fun_upd_apply)
+    apply (clarsimp simp: prev_queue_head_def fun_upd_apply opt_map_def)
+   apply (clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply split: option.splits)
+   apply (meson distinct_in_butlast_not_last in_set_butlastD last_in_set not_last_in_set_butlast)
+
+  \<comment> \<open>tcbPtr is in the middle of the ready queue\<close>
+  apply (clarsimp simp: obj_at'_def)
+  apply (frule set_list_mem_nonempty)
+  apply (frule split_list)
+  apply clarsimp
+  apply (rename_tac xs ys)
+  apply (prop_tac "xs \<noteq> [] \<and> ys \<noteq> []", fastforce simp: queue_end_valid_def)
+  apply clarsimp
+  apply (frule (2) ptr_in_middle_prev_next)
+   apply fastforce
+  apply (clarsimp simp: tcb_queue_remove_def)
+  apply (prop_tac "tcbPtr \<noteq> last xs")
+   apply (clarsimp simp: distinct_append)
+  apply (prop_tac "tcbPtr \<noteq> hd ys")
+   apply (fastforce dest: hd_in_set simp: distinct_append)
+  apply (prop_tac "last xs \<noteq> hd ys")
+   apply (metis distinct_decompose2 hd_Cons_tl last_in_set)
+  apply (prop_tac "list_remove (xs @ tcbPtr # ys) tcbPtr = xs @ ys")
+   apply (simp add: list_remove_middle_distinct del: list_remove_append)
+  apply (intro conjI impI allI; (solves \<open>clarsimp simp: distinct_append\<close>)?)
+     apply (fastforce elim!: rsubst3[where P=heap_ls]
+                      dest!: heap_ls_remove_middle hd_in_set last_in_set
+                       simp: distinct_append not_emptyI opt_map_def fun_upd_apply)
+    apply (clarsimp simp: queue_end_valid_def fun_upd_apply)
+   apply (case_tac xs;
+          fastforce simp: prev_queue_head_def opt_map_def fun_upd_apply distinct_append)
+  apply (clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply distinct_append
+                 split: option.splits)
   done
 
 lemma thread_get_test: "do cur_ts \<leftarrow> get_thread_state cur; g (test cur_ts) od =
@@ -2112,30 +3217,84 @@ lemma setBoundNotification_corres:
 crunches rescheduleRequired, tcbSchedDequeue, setThreadState, setBoundNotification
   for tcb'[wp]: "tcb_at' addr"
 
+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
+
+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
+
+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)
+
+crunches addToBitmap
+  for valid_objs'[wp]: valid_objs'
+  (simp: unless_def crunch_simps wp: crunch_wps)
+
+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
+
 crunches rescheduleRequired, removeFromBitmap
   for valid_objs'[wp]: valid_objs'
-  (simp: unless_def crunch_simps)
+  (simp: crunch_simps)
 
+lemmas ko_at_valid_objs'_pre =
+  ko_at_valid_objs'[simplified project_inject, atomized, simplified, rule_format]
 
-lemma tcbSchedDequeue_valid_objs' [wp]: "\<lbrace> valid_objs' \<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>_. valid_objs' \<rbrace>"
-  unfolding tcbSchedDequeue_def
-  apply (wp threadSet_valid_objs')
-        apply (clarsimp simp add: valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)
-        apply wp
-       apply (simp add: if_apply_def2)
-       apply (wp hoare_drop_imps)
-       apply (wp | simp cong: if_cong add: valid_tcb'_def tcb_cte_cases_def cteSizeBits_def if_apply_def2)+
+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]
+
+lemma tcbQueueRemove_valid_objs'[wp]:
+  "tcbQueueRemove queue tcbPtr \<lbrace>valid_objs'\<rbrace>"
+  unfolding tcbQueueRemove_def
+  apply (wpsimp wp: getObject_tcb_wp)
+  apply normalise_obj_at'
+  apply (fastforce dest!: tcb_ko_at_valid_objs_valid_tcb'
+                    simp: valid_tcb'_def valid_bound_tcb'_def obj_at'_def)
   done
 
+lemma tcbSchedDequeue_valid_objs'[wp]:
+  "tcbSchedDequeue t \<lbrace>valid_objs'\<rbrace>"
+  unfolding tcbSchedDequeue_def setQueue_def
+  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>"
-  apply (simp add: setThreadState_def setQueue_def isRunnable_def isStopped_def)
-  apply (wp threadSet_valid_objs')
-     apply (simp add: valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)
-     apply (wp threadSet_valid_objs' | simp)+
-  apply (clarsimp simp: valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)
+  "\<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')
+   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':
@@ -2223,18 +3382,6 @@ lemma setQueue_valid_bitmapQ_except[wp]:
   unfolding setQueue_def bitmapQ_defs
   by (wp, clarsimp simp: bitmapQ_def)
 
-lemma setQueue_valid_bitmapQ: (* enqueue only *)
-  "\<lbrace> valid_bitmapQ and (\<lambda>s. (ksReadyQueues s (d, p) = []) = (ts = [])) \<rbrace>
-  setQueue d p ts
-  \<lbrace>\<lambda>_. valid_bitmapQ \<rbrace>"
-  unfolding setQueue_def bitmapQ_defs
-  by (wp, clarsimp simp: bitmapQ_def)
-
-lemma setQueue_valid_queues':
-  "\<lbrace>valid_queues' and (\<lambda>s. \<forall>t. obj_at' (inQ d p) t s \<longrightarrow> t \<in> set ts)\<rbrace>
-    setQueue d p ts \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  by (wp | simp add: valid_queues'_def setQueue_def)+
-
 lemma setQueue_cur:
   "\<lbrace>\<lambda>s. cur_tcb' s\<rbrace> setQueue d p ts \<lbrace>\<lambda>rv s. cur_tcb' s\<rbrace>"
   unfolding setQueue_def cur_tcb'_def
@@ -2372,9 +3519,17 @@ lemma threadSet_queued_sch_act_wf[wp]:
   apply (wp tcb_in_cur_domain'_lift | simp add: obj_at'_def)+
   done
 
+lemma tcbSchedNext_update_pred_tcb_at'[wp]:
+  "threadSet (tcbSchedNext_update f) t \<lbrace>\<lambda>s. P (pred_tcb_at' proj P' t' s)\<rbrace>"
+  by (wp threadSet_pred_tcb_no_state crunch_wps | clarsimp simp: tcb_to_itcb'_def)+
+
+lemma tcbSchedPrev_update_pred_tcb_at'[wp]:
+  "threadSet (tcbSchedPrev_update f) t \<lbrace>\<lambda>s. P (pred_tcb_at' proj P' t' s)\<rbrace>"
+  by (wp threadSet_pred_tcb_no_state crunch_wps | clarsimp simp: tcb_to_itcb'_def)+
+
 lemma tcbSchedEnqueue_pred_tcb_at'[wp]:
   "\<lbrace>\<lambda>s. pred_tcb_at' proj P' t' s \<rbrace> tcbSchedEnqueue t \<lbrace>\<lambda>_ s. pred_tcb_at' proj P' t' s\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def when_def unless_def)
+  apply (simp add: tcbSchedEnqueue_def tcbQueuePrepend_def when_def unless_def)
   apply (wp threadSet_pred_tcb_no_state crunch_wps | clarsimp simp: tcb_to_itcb'_def)+
   done
 
@@ -2382,8 +3537,9 @@ lemma tcbSchedDequeue_sch_act_wf[wp]:
   "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>
     tcbSchedDequeue t
    \<lbrace>\<lambda>_ s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  unfolding tcbSchedDequeue_def
-  by (wp setQueue_sch_act | wp sch_act_wf_lift | simp add: if_apply_def2)+
+  unfolding tcbSchedDequeue_def tcbQueueRemove_def
+  by (wp setQueue_sch_act threadSet_tcbDomain_triv hoare_drop_imps
+      | wp sch_act_wf_lift | simp add: if_apply_def2)+
 
 crunch nosch: tcbSchedDequeue "\<lambda>s. P (ksSchedulerAction s)"
 
@@ -2479,21 +3635,22 @@ lemma tcbSchedEnqueue_sch_act[wp]:
   "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>
     tcbSchedEnqueue t
    \<lbrace>\<lambda>_ s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  by (simp add: tcbSchedEnqueue_def unless_def)
-     (wp setQueue_sch_act | wp sch_act_wf_lift  | clarsimp)+
+  by (simp add: tcbSchedEnqueue_def tcbQueuePrepend_def unless_def)
+     (wp setQueue_sch_act threadSet_tcbDomain_triv | wp sch_act_wf_lift  | clarsimp)+
 
 lemma tcbSchedEnqueue_weak_sch_act[wp]:
   "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
     tcbSchedEnqueue t
    \<lbrace>\<lambda>_ s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
+  apply (simp add: tcbSchedEnqueue_def tcbQueuePrepend_def unless_def)
   apply (wp setQueue_sch_act threadSet_weak_sch_act_wf | clarsimp)+
   done
 
-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>"
+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
+  apply (clarsimp simp: obj_at'_def)
   done
 
 lemma threadGet_const:
@@ -2539,14 +3696,6 @@ lemma addToBitmap_bitmapQ:
   by (wpsimp simp: bitmap_fun_defs bitmapQ_def prioToL1Index_bit_set prioL2Index_bit_set
              simp_del: bit_exp_iff)
 
-lemma addToBitmap_valid_queues_no_bitmap_except:
-" \<lbrace> valid_queues_no_bitmap_except t \<rbrace>
-     addToBitmap d p
-  \<lbrace>\<lambda>_. valid_queues_no_bitmap_except t \<rbrace>"
-  unfolding addToBitmap_def modifyReadyQueuesL1Bitmap_def modifyReadyQueuesL2Bitmap_def
-             getReadyQueuesL1Bitmap_def getReadyQueuesL2Bitmap_def valid_queues_no_bitmap_except_def
-  by (wp, clarsimp)
-
 crunch norq[wp]: addToBitmap "\<lambda>s. P (ksReadyQueues s)"
   (wp: updateObject_cte_inv hoare_drop_imps)
 crunch norq[wp]: removeFromBitmap "\<lambda>s. P (ksReadyQueues s)"
@@ -2578,9 +3727,8 @@ lemma prioToL1Index_complement_nth_w2p:
 
 lemma valid_bitmapQ_exceptE:
   "\<lbrakk> valid_bitmapQ_except d' p' s ; d \<noteq> d' \<or> p \<noteq> p' \<rbrakk>
-   \<Longrightarrow> bitmapQ d p s = (ksReadyQueues s (d, p) \<noteq> [])"
-   unfolding valid_bitmapQ_except_def
-   by blast
+   \<Longrightarrow> bitmapQ d p s = (\<not> tcbQueueEmpty (ksReadyQueues s (d, p)))"
+  by (fastforce simp: valid_bitmapQ_except_def)
 
 lemma invertL1Index_eq_cancelD:
   "\<lbrakk>  invertL1Index i = invertL1Index j ; i < l2BitmapSize ; j < l2BitmapSize \<rbrakk>
@@ -2695,22 +3843,15 @@ lemma addToBitmap_valid_bitmapQ_except:
   done
 
 lemma addToBitmap_valid_bitmapQ:
-" \<lbrace> valid_bitmapQ_except d p and bitmapQ_no_L2_orphans and
-    (\<lambda>s. ksReadyQueues s (d,p) \<noteq> []) \<rbrace>
-     addToBitmap d p
-  \<lbrace>\<lambda>_. valid_bitmapQ \<rbrace>"
-proof -
-  have "\<lbrace> valid_bitmapQ_except d p and bitmapQ_no_L2_orphans and
-            (\<lambda>s. ksReadyQueues s (d,p) \<noteq> []) \<rbrace>
-         addToBitmap d p
-         \<lbrace>\<lambda>_. valid_bitmapQ_except d p and
-              bitmapQ_no_L2_orphans and (\<lambda>s. bitmapQ d p s \<and> ksReadyQueues s (d,p) \<noteq> []) \<rbrace>"
-  by (wp addToBitmap_valid_queues_no_bitmap_except addToBitmap_valid_bitmapQ_except
-            addToBitmap_bitmapQ_no_L2_orphans addToBitmap_bitmapQ; simp)
-
-  thus ?thesis
-    by - (erule hoare_strengthen_post; fastforce elim: valid_bitmap_valid_bitmapQ_exceptE)
-qed
+  "\<lbrace>valid_bitmapQ_except d p and bitmapQ_no_L2_orphans
+    and (\<lambda>s. \<not> tcbQueueEmpty (ksReadyQueues s (d,p)))\<rbrace>
+   addToBitmap d p
+   \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
+  (is "\<lbrace>?pre\<rbrace> _ \<lbrace>_\<rbrace>")
+  apply (rule_tac Q="\<lambda>_ s. ?pre s \<and> bitmapQ d p s" in hoare_strengthen_post)
+   apply (wpsimp wp: addToBitmap_valid_bitmapQ_except addToBitmap_bitmapQ)
+  apply (fastforce elim: valid_bitmap_valid_bitmapQ_exceptE)
+  done
 
 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>"
@@ -2728,12 +3869,6 @@ lemma threadGet_const_tcb_at_imp_lift:
   apply (clarsimp simp: obj_at'_def)
   done
 
-lemma valid_queues_no_bitmap_objD:
-  "\<lbrakk> valid_queues_no_bitmap s; t \<in> set (ksReadyQueues s (d, p))\<rbrakk>
-   \<Longrightarrow> obj_at' (inQ d p and runnable' \<circ> tcbState) t s"
-   unfolding valid_queues_no_bitmap_def
-   by metis
-
 lemma setQueue_bitmapQ_no_L1_orphans[wp]:
   "\<lbrace> bitmapQ_no_L1_orphans \<rbrace>
        setQueue d p ts
@@ -2753,126 +3888,6 @@ lemma setQueue_sets_queue[wp]:
   unfolding setQueue_def
   by (wp, simp)
 
-lemma tcbSchedEnqueueOrAppend_valid_queues:
-  (* f is either (t#ts) or (ts @ [t]), so we define its properties generally *)
-  assumes f_set[simp]: "\<And>ts. t \<in> set (f ts)"
-  assumes f_set_insert[simp]: "\<And>ts. set (f ts) = insert t (set ts)"
-  assumes f_not_empty[simp]: "\<And>ts. f ts \<noteq> []"
-  assumes f_distinct: "\<And>ts. \<lbrakk> distinct ts ; t \<notin> set ts \<rbrakk> \<Longrightarrow> distinct (f ts)"
-  shows "\<lbrace>Invariants_H.valid_queues and st_tcb_at' runnable' t and valid_objs' \<rbrace>
-    do queued \<leftarrow> threadGet tcbQueued t;
-       unless queued $
-       do tdom \<leftarrow> threadGet tcbDomain t;
-          prio \<leftarrow> threadGet tcbPriority t;
-          queue \<leftarrow> getQueue tdom prio;
-          setQueue tdom prio $ f queue;
-          when (null queue) $ addToBitmap tdom prio;
-          threadSet (tcbQueued_update (\<lambda>_. True)) t
-       od
-    od
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-proof -
-
-  define could_run where "could_run ==
-    \<lambda>d p t. obj_at' (\<lambda>tcb. inQ d p (tcbQueued_update (\<lambda>_. True) tcb) \<and> runnable' (tcbState tcb)) t"
-
-  have addToBitmap_could_run:
-  "\<And>d p. \<lbrace>\<lambda>s. \<forall>d p. t \<in> set (ksReadyQueues s (d, p)) \<longrightarrow> could_run d p t s\<rbrace>
-         addToBitmap d p
-         \<lbrace>\<lambda>_ s. \<forall>d p. t \<in> set (ksReadyQueues s (d, p)) \<longrightarrow> could_run d p t s\<rbrace>"
-    unfolding bitmap_fun_defs
-    by (wp, clarsimp simp: could_run_def)
-
-  have setQueue_valid_queues_no_bitmap_except:
-    "\<And>d p ts.
-     \<lbrace> valid_queues_no_bitmap_except t and
-       (\<lambda>s. ksReadyQueues s (d, p) = ts \<and> p \<le> maxPriority \<and> d \<le> maxDomain \<and> t \<notin> set ts) \<rbrace>
-         setQueue d p (f ts)
-     \<lbrace>\<lambda>rv. valid_queues_no_bitmap_except t\<rbrace>"
-    unfolding setQueue_def valid_queues_no_bitmap_except_def null_def
-    by (wp, auto intro: f_distinct)
-
-  have threadSet_valid_queues_could_run:
-   "\<And>f. \<lbrace> valid_queues_no_bitmap_except t and
-          (\<lambda>s. \<forall>d p. t \<in> set (ksReadyQueues s (d,p)) \<longrightarrow> could_run d p t s) and
-          valid_bitmapQ and bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans \<rbrace>
-            threadSet (tcbQueued_update (\<lambda>_. True)) t
-         \<lbrace>\<lambda>rv. Invariants_H.valid_queues \<rbrace>"
-    unfolding threadSet_def could_run_def
-    apply (rule hoare_seq_ext[OF _ getObject_tcb_sp])
-    apply (rule hoare_pre)
-     apply (simp add: valid_queues_def valid_queues_no_bitmap_def)
-     apply (wp setObject_queues_unchanged_tcb hoare_Ball_helper hoare_vcg_all_lift
-               setObject_tcb_strongest)
-    apply (clarsimp simp: valid_queues_no_bitmap_except_def obj_at'_def)
-    done
-
-  have setQueue_could_run: "\<And>d p ts.
-    \<lbrace> valid_queues and (\<lambda>_. t \<in> set ts) and
-      (\<lambda>s. could_run d p t s) \<rbrace>
-    setQueue d p ts
-    \<lbrace>\<lambda>rv s. (\<forall>d p. t \<in> set (ksReadyQueues s (d, p)) \<longrightarrow> could_run d p t s)\<rbrace>"
-    unfolding setQueue_def valid_queues_def could_run_def
-    by wp (fastforce dest: valid_queues_no_bitmap_objD simp: obj_at'_def inQ_def)
-
-  note hoare_vcg_if_lift[wp] hoare_vcg_conj_lift[wp] hoare_vcg_const_imp_lift[wp]
-
-  show ?thesis
-  unfolding tcbSchedEnqueue_def null_def
-  apply (rule hoare_pre)
-   apply (rule hoare_seq_ext)
-    apply (simp add: unless_def)
-    apply (wp threadSet_valid_queues_could_run)
-        apply (wp addToBitmap_could_run addToBitmap_valid_bitmapQ
-                  addToBitmap_valid_queues_no_bitmap_except addToBitmap_bitmapQ_no_L2_orphans)+
-       apply (wp setQueue_valid_queues_no_bitmap_except setQueue_could_run
-                 setQueue_valid_bitmapQ_except setQueue_sets_queue setQueue_valid_bitmapQ)+
-      apply (wp threadGet_const_tcb_at_imp_lift | simp add: if_apply_def2)+
-  apply clarsimp
-  apply (frule pred_tcb_at')
-  apply (frule (1) valid_objs'_maxDomain)
-  apply (frule (1) valid_objs'_maxPriority)
-  apply (clarsimp simp: valid_queues_def st_tcb_at'_def obj_at'_def valid_queues_no_bitmap_exceptI)
-  apply (fastforce dest!: valid_queues_no_bitmap_objD simp: obj_at'_def inQ_def could_run_def)
-  done
-qed
-
-lemma tcbSchedEnqueue_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues
-    and st_tcb_at' runnable' t
-    and valid_objs' \<rbrace>
-     tcbSchedEnqueue t
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-   unfolding tcbSchedEnqueue_def
-   by (fastforce intro:  tcbSchedEnqueueOrAppend_valid_queues)
-
-lemma tcbSchedAppend_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues
-    and st_tcb_at' runnable' t
-    and valid_objs' \<rbrace>
-     tcbSchedAppend t
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-   unfolding tcbSchedAppend_def
-   by (fastforce intro:  tcbSchedEnqueueOrAppend_valid_queues)
-
-lemma rescheduleRequired_valid_queues[wp]:
-  "\<lbrace>\<lambda>s. Invariants_H.valid_queues s \<and> valid_objs' s \<and>
-        weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | wpc | simp)+
-  apply (fastforce simp: weak_sch_act_wf_def elim: valid_objs'_maxDomain valid_objs'_maxPriority)
-  done
-
-lemma rescheduleRequired_valid_queues_sch_act_simple:
-  "\<lbrace>Invariants_H.valid_queues and sch_act_simple\<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | wpc | simp | fastforce simp: Invariants_H.valid_queues_def sch_act_simple_def)+
-  done
-
 lemma rescheduleRequired_valid_bitmapQ_sch_act_simple:
   "\<lbrace> valid_bitmapQ and sch_act_simple\<rbrace>
     rescheduleRequired
@@ -2914,151 +3929,32 @@ lemma rescheduleRequired_bitmapQ_no_L2_orphans_sch_act_simple:
 
 lemma sts_valid_bitmapQ_sch_act_simple:
   "\<lbrace>valid_bitmapQ and sch_act_simple\<rbrace>
-    setThreadState st t
+   setThreadState st t
    \<lbrace>\<lambda>_. valid_bitmapQ \<rbrace>"
   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 Invariants_H.valid_queues_def inQ_def)+
+   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>"
+  "\<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 Invariants_H.valid_queues_def inQ_def)+
+   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>bitmapQ_no_L1_orphans and sch_act_simple\<rbrace>
+   setThreadState st t
    \<lbrace>\<lambda>_. bitmapQ_no_L1_orphans \<rbrace>"
   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 Invariants_H.valid_queues_def inQ_def)+
-  done
-
-lemma sts_valid_queues:
-  "\<lbrace>\<lambda>s. Invariants_H.valid_queues s \<and>
-    ((\<exists>p. t \<in> set(ksReadyQueues s p)) \<longrightarrow> runnable' st)\<rbrace>
-   setThreadState st t \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: setThreadState_def)
-  apply (wp rescheduleRequired_valid_queues_sch_act_simple
-            threadSet_valid_queues [THEN hoare_strengthen_post])
-   apply (clarsimp simp: sch_act_simple_def Invariants_H.valid_queues_def inQ_def)+
-  done
-
-lemma sbn_valid_queues:
-  "\<lbrace>\<lambda>s. Invariants_H.valid_queues s\<rbrace>
-   setBoundNotification ntfn t \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: setBoundNotification_def)
-  apply (wp threadSet_valid_queues [THEN hoare_strengthen_post])
-   apply (clarsimp simp: sch_act_simple_def Invariants_H.valid_queues_def inQ_def)+
-  done
-
-
-
-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]:
-  "\<lbrace>valid_queues' and st_tcb_at' runnable' t \<rbrace>
-    tcbSchedEnqueue t
-   \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def)
-  apply (rule hoare_pre)
-   apply (rule_tac B="\<lambda>rv. valid_queues' and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"
-           in hoare_seq_ext)
-    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 inQ_def)
-       apply (wp setQueue_valid_queues' | simp | simp add: setQueue_def)+
-     apply (wp getObject_tcb_wp | simp add: threadGet_def)+
-     apply (clarsimp simp: obj_at'_def inQ_def valid_queues'_def)
-    apply (wp getObject_tcb_wp | simp add: threadGet_def)+
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-lemma rescheduleRequired_valid_queues'_weak[wp]:
-  "\<lbrace>\<lambda>s. valid_queues' s \<and> weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply wpsimp
-  apply (clarsimp simp: weak_sch_act_wf_def)
-  done
-
-lemma rescheduleRequired_valid_queues'_sch_act_simple:
-  "\<lbrace>valid_queues' and sch_act_simple\<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | wpc | simp | fastforce simp: valid_queues'_def sch_act_simple_def)+
-  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)
-  apply (wp rescheduleRequired_valid_queues'_sch_act_simple)
-  apply (rule_tac Q="\<lambda>_. valid_queues'" in hoare_post_imp)
-   apply (clarsimp simp: sch_act_simple_def)
-  apply (wp threadSet_valid_queues')
-  apply (fastforce simp: inQ_def obj_at'_def pred_tcb_at'_def)
-  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 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 cteSizeBits_def valid_tcb_state'_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)
-  apply (wp threadSet_valid_objs' | clarsimp simp: valid_tcb'_tcbState_update)+
-  done
-
-lemma rescheduleRequired_ksQ:
-  "\<lbrace>\<lambda>s. sch_act_simple s \<and> P (ksReadyQueues s p)\<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_ s. P (ksReadyQueues s p)\<rbrace>"
-  including no_pre
-  apply (simp add: rescheduleRequired_def sch_act_simple_def)
-  apply (rule_tac B="\<lambda>rv s. (rv = ResumeCurrentThread \<or> rv = ChooseNewThread)
-                            \<and> P (ksReadyQueues s p)" in hoare_seq_ext)
-   apply wpsimp
-   apply (case_tac x; simp)
-  apply wp
+   apply (clarsimp simp: sch_act_simple_def inQ_def)+
   done
 
 lemma setSchedulerAction_ksQ[wp]:
@@ -3073,17 +3969,6 @@ lemma sbn_ksQ:
   "\<lbrace>\<lambda>s. P (ksReadyQueues s p)\<rbrace> setBoundNotification ntfn t \<lbrace>\<lambda>rv s. P (ksReadyQueues s p)\<rbrace>"
   by (simp add: setBoundNotification_def, wp)
 
-lemma sts_ksQ:
-  "\<lbrace>\<lambda>s. sch_act_simple s \<and> P (ksReadyQueues s p)\<rbrace>
-    setThreadState st t
-   \<lbrace>\<lambda>_ s. P (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: setThreadState_def)
-  apply (wp rescheduleRequired_ksQ)
-  apply (rule_tac Q="\<lambda>_ s. P (ksReadyQueues s p)" in hoare_post_imp)
-   apply (clarsimp simp: sch_act_simple_def)+
-  apply (wp, simp)
-  done
-
 lemma setQueue_ksQ[wp]:
   "\<lbrace>\<lambda>s. P ((ksReadyQueues s)((d, p) := q))\<rbrace>
      setQueue d p q
@@ -3091,22 +3976,6 @@ lemma setQueue_ksQ[wp]:
   by (simp add: setQueue_def fun_upd_def[symmetric]
            | wp)+
 
-lemma tcbSchedEnqueue_ksQ:
-  "\<lbrace>\<lambda>s. t' \<notin> set (ksReadyQueues s p) \<and> t' \<noteq> t \<rbrace>
-   tcbSchedEnqueue t \<lbrace>\<lambda>_ s. t' \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply (wpsimp wp: hoare_vcg_imp_lift threadGet_wp)
-  apply (drule obj_at_ko_at')
-  apply fastforce
-  done
-
-lemma rescheduleRequired_ksQ':
-  "\<lbrace>\<lambda>s. t \<notin> set (ksReadyQueues s p) \<and> sch_act_not t s \<rbrace>
-   rescheduleRequired \<lbrace>\<lambda>_ s. t \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wpsimp wp: tcbSchedEnqueue_ksQ)
-  done
-
 lemma threadSet_tcbState_st_tcb_at':
   "\<lbrace>\<lambda>s. P st \<rbrace> threadSet (tcbState_update (\<lambda>_. st)) t \<lbrace>\<lambda>_. st_tcb_at' P t\<rbrace>"
   apply (simp add: threadSet_def pred_tcb_at'_def)
@@ -3117,36 +3986,6 @@ lemma isRunnable_const:
   "\<lbrace>st_tcb_at' runnable' t\<rbrace> isRunnable t \<lbrace>\<lambda>runnable _. runnable \<rbrace>"
   by (rule isRunnable_wp)
 
-lemma sts_ksQ':
-  "\<lbrace>\<lambda>s. (runnable' st \<or> ksCurThread s \<noteq> t) \<and> P (ksReadyQueues s p)\<rbrace>
-   setThreadState st t
-   \<lbrace>\<lambda>_ s. P (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: setThreadState_def)
-  apply (rule hoare_pre_disj')
-   apply (rule hoare_seq_ext [OF _
-                 hoare_vcg_conj_lift
-                   [OF threadSet_tcbState_st_tcb_at' [where P=runnable']
-                       threadSet_ksQ]])
-   apply (rule hoare_seq_ext [OF _
-                 hoare_vcg_conj_lift [OF isRunnable_const isRunnable_inv]])
-   apply (clarsimp simp: when_def)
-   apply (case_tac x)
-    apply (clarsimp, wp)[1]
-   apply (clarsimp)
-  apply (rule hoare_seq_ext [OF _
-                hoare_vcg_conj_lift
-                  [OF threadSet_ct threadSet_ksQ]])
-  apply (rule hoare_seq_ext [OF _ isRunnable_inv])
-  apply (rule hoare_seq_ext [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 valid_ipc_buffer_ptr'D:
   assumes yv: "y < unat max_ipc_words"
   and    buf: "valid_ipc_buffer_ptr' a s"
@@ -3720,7 +4559,7 @@ lemma ct_in_state'_set:
 
 crunches setQueue, rescheduleRequired, tcbSchedDequeue
   for idle'[wp]: "valid_idle'"
-  (simp: crunch_simps)
+  (simp: crunch_simps wp: crunch_wps)
 
 lemma sts_valid_idle'[wp]:
   "\<lbrace>valid_idle' and valid_pspace' and
@@ -3760,8 +4599,9 @@ lemma gbn_sp':
 
 lemma tcbSchedDequeue_tcbState_obj_at'[wp]:
   "\<lbrace>obj_at' (P \<circ> tcbState) t'\<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>rv. obj_at' (P \<circ> tcbState) t'\<rbrace>"
-  apply (simp add: tcbSchedDequeue_def)
-  apply (wp | simp add: o_def split del: if_split cong: if_cong)+
+  apply (simp add: tcbSchedDequeue_def tcbQueueRemove_def)
+  apply (wpsimp wp: getObject_tcb_wp simp: o_def threadGet_def)
+  apply (clarsimp simp: obj_at'_def)
   done
 
 crunch typ_at'[wp]: setQueue "\<lambda>s. P' (typ_at' P t s)"
@@ -3780,10 +4620,14 @@ lemma setQueue_pred_tcb_at[wp]:
 lemma tcbSchedDequeue_pred_tcb_at'[wp]:
   "\<lbrace>\<lambda>s. P' (pred_tcb_at' proj P t' s)\<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>_ s. P' (pred_tcb_at' proj P t' s)\<rbrace>"
   apply (rule_tac P=P' in P_bool_lift)
-   apply (simp add: tcbSchedDequeue_def)
-   apply (wp threadSet_pred_tcb_no_state | clarsimp simp: tcb_to_itcb'_def)+
-  apply (simp add: tcbSchedDequeue_def)
-  apply (wp threadSet_pred_tcb_no_state | clarsimp simp: tcb_to_itcb'_def)+
+   apply (simp add: tcbSchedDequeue_def tcbQueueRemove_def)
+   apply (wpsimp wp: threadSet_pred_tcb_no_state getObject_tcb_wp
+               simp: threadGet_def tcb_to_itcb'_def)
+   apply (clarsimp simp: obj_at'_def)
+  apply (simp add: tcbSchedDequeue_def tcbQueueRemove_def)
+  apply (wpsimp wp: threadSet_pred_tcb_no_state getObject_tcb_wp
+              simp: threadGet_def tcb_to_itcb'_def)
+  apply (clarsimp simp: obj_at'_def)
   done
 
 lemma sts_st_tcb':
@@ -3879,39 +4723,154 @@ crunch nonz_cap[wp]: addToBitmap "ex_nonz_cap_to' t"
 crunch iflive'[wp]: removeFromBitmap if_live_then_nonz_cap'
 crunch nonz_cap[wp]: removeFromBitmap "ex_nonz_cap_to' t"
 
-lemma tcbSchedEnqueue_iflive'[wp]:
-  "\<lbrace>if_live_then_nonz_cap' and ex_nonz_cap_to' tcb\<rbrace>
-    tcbSchedEnqueue tcb \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply (wp threadSet_iflive' hoare_drop_imps | simp add: crunch_simps)+
+crunches rescheduleRequired
+  for cap_to'[wp]: "ex_nonz_cap_to' p"
+
+lemma tcbQueued_update_tcb_cte_cases:
+  "(getF, setF) \<in> ran tcb_cte_cases \<Longrightarrow> getF (tcbQueued_update f tcb) = getF tcb"
+  unfolding tcb_cte_cases_def
+  by (case_tac tcb; fastforce simp: objBits_simps')
+
+lemma tcbSchedNext_update_tcb_cte_cases:
+  "(getF, setF) \<in> ran tcb_cte_cases \<Longrightarrow> getF (tcbSchedNext_update f tcb) = getF tcb"
+  unfolding tcb_cte_cases_def
+  by (case_tac tcb; fastforce simp: objBits_simps')
+
+lemma tcbSchedPrev_update_tcb_cte_cases:
+  "(getF, setF) \<in> ran tcb_cte_cases \<Longrightarrow> getF (tcbSchedPrev_update f tcb) = getF tcb"
+  unfolding tcb_cte_cases_def
+  by (case_tac tcb; fastforce simp: objBits_simps')
+
+lemma tcbSchedNext_update_ctes_of[wp]:
+  "threadSet (tcbSchedNext_update f) tptr \<lbrace>\<lambda>s. P (ctes_of s)\<rbrace>"
+  by (wpsimp wp: threadSet_ctes_ofT simp: tcbSchedNext_update_tcb_cte_cases)
+
+lemma tcbSchedPrev_update_ctes_of[wp]:
+  "threadSet (tcbSchedPrev_update f) tptr \<lbrace>\<lambda>s. P (ctes_of s)\<rbrace>"
+  by (wpsimp wp: threadSet_ctes_ofT simp: tcbSchedPrev_update_tcb_cte_cases)
+
+lemma tcbSchedNext_ex_nonz_cap_to'[wp]:
+  "threadSet (tcbSchedNext_update f) tptr \<lbrace>ex_nonz_cap_to' p\<rbrace>"
+  by (wpsimp wp: threadSet_cap_to simp: tcbSchedNext_update_tcb_cte_cases)
+
+lemma tcbSchedPrev_ex_nonz_cap_to'[wp]:
+  "threadSet (tcbSchedPrev_update f) tptr \<lbrace>ex_nonz_cap_to' p\<rbrace>"
+  by (wpsimp wp: threadSet_cap_to simp: tcbSchedPrev_update_tcb_cte_cases)
+
+lemma tcbSchedNext_update_iflive':
+  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s \<and> ex_nonz_cap_to' t s\<rbrace>
+   threadSet (tcbSchedNext_update f) t
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  by (wpsimp wp: threadSet_iflive'T simp: tcbSchedNext_update_tcb_cte_cases)
+
+lemma tcbSchedPrev_update_iflive':
+  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s \<and> ex_nonz_cap_to' t s\<rbrace>
+   threadSet (tcbSchedPrev_update f) t
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  by (wpsimp wp: threadSet_iflive'T simp: tcbSchedPrev_update_tcb_cte_cases)
+
+lemma tcbQueued_update_iflive'[wp]:
+  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s \<and> ex_nonz_cap_to' t s\<rbrace>
+   threadSet (tcbQueued_update f) t
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  by (wpsimp wp: threadSet_iflive'T simp: tcbQueued_update_tcb_cte_cases)
+
+lemma getTCB_wp:
+  "\<lbrace>\<lambda>s. \<forall>ko :: tcb. ko_at' ko p s \<longrightarrow> Q ko s\<rbrace> getObject p \<lbrace>Q\<rbrace>"
+  apply (wpsimp wp: getObject_tcb_wp)
+  apply (clarsimp simp: obj_at'_def)
   done
 
-lemma rescheduleRequired_iflive'[wp]:
-  "\<lbrace>if_live_then_nonz_cap'
-        and (\<lambda>s. \<forall>t. ksSchedulerAction s = SwitchToThread t
-                \<longrightarrow> st_tcb_at' runnable' t s)\<rbrace>
-      rescheduleRequired
-   \<lbrace>\<lambda>rv. if_live_then_nonz_cap'\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | wpc | simp)+
-  apply (clarsimp simp: pred_tcb_at'_def obj_at'_real_def)
-  apply (erule(1) if_live_then_nonz_capD')
-  apply fastforce
+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 ko_wp_at'_def)
+  done
+
+lemma tcbQueueRemove_ex_nonz_cap_to'[wp]:
+  "tcbQueueRemove q tcbPtr \<lbrace>ex_nonz_cap_to' tcbPtr'\<rbrace>"
+  unfolding tcbQueueRemove_def
+  by (wpsimp wp: threadSet_cap_to' hoare_drop_imps getTCB_wp)
+
+(* We could write this one as "\<forall>t. tcbQueueHead t \<longrightarrow> ..." instead, but we can't do the same in
+   tcbQueueAppend_if_live_then_nonz_cap', and it's nicer if the two lemmas are symmetric *)
+lemma tcbQueuePrepend_if_live_then_nonz_cap':
+  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s \<and> ex_nonz_cap_to' tcbPtr s
+        \<and> (\<not> tcbQueueEmpty q \<longrightarrow> ex_nonz_cap_to' (the (tcbQueueHead q)) s)\<rbrace>
+   tcbQueuePrepend q tcbPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  unfolding tcbQueuePrepend_def
+  by (wpsimp wp: tcbSchedPrev_update_iflive' tcbSchedNext_update_iflive'
+                 hoare_vcg_if_lift2 hoare_vcg_imp_lift')
+
+lemma tcbQueueAppend_if_live_then_nonz_cap':
+  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s \<and> ex_nonz_cap_to' tcbPtr s
+        \<and> (\<not> tcbQueueEmpty q \<longrightarrow> ex_nonz_cap_to' (the (tcbQueueEnd q)) s)\<rbrace>
+   tcbQueueAppend q tcbPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  unfolding tcbQueueAppend_def
+  by (wpsimp wp: tcbSchedPrev_update_iflive' tcbSchedNext_update_iflive')
+
+lemma tcbQueueInsert_if_live_then_nonz_cap':
+  "\<lbrace>if_live_then_nonz_cap' and ex_nonz_cap_to' tcbPtr and valid_objs' and sym_heap_sched_pointers\<rbrace>
+   tcbQueueInsert tcbPtr afterPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  unfolding tcbQueueInsert_def
+  apply (wpsimp wp: tcbSchedPrev_update_iflive' tcbSchedNext_update_iflive' getTCB_wp)
+  apply (intro conjI)
+   apply (erule if_live_then_nonz_capE')
+   apply (clarsimp simp: ko_wp_at'_def obj_at'_def)
+  apply (erule if_live_then_nonz_capE')
+  apply (frule_tac p'=afterPtr in sym_heapD2)
+   apply (fastforce simp: opt_map_def obj_at'_def)
+  apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+  apply (clarsimp simp: valid_tcb'_def ko_wp_at'_def obj_at'_def opt_map_def)
   done
 
+lemma tcbSchedEnqueue_iflive'[wp]:
+  "\<lbrace>if_live_then_nonz_cap' and pspace_aligned' and pspace_distinct'\<rbrace>
+   tcbSchedEnqueue tcbPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  unfolding tcbSchedEnqueue_def
+  apply (wpsimp wp: tcbQueuePrepend_if_live_then_nonz_cap' threadGet_wp)
+  apply normalise_obj_at'
+  apply (rename_tac tcb)
+  apply (frule_tac p=tcbPtr in if_live_then_nonz_capE')
+   apply (fastforce simp: ko_wp_at'_def obj_at'_def)
+  apply clarsimp
+  apply (erule if_live_then_nonz_capE')
+  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 (fastforce dest!: obj_at'_tcbQueueHead_ksReadyQueues
+                    simp: ko_wp_at'_def inQ_def opt_pred_def opt_map_def obj_at'_def
+                   split: option.splits)
+  done
+
+crunches rescheduleRequired
+  for iflive'[wp]: if_live_then_nonz_cap'
+
 lemma sts_iflive'[wp]:
   "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s
-      \<and> (st \<noteq> Inactive \<and> \<not> idle' st \<longrightarrow> ex_nonz_cap_to' t s)\<rbrace>
+      \<and> (st \<noteq> Inactive \<and> \<not> idle' st \<longrightarrow> ex_nonz_cap_to' t s)
+      \<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 setQueue_def)
-  apply (rule hoare_pre)
-   apply (wp | simp)+
-      apply (rule_tac Q="\<lambda>rv. if_live_then_nonz_cap'" in hoare_post_imp)
-       apply clarsimp
-      apply (wp threadSet_iflive' | simp)+
-   apply auto
- done
+  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
+  done
 
 lemma sbn_iflive'[wp]:
   "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s
@@ -4030,6 +4989,18 @@ lemma setBoundNotification_vms'[wp]:
   apply (intro hoare_vcg_all_lift hoare_vcg_disj_lift; wp)
   done
 
+lemma threadSet_ct_not_inQ:
+  "(\<And>tcb. tcbQueued tcb = tcbQueued (F tcb))
+   \<Longrightarrow> threadSet F tcbPtr \<lbrace>\<lambda>s. P (ct_not_inQ s)\<rbrace>"
+  unfolding threadSet_def
+  apply (wpsimp wp: getTCB_wp simp: setObject_def updateObject_default_def)
+  apply (erule rsubst[where P=P])
+  by (fastforce simp: ct_not_inQ_def obj_at'_def objBits_simps ps_clear_def split: if_splits)
+
+crunches tcbQueuePrepend, tcbQueueAppend, tcbQueueInsert, tcbQueueRemove, addToBitmap
+  for ct_not_inQ[wp]: ct_not_inQ
+  (wp: threadSet_ct_not_inQ crunch_wps)
+
 lemma tcbSchedEnqueue_ct_not_inQ:
   "\<lbrace>ct_not_inQ and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t)\<rbrace>
     tcbSchedEnqueue t \<lbrace>\<lambda>_. ct_not_inQ\<rbrace>"
@@ -4053,12 +5024,7 @@ lemma tcbSchedEnqueue_ct_not_inQ:
       done
     show ?thesis
       apply (simp add: tcbSchedEnqueue_def unless_def null_def)
-      apply (wp ts sq hoare_convert_imp [OF addToBitmap_nosch addToBitmap_ct'])+
-           apply (rule_tac Q="\<lambda>_. ?PRE" in hoare_post_imp, clarsimp)
-           apply (wp sq hoare_convert_imp [OF setQueue_nosch setQueue_ct])+
-       apply (rule_tac Q="\<lambda>_. ?PRE" in hoare_post_imp, clarsimp)
-       apply wp
-      apply assumption
+      apply (wpsimp wp: ts sq hoare_vcg_imp_lift' getTCB_wp simp: threadGet_def)+
       done
   qed
 
@@ -4085,12 +5051,7 @@ lemma tcbSchedAppend_ct_not_inQ:
       done
     show ?thesis
       apply (simp add: tcbSchedAppend_def unless_def null_def)
-      apply (wp ts sq hoare_convert_imp [OF addToBitmap_nosch addToBitmap_ct'])+
-           apply (rule_tac Q="\<lambda>_. ?PRE" in hoare_post_imp, clarsimp)
-           apply (wp sq hoare_convert_imp [OF setQueue_nosch setQueue_ct])+
-       apply (rule_tac Q="\<lambda>_. ?PRE" in hoare_post_imp, clarsimp)
-       apply wp
-      apply assumption
+      apply (wpsimp wp: ts sq hoare_vcg_imp_lift' getTCB_wp simp: threadGet_def)+
       done
   qed
 
@@ -4119,12 +5080,10 @@ lemma rescheduleRequired_sa_cnt[wp]:
 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>"
-  (is "\<lbrace>?PRE\<rbrace> _ \<lbrace>_\<rbrace>")
   apply (simp add: possibleSwitchTo_def curDomain_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)
+         | (rule hoare_post_imp[OF _ rescheduleRequired_sa_cnt], fastforce))+
   done
 
 lemma threadSet_tcbState_update_ct_not_inQ[wp]:
@@ -4204,29 +5163,6 @@ lemma tcbSchedDequeue_ct_not_inQ[wp]:
       done
   qed
 
-lemma tcbSchedEnqueue_not_st:
-  "(\<And>tcb st qd. P (tcb\<lparr>tcbState := st, tcbQueued := qd\<rparr>) \<longleftrightarrow> P tcb)
-     \<Longrightarrow> \<lbrace>obj_at' P t'\<rbrace> tcbSchedEnqueue t \<lbrace>\<lambda>_. obj_at' P t'\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply (wp threadGet_wp | simp)+
-  apply (clarsimp simp: obj_at'_def)
-  apply (case_tac obja)
-  apply fastforce
-  done
-
-lemma setThreadState_not_st:
-  "(\<And>tcb st qd. P (tcb\<lparr>tcbState := st, tcbQueued := qd\<rparr>) \<longleftrightarrow> P tcb)
-     \<Longrightarrow> \<lbrace>obj_at' P t'\<rbrace> setThreadState st t \<lbrace>\<lambda>_. obj_at' P t'\<rbrace>"
-  apply (simp add: setThreadState_def rescheduleRequired_def)
-  apply (wp hoare_vcg_conj_lift tcbSchedEnqueue_not_st
-          | wpc
-          | rule hoare_drop_imps
-          | simp)+
-  apply (clarsimp simp: obj_at'_def)
-  apply (case_tac obj)
-  apply fastforce
-  done
-
 crunch ct_idle_or_in_cur_domain'[wp]: setQueue ct_idle_or_in_cur_domain'
   (simp: ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def)
 
@@ -4255,17 +5191,8 @@ lemma removeFromBitmap_ct_idle_or_in_cur_domain'[wp]:
            | clarsimp simp: updateObject_default_def in_monad setNotification_def)+
   done
 
-lemma tcbSchedEnqueue_ksCurDomain[wp]:
-  "\<lbrace> \<lambda>s. P (ksCurDomain s)\<rbrace> tcbSchedEnqueue tptr \<lbrace>\<lambda>_ s. P (ksCurDomain s)\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply wpsimp
-  done
-
-lemma tcbSchedEnqueue_ksDomSchedule[wp]:
-  "\<lbrace> \<lambda>s. P (ksDomSchedule s)\<rbrace> tcbSchedEnqueue tptr \<lbrace>\<lambda>_ s. P (ksDomSchedule s)\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply wpsimp
-  done
+crunches tcbQueuePrepend
+  for ct_idle_or_in_cur_domain'[wp]: ct_idle_or_in_cur_domain'
 
 lemma tcbSchedEnqueue_ct_idle_or_in_cur_domain'[wp]:
   "\<lbrace>ct_idle_or_in_cur_domain'\<rbrace> tcbSchedEnqueue tptr \<lbrace>\<lambda>_. ct_idle_or_in_cur_domain'\<rbrace>"
@@ -4343,12 +5270,375 @@ lemma sts_utr[wp]:
   apply (wp untyped_ranges_zero_lift)
   done
 
+lemma removeFromBitmap_bitmapQ:
+  "\<lbrace>\<top>\<rbrace> removeFromBitmap d p \<lbrace>\<lambda>_ s. \<not> bitmapQ d p s \<rbrace>"
+  unfolding bitmapQ_defs bitmap_fun_defs
+  by (wpsimp simp: bitmap_fun_defs)
+
+lemma removeFromBitmap_valid_bitmapQ[wp]:
+  "\<lbrace>valid_bitmapQ_except d p and bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans
+    and (\<lambda>s. tcbQueueEmpty (ksReadyQueues s (d,p)))\<rbrace>
+   removeFromBitmap d p
+   \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
+  (is "\<lbrace>?pre\<rbrace> _ \<lbrace>_\<rbrace>")
+  apply (rule_tac Q="\<lambda>_ s. ?pre s \<and> \<not> bitmapQ d p s" in hoare_strengthen_post)
+   apply (wpsimp wp: removeFromBitmap_valid_bitmapQ_except removeFromBitmap_bitmapQ)
+  apply (fastforce elim: valid_bitmap_valid_bitmapQ_exceptE)
+  done
+
+crunches tcbSchedDequeue
+  for bitmapQ_no_L1_orphans[wp]: bitmapQ_no_L1_orphans
+  and bitmapQ_no_L2_orphans[wp]: bitmapQ_no_L2_orphans
+  (wp: crunch_wps simp: crunch_simps)
+
+lemma setQueue_nonempty_valid_bitmapQ':
+  "\<lbrace>\<lambda>s. valid_bitmapQ s \<and> \<not> tcbQueueEmpty (ksReadyQueues s (d, p))\<rbrace>
+   setQueue d p queue
+   \<lbrace>\<lambda>_ s. \<not> tcbQueueEmpty queue \<longrightarrow> valid_bitmapQ s\<rbrace>"
+  apply (wpsimp simp: setQueue_def)
+  apply (fastforce simp: valid_bitmapQ_def bitmapQ_def)
+  done
+
+lemma threadSet_valid_bitmapQ_except[wp]:
+  "threadSet f tcbPtr \<lbrace>valid_bitmapQ_except d p\<rbrace>"
+  unfolding threadSet_def
+  apply (wpsimp wp: getTCB_wp simp: setObject_def updateObject_default_def)
+  apply (clarsimp simp: valid_bitmapQ_except_def bitmapQ_def)
+  done
+
+lemma threadSet_bitmapQ:
+  "threadSet F t \<lbrace>bitmapQ domain priority\<rbrace>"
+  unfolding threadSet_def
+  apply (wpsimp wp: getTCB_wp simp: setObject_def updateObject_default_def)
+  by (clarsimp simp: bitmapQ_def)
+
+crunches tcbQueueRemove, tcbQueuePrepend, tcbQueueAppend
+  for valid_bitmapQ_except[wp]: "valid_bitmapQ_except d p"
+  and valid_bitmapQ[wp]: valid_bitmapQ
+  and bitmapQ[wp]: "bitmapQ tdom prio"
+  (wp: crunch_wps)
+
+lemma tcbQueued_imp_queue_nonempty:
+  "\<lbrakk>list_queue_relation ts (ksReadyQueues s (tcbDomain tcb, tcbPriority tcb)) nexts prevs;
+    \<forall>t. t \<in> set ts \<longleftrightarrow> (inQ (tcbDomain tcb) (tcbPriority tcb) |< tcbs_of' s) t;
+    ko_at' tcb tcbPtr s; tcbQueued tcb\<rbrakk>
+   \<Longrightarrow> \<not> tcbQueueEmpty (ksReadyQueues s (tcbDomain tcb, tcbPriority tcb))"
+  apply (clarsimp simp: list_queue_relation_def tcbQueueEmpty_def)
+  apply (drule_tac x=tcbPtr in spec)
+  apply (fastforce dest: heap_path_head simp: inQ_def opt_map_def opt_pred_def obj_at'_def)
+  done
+
+lemma tcbSchedDequeue_valid_bitmapQ[wp]:
+  "\<lbrace>valid_bitmaps\<rbrace> tcbSchedDequeue tcbPtr \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
+  unfolding tcbSchedDequeue_def tcbQueueRemove_def
+  apply (wpsimp wp: setQueue_nonempty_valid_bitmapQ' hoare_vcg_conj_lift
+                    hoare_vcg_if_lift2 hoare_vcg_const_imp_lift threadGet_wp
+         | wp (once) hoare_drop_imps)+
+  by (fastforce dest!: tcbQueued_imp_queue_nonempty
+                 simp: ready_queue_relation_def ksReadyQueues_asrt_def obj_at'_def)
+
+lemma tcbSchedDequeue_valid_bitmaps[wp]:
+  "tcbSchedDequeue tcbPtr \<lbrace>valid_bitmaps\<rbrace>"
+  by (wpsimp simp: valid_bitmaps_def)
+
+lemma setQueue_valid_bitmapQ': (* enqueue only *)
+  "\<lbrace>valid_bitmapQ_except d p and bitmapQ d p and K (\<not> tcbQueueEmpty q)\<rbrace>
+   setQueue d p q
+   \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
+  unfolding setQueue_def bitmapQ_defs
+  by (wpsimp simp: bitmapQ_def)
+
+lemma tcbSchedEnqueue_valid_bitmapQ[wp]:
+  "\<lbrace>valid_bitmaps\<rbrace> tcbSchedEnqueue tcbPtr \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
+  supply if_split[split del]
+  unfolding tcbSchedEnqueue_def
+  apply (wpsimp simp: tcbQueuePrepend_def
+                  wp: setQueue_valid_bitmapQ' addToBitmap_valid_bitmapQ_except addToBitmap_bitmapQ
+                      threadGet_wp)
+  apply (fastforce simp: valid_bitmaps_def valid_bitmapQ_def tcbQueueEmpty_def split: if_splits)
+  done
+
+crunches tcbSchedEnqueue, tcbSchedAppend
+  for bitmapQ_no_L1_orphans[wp]: bitmapQ_no_L1_orphans
+  and bitmapQ_no_L2_orphans[wp]: bitmapQ_no_L2_orphans
+
+lemma tcbSchedEnqueue_valid_bitmaps[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>valid_bitmaps\<rbrace>"
+  unfolding valid_bitmaps_def
+  apply wpsimp
+  apply (clarsimp simp: valid_bitmaps_def)
+  done
+
+crunches rescheduleRequired, threadSet, setThreadState
+  for valid_bitmaps[wp]: valid_bitmaps
+  (rule: valid_bitmaps_lift)
+
+lemma tcbSchedEnqueue_valid_sched_pointers[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>valid_sched_pointers\<rbrace>"
+  apply (clarsimp simp: tcbSchedEnqueue_def getQueue_def unless_def)
+  \<comment> \<open>we step forwards until we can step over the addToBitmap in order to avoid state blow-up\<close>
+  apply (intro hoare_seq_ext[OF _ stateAssert_sp] hoare_seq_ext[OF _ isRunnable_inv]
+               hoare_seq_ext[OF _ assert_sp] hoare_seq_ext[OF _ threadGet_sp]
+               hoare_seq_ext[OF _ gets_sp]
+         | rule hoare_when_cases, fastforce)+
+  apply (forward_inv_step wp: hoare_vcg_ex_lift)
+  supply if_split[split del]
+  apply (wpsimp wp: getTCB_wp
+              simp: threadSet_def setObject_def updateObject_default_def tcbQueuePrepend_def
+                    setQueue_def)
+  apply (clarsimp simp: valid_sched_pointers_def)
+  apply (intro conjI impI)
+   apply (fastforce simp: opt_pred_def opt_map_def split: if_splits)
+  apply normalise_obj_at'
+  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: valid_sched_pointers_def list_queue_relation_def)
+  apply (case_tac "ts = []", fastforce simp: tcbQueueEmpty_def)
+  by (intro conjI impI;
+      force dest!: hd_in_set heap_path_head
+             simp: inQ_def opt_pred_def opt_map_def obj_at'_def split: if_splits)
+
+lemma tcbSchedAppend_valid_sched_pointers[wp]:
+  "tcbSchedAppend tcbPtr \<lbrace>valid_sched_pointers\<rbrace>"
+  apply (clarsimp simp: tcbSchedAppend_def getQueue_def unless_def)
+  \<comment> \<open>we step forwards until we can step over the addToBitmap in order to avoid state blow-up\<close>
+  apply (intro hoare_seq_ext[OF _ stateAssert_sp] hoare_seq_ext[OF _ isRunnable_inv]
+               hoare_seq_ext[OF _ assert_sp] hoare_seq_ext[OF _ threadGet_sp]
+               hoare_seq_ext[OF _ gets_sp]
+         | rule hoare_when_cases, fastforce)+
+  apply (forward_inv_step wp: hoare_vcg_ex_lift)
+  supply if_split[split del]
+  apply (wpsimp wp: getTCB_wp
+              simp: threadSet_def setObject_def updateObject_default_def tcbQueueAppend_def
+                    setQueue_def)
+  apply (clarsimp simp: valid_sched_pointers_def)
+  apply (intro conjI impI)
+   apply (fastforce simp: opt_pred_def opt_map_def split: if_splits)
+  apply normalise_obj_at'
+  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)
+  by (intro conjI impI;
+      clarsimp dest: last_in_set
+               simp: valid_sched_pointers_def opt_map_def list_queue_relation_def tcbQueueEmpty_def
+                     queue_end_valid_def inQ_def opt_pred_def obj_at'_def
+              split: if_splits option.splits;
+      fastforce)
+
+lemma tcbSchedDequeue_valid_sched_pointers[wp]:
+  "\<lbrace>valid_sched_pointers and sym_heap_sched_pointers\<rbrace>
+   tcbSchedDequeue tcbPtr
+   \<lbrace>\<lambda>_. valid_sched_pointers\<rbrace>"
+  supply if_split[split del] fun_upd_apply[simp del]
+  apply (clarsimp simp: tcbSchedDequeue_def getQueue_def setQueue_def)
+  apply (wpsimp wp: threadSet_wp getTCB_wp threadGet_wp simp: tcbQueueRemove_def)
+  apply normalise_obj_at'
+  apply (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 split: if_splits)
+  apply (frule (1) list_queue_relation_neighbour_in_set[where p=tcbPtr])
+   apply (fastforce simp: inQ_def opt_pred_def opt_map_def obj_at'_def)
+  apply (clarsimp simp: list_queue_relation_def)
+  apply (intro conjI impI)
+     \<comment> \<open>the ready queue is the singleton consisting of tcbPtr\<close>
+     apply (clarsimp simp: valid_sched_pointers_def)
+     apply (case_tac "ptr = tcbPtr")
+      apply (force dest!: heap_ls_last_None
+                    simp: prev_queue_head_def queue_end_valid_def inQ_def opt_map_def obj_at'_def)
+     apply (simp add: fun_upd_def opt_pred_def)
+    \<comment> \<open>tcbPtr is the head of the ready queue\<close>
+    subgoal
+      by (auto dest!: heap_ls_last_None
+                simp: valid_sched_pointers_def fun_upd_apply prev_queue_head_def
+                      inQ_def opt_pred_def opt_map_def obj_at'_def
+               split: if_splits option.splits)
+   \<comment> \<open>tcbPtr is the end of the ready queue\<close>
+   subgoal
+     by (auto dest!: heap_ls_last_None
+               simp: valid_sched_pointers_def queue_end_valid_def inQ_def opt_pred_def
+                     opt_map_def fun_upd_apply obj_at'_def
+              split: if_splits option.splits)
+  \<comment> \<open>tcbPtr is in the middle of the ready queue\<close>
+  apply (intro conjI impI allI)
+  by (clarsimp simp: valid_sched_pointers_def inQ_def opt_pred_def opt_map_def fun_upd_apply obj_at'_def
+              split: if_splits option.splits;
+      auto)
+
+lemma tcbQueueRemove_sym_heap_sched_pointers:
+  "\<lbrace>\<lambda>s. sym_heap_sched_pointers s
+        \<and> (\<exists>ts. list_queue_relation ts q (tcbSchedNexts_of s) (tcbSchedPrevs_of s)
+                \<and> tcbPtr \<in> set ts)\<rbrace>
+   tcbQueueRemove q tcbPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  supply heap_path_append[simp del]
+  apply (clarsimp simp: tcbQueueRemove_def)
+  apply (wpsimp wp: threadSet_wp getTCB_wp)
+  apply (rename_tac tcb ts)
+
+  \<comment> \<open>tcbPtr is the head of q, which is not a singleton\<close>
+  apply (rule conjI)
+   apply clarsimp
+   apply (clarsimp simp: list_queue_relation_def Let_def)
+   apply (prop_tac "tcbSchedNext tcb \<noteq> Some tcbPtr")
+    apply (fastforce dest: heap_ls_no_loops[where p=tcbPtr] simp: opt_map_def obj_at'_def)
+   apply (fastforce intro: sym_heap_remove_only'
+                     simp: prev_queue_head_def opt_map_red opt_map_upd_triv obj_at'_def)
+
+  \<comment> \<open>tcbPtr is the end of q, which is not a singleton\<close>
+  apply (intro impI)
+  apply (rule conjI)
+   apply clarsimp
+   apply (prop_tac "tcbSchedPrev tcb \<noteq> Some tcbPtr")
+    apply (fastforce dest!: heap_ls_prev_no_loops[where p=tcbPtr]
+                      simp: list_queue_relation_def opt_map_def obj_at'_def)
+   apply (subst fun_upd_swap, fastforce)
+   apply (fastforce intro: sym_heap_remove_only simp: opt_map_red opt_map_upd_triv obj_at'_def)
+
+  \<comment> \<open>tcbPtr is in the middle of q\<close>
+  apply (intro conjI impI allI)
+  apply (frule (2) list_queue_relation_neighbour_in_set[where p=tcbPtr])
+  apply (frule split_list)
+  apply clarsimp
+  apply (rename_tac xs ys)
+  apply (prop_tac "xs \<noteq> [] \<and> ys \<noteq> []")
+   apply (fastforce simp: list_queue_relation_def queue_end_valid_def)
+  apply (clarsimp simp: list_queue_relation_def)
+  apply (frule (3) ptr_in_middle_prev_next)
+  apply (frule heap_ls_distinct)
+  apply (rename_tac afterPtr beforePtr xs ys)
+  apply (frule_tac before=beforePtr and middle=tcbPtr and after=afterPtr
+                in sym_heap_remove_middle_from_chain)
+      apply (fastforce dest: last_in_set simp: opt_map_def obj_at'_def)
+     apply (fastforce dest: hd_in_set simp: opt_map_def obj_at'_def)
+    apply (rule_tac hp="tcbSchedNexts_of s" in sym_heapD2)
+     apply fastforce
+    apply (fastforce simp: opt_map_def obj_at'_def)
+   apply (fastforce simp: opt_map_def obj_at'_def)
+  apply (fastforce simp: fun_upd_swap opt_map_red opt_map_upd_triv obj_at'_def split: if_splits)
+  done
+
+lemma tcbQueuePrepend_sym_heap_sched_pointers:
+  "\<lbrace>\<lambda>s. sym_heap_sched_pointers s
+        \<and> (\<exists>ts. list_queue_relation ts q (tcbSchedNexts_of s) (tcbSchedPrevs_of s)
+                \<and> tcbPtr \<notin> set ts)
+        \<and> tcbSchedNexts_of s tcbPtr = None \<and> tcbSchedPrevs_of s tcbPtr = None\<rbrace>
+   tcbQueuePrepend q tcbPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  supply if_split[split del]
+  apply (clarsimp simp: tcbQueuePrepend_def)
+  apply (wpsimp wp: threadSet_wp)
+  apply (prop_tac "tcbPtr \<noteq> the (tcbQueueHead q)")
+   apply (case_tac "ts = []";
+          fastforce dest: heap_path_head simp: list_queue_relation_def tcbQueueEmpty_def)
+  apply (drule_tac a=tcbPtr and b="the (tcbQueueHead q)" in sym_heap_connect)
+    apply assumption
+   apply (clarsimp simp: list_queue_relation_def prev_queue_head_def tcbQueueEmpty_def)
+  apply (fastforce simp: fun_upd_swap opt_map_red opt_map_upd_triv obj_at'_def tcbQueueEmpty_def)
+  done
+
+lemma tcbQueueInsert_sym_heap_sched_pointers:
+  "\<lbrace>\<lambda>s. sym_heap_sched_pointers s
+        \<and> tcbSchedNexts_of s tcbPtr = None \<and> tcbSchedPrevs_of s tcbPtr = None\<rbrace>
+   tcbQueueInsert tcbPtr afterPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  apply (clarsimp simp: tcbQueueInsert_def)
+  \<comment> \<open>forwards step in order to name beforePtr below\<close>
+  apply (rule hoare_seq_ext[OF _ getObject_tcb_sp])
+  apply (rule hoare_seq_ext[OF _ assert_sp])
+  apply (rule hoare_ex_pre_conj[simplified conj_commute], rename_tac beforePtr)
+  apply (rule hoare_seq_ext[OF _ assert_sp])
+  apply (wpsimp wp: threadSet_wp)
+  apply normalise_obj_at'
+  apply (prop_tac "tcbPtr \<noteq> afterPtr")
+   apply (clarsimp simp: list_queue_relation_def opt_map_red obj_at'_def)
+  apply (prop_tac "tcbPtr \<noteq> beforePtr")
+   apply (fastforce dest: sym_heap_None simp: opt_map_def obj_at'_def split: option.splits)
+  apply (prop_tac "tcbSchedNexts_of s beforePtr = Some afterPtr")
+   apply (fastforce intro: sym_heapD2 simp: opt_map_def obj_at'_def)
+  apply (fastforce dest: sym_heap_insert_into_middle_of_chain
+                   simp: fun_upd_swap opt_map_red opt_map_upd_triv obj_at'_def)
+  done
+
+lemma tcbQueueAppend_sym_heap_sched_pointers:
+  "\<lbrace>\<lambda>s. sym_heap_sched_pointers s
+        \<and> (\<exists>ts. list_queue_relation ts q (tcbSchedNexts_of s) (tcbSchedPrevs_of s)
+                \<and> tcbPtr \<notin> set ts)
+        \<and> tcbSchedNexts_of s tcbPtr = None \<and> tcbSchedPrevs_of s tcbPtr = None\<rbrace>
+   tcbQueueAppend q tcbPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  supply if_split[split del]
+  apply (clarsimp simp: tcbQueueAppend_def)
+  apply (wpsimp wp: threadSet_wp)
+  apply (clarsimp simp: tcbQueueEmpty_def list_queue_relation_def queue_end_valid_def obj_at'_def
+                 split: if_splits)
+   apply fastforce
+  apply (drule_tac a="last ts" and b=tcbPtr in sym_heap_connect)
+    apply (fastforce dest: heap_ls_last_None)
+   apply assumption
+  apply (simp add: opt_map_red tcbQueueEmpty_def)
+  apply (subst fun_upd_swap, simp)
+  apply (fastforce simp: opt_map_red opt_map_upd_triv)
+  done
+
+lemma tcbQueued_update_sym_heap_sched_pointers[wp]:
+  "threadSet (tcbQueued_update f) tcbPtr \<lbrace>sym_heap_sched_pointers\<rbrace>"
+  by (rule sym_heap_sched_pointers_lift;
+      wpsimp wp: threadSet_tcbSchedPrevs_of threadSet_tcbSchedNexts_of)
+
+lemma tcbSchedEnqueue_sym_heap_sched_pointers[wp]:
+  "\<lbrace>sym_heap_sched_pointers and valid_sched_pointers\<rbrace>
+   tcbSchedEnqueue tcbPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  unfolding tcbSchedEnqueue_def
+  apply (wpsimp wp: tcbQueuePrepend_sym_heap_sched_pointers threadGet_wp
+              simp: addToBitmap_def 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 (fastforce dest!: spec[where x=tcbPtr] inQ_implies_tcbQueueds_of
+                    simp: valid_sched_pointers_def opt_pred_def opt_map_def obj_at'_def)
+  done
+
+lemma tcbSchedAppend_sym_heap_sched_pointers[wp]:
+  "\<lbrace>sym_heap_sched_pointers and valid_sched_pointers\<rbrace>
+   tcbSchedAppend tcbPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  unfolding tcbSchedAppend_def
+  apply (wpsimp wp: tcbQueueAppend_sym_heap_sched_pointers threadGet_wp
+              simp: addToBitmap_def 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 (fastforce dest!: spec[where x=tcbPtr] inQ_implies_tcbQueueds_of
+                    simp: valid_sched_pointers_def opt_pred_def opt_map_def obj_at'_def)
+  done
+
+lemma tcbSchedDequeue_sym_heap_sched_pointers[wp]:
+  "\<lbrace>sym_heap_sched_pointers and valid_sched_pointers\<rbrace>
+   tcbSchedDequeue tcbPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  unfolding tcbSchedDequeue_def
+  apply (wpsimp wp: tcbQueueRemove_sym_heap_sched_pointers hoare_vcg_if_lift2 threadGet_wp
+              simp: bitmap_fun_defs)
+  apply (fastforce simp: ready_queue_relation_def ksReadyQueues_asrt_def inQ_def opt_pred_def
+                         opt_map_def obj_at'_def)
+  done
+
+crunches setThreadState
+  for valid_sched_pointers[wp]: valid_sched_pointers
+  and sym_heap_sched_pointers[wp]: sym_heap_sched_pointers
+  (simp: crunch_simps wp: crunch_wps threadSet_valid_sched_pointers threadSet_sched_pointers)
+
 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. (\<exists>p. t \<in> set(ksReadyQueues s p)) \<longrightarrow> runnable' st)
       and (\<lambda>s. runnable' st \<and> obj_at' tcbQueued t s \<longrightarrow> st_tcb_at' runnable' t s)
       and sch_act_simple
       and invs'\<rbrace>
@@ -4357,21 +5647,21 @@ lemma sts_invs_minor':
   including no_pre
   apply (simp add: invs'_def valid_state'_def)
   apply (rule hoare_pre)
-   apply (wp sts_valid_queues valid_irq_node_lift irqs_masked_lift
-              setThreadState_ct_not_inQ
+   apply (wp valid_irq_node_lift irqs_masked_lift
+             setThreadState_ct_not_inQ
             | simp add: cteCaps_of_def o_def)+
   apply (clarsimp simp: sch_act_simple_def)
   apply (intro conjI)
-     apply clarsimp
-    defer
-    apply (clarsimp dest!: st_tcb_at_state_refs_ofD'
-                    elim!: rsubst[where P=sym_refs]
-                   intro!: ext)
-   apply (clarsimp elim!: st_tcb_ex_cap'')
+       apply clarsimp
+      defer
+      apply (clarsimp dest!: st_tcb_at_state_refs_ofD'
+                      elim!: rsubst[where P=sym_refs]
+                     intro!: ext)
+      apply (clarsimp elim!: st_tcb_ex_cap'')
+    apply fastforce
+   apply fastforce
   apply (frule tcb_in_valid_state', clarsimp+)
-  apply (cases st, simp_all add: valid_tcb_state'_def
-                  split: Structures_H.thread_state.split_asm)
-  done
+  by (cases st; simp add: valid_tcb_state'_def split: Structures_H.thread_state.split_asm)
 
 lemma sts_cap_to'[wp]:
   "\<lbrace>ex_nonz_cap_to' p\<rbrace> setThreadState st t \<lbrace>\<lambda>rv. ex_nonz_cap_to' p\<rbrace>"
@@ -4416,12 +5706,56 @@ lemma threadSet_ct_running':
   apply wp
   done
 
+lemma tcbQueuePrepend_tcbPriority_obj_at'[wp]:
+  "tcbQueuePrepend queue tptr \<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
+  unfolding tcbQueuePrepend_def
+  apply (wpsimp wp: threadSet_wp)
+  by (auto simp: obj_at'_def objBits_simps ps_clear_def split: if_splits)
+
+lemma tcbQueuePrepend_tcbDomain_obj_at'[wp]:
+  "tcbQueuePrepend queue tptr \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  unfolding tcbQueuePrepend_def
+  apply (wpsimp wp: threadSet_wp)
+  by (auto simp: obj_at'_def objBits_simps ps_clear_def split: if_splits)
+
+lemma tcbSchedDequeue_tcbPriority[wp]:
+  "tcbSchedDequeue t \<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
+  unfolding tcbSchedDequeue_def tcbQueueRemove_def
+  by (wpsimp wp: hoare_when_weak_wp hoare_drop_imps)
+
+lemma tcbSchedDequeue_tcbDomain[wp]:
+  "tcbSchedDequeue t \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  unfolding tcbSchedDequeue_def tcbQueueRemove_def
+  by (wpsimp wp: hoare_when_weak_wp hoare_drop_imps)
+
+lemma tcbSchedEnqueue_tcbPriority_obj_at'[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
+  unfolding tcbSchedEnqueue_def setQueue_def
+  by wpsimp
+
+lemma tcbSchedEnqueue_tcbDomain_obj_at'[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  unfolding tcbSchedEnqueue_def setQueue_def
+  by wpsimp
+
+crunches rescheduleRequired
+  for tcbPriority_obj_at'[wp]: "obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'"
+  and tcbDomain_obj_at'[wp]: "obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'"
+
+lemma setThreadState_tcbPriority_obj_at'[wp]:
+  "setThreadState ts tptr \<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
+  unfolding setThreadState_def
+  apply (wpsimp wp: threadSet_wp)
+  apply (fastforce simp: obj_at'_def objBits_simps ps_clear_def)
+  done
+
 lemma setThreadState_tcb_in_cur_domain'[wp]:
   "\<lbrace>tcb_in_cur_domain' t'\<rbrace> setThreadState 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 setThreadState_not_st | simp)+
+  apply (simp add: setThreadState_def)
+  apply (wpsimp wp: threadSet_ct_idle_or_in_cur_domain' hoare_drop_imps)+
   done
 
 lemma asUser_global_refs':   "\<lbrace>valid_global_refs'\<rbrace> asUser t f \<lbrace>\<lambda>rv. valid_global_refs'\<rbrace>"
@@ -4567,10 +5901,13 @@ 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)
-            (set_eobject ptr etcb) (setObject ptr tcb')"
+  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
@@ -4591,21 +5928,34 @@ lemma set_eobject_corres':
    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 cte_relation_def tcb_relation_def
+     apply (clarsimp simp: obj_at'_def other_obj_relation_def tcb_relation_cut_def cte_relation_def
+                           tcb_relation_def
                      split: if_split_asm)+
    apply (clarsimp simp: aobj_relation_cuts_def split: RISCV64_A.arch_kernel_obj.splits)
    apply (rename_tac arch_kernel_obj obj d p ts)
    apply (case_tac arch_kernel_obj; simp)
      apply (clarsimp simp: pte_relation_def is_tcb_def
                     split: if_split_asm)+
-  apply (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
+  apply (extract_conjunct \<open>match conclusion in "ekheap_relation _ _" \<Rightarrow> -\<close>)
+   apply (simp only: ekheap_relation_def dom_fun_upd2 simp_thms)
+   apply (frule bspec, erule domI)
+   apply (rule ballI, drule(1) bspec)
+   apply (drule domD)
+   apply (clarsimp simp: obj_at'_def)
+   apply (insert e)
+   apply (clarsimp simp: other_obj_relation_def etcb_relation_def is_other_obj_relation_type
                   split: Structures_A.kernel_object.splits kernel_object.splits arch_kernel_obj.splits)
+   apply (frule in_ready_q_tcbQueued_eq[where t=ptr])
+  apply (rename_tac s' conctcb' abstcb exttcb)
+  apply (clarsimp simp: ready_queues_relation_def Let_def)
+  apply (prop_tac "(tcbSchedNexts_of s')(ptr := tcbSchedNext tcb') = tcbSchedNexts_of s'")
+   apply (fastforce simp: opt_map_def obj_at'_def non_exst_same_def split: option.splits)
+  apply (prop_tac "(tcbSchedPrevs_of s')(ptr := tcbSchedPrev tcb') = tcbSchedPrevs_of s'")
+   apply (fastforce simp: opt_map_def obj_at'_def non_exst_same_def split: option.splits)
+  apply (clarsimp simp: ready_queue_relation_def opt_map_def opt_pred_def obj_at'_def inQ_def
+                        non_exst_same_def
+                 split: option.splits)
+  apply metis
   done
 
 lemma set_eobject_corres:
@@ -4613,9 +5963,13 @@ lemma set_eobject_corres:
   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)
-                  (set_eobject add etcbu) (setObject add tcbu')"
+  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)
@@ -4642,24 +5996,27 @@ lemma set_eobject_corres:
 
 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)
-                    (ethread_set f t) (threadSet f' t)"
+  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+
+     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 simp
+  apply (clarsimp simp: obj_at'_def)
   done
 
 lemmas ethread_set_corres =
diff --git a/proof/refine/RISCV64/Tcb_R.thy b/proof/refine/RISCV64/Tcb_R.thy
index 101d292c3a..8f9b36617b 100644
--- a/proof/refine/RISCV64/Tcb_R.thy
+++ b/proof/refine/RISCV64/Tcb_R.thy
@@ -191,18 +191,13 @@ lemma setupReplyMaster_weak_sch_act_wf[wp]:
   apply assumption
   done
 
-crunches setupReplyMaster
-  for valid_queues[wp]: "Invariants_H.valid_queues"
-  and valid_queues'[wp]: "valid_queues'"
-  (wp: crunch_wps simp: crunch_simps)
-
 crunches 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) (invs' and tcb_at' t)
+  "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)
@@ -213,19 +208,20 @@ lemma restart_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_valid_queues sts_st_tcb'
-                    | clarsimp simp: valid_tcb_state'_def)+
-       apply (rule_tac Q="\<lambda>rv. valid_sched and cur_tcb and pspace_aligned and pspace_distinct"
-                       in hoare_strengthen_post)
-        apply wp
-       apply (simp add: valid_sched_def valid_sched_action_def)
-      apply (rule_tac Q="\<lambda>rv. invs' and tcb_at' t" in hoare_strengthen_post)
-       apply wp
-      apply (clarsimp simp: invs'_def valid_state'_def sch_act_wf_weak valid_pspace'_def)
-     apply wp+
+              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 simp add: invs'_def valid_state'_def sch_act_wf_weak)
+  apply clarsimp
   done
 
 lemma restart_invs':
@@ -312,6 +308,11 @@ lemma asUser_postModifyRegisters_corres:
     apply (rule corres_stateAssert_assume)
   by simp+
 
+crunches restart
+  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 tcb_at dest and ex_nonz_cap_to dest)
         (invs' and sch_act_simple and tcb_at' dest and ex_nonz_cap_to' dest)
@@ -338,10 +339,12 @@ lemma invokeTCB_WriteRegisters_corres:
               apply simp
              apply (wp+)[2]
            apply ((wp hoare_weak_lift_imp restart_invs'
-               | strengthen valid_sched_weak_strg einvs_valid_etcbs invs_valid_queues' invs_queues
-                            invs_weak_sch_act_wf
-               | 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]
+                   | 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_post_imp)
           apply (fastforce simp: invs_def valid_sched_weak_strg valid_sched_def valid_state_def dest!: idle_no_ex_cap)
          prefer 2
@@ -370,6 +373,10 @@ lemma suspend_ResumeCurrentThread_imp_notct[wp]:
    \<lbrace>\<lambda>rv s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>"
   by (wpsimp simp: suspend_def)
 
+crunches restart, suspend
+  for cur_tcb'[wp]: cur_tcb'
+  (wp: crunch_wps threadSet_cur ignore: threadSet)
+
 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
@@ -434,7 +441,7 @@ proof -
                 apply (simp add: frame_registers_def frameRegisters_def)
                apply (simp add: getRestartPC_def setNextPC_def dc_def[symmetric])
                apply (rule Q[OF refl refl])
-              apply (wp mapM_x_wp' | simp)+
+              apply (wp mapM_x_wp' hoare_weak_lift_imp | simp)+
             apply (rule corres_split_nor)
                apply (rule corres_when[OF refl])
                apply (rule R[OF refl refl])
@@ -446,11 +453,11 @@ proof -
                     apply simp
                    apply (solves \<open>wp hoare_weak_lift_imp\<close>)+
              apply (rule_tac Q="\<lambda>_. einvs and tcb_at dest" in hoare_post_imp)
-              apply (clarsimp simp: invs_def valid_state_def valid_pspace_def valid_sched_weak_strg valid_sched_def)
+              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_post_imp)
-              apply (clarsimp simp: invs'_def valid_state'_def invs_weak_sch_act_wf cur_tcb'_def)
-             apply ((wp mapM_x_wp' hoare_weak_lift_imp | simp+)+)[4]
+              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
@@ -499,38 +506,6 @@ lemma copyreg_invs':
    \<lbrace>\<lambda>rv. invs'\<rbrace>"
   by (rule hoare_strengthen_post, rule copyreg_invs'', simp)
 
-lemma threadSet_valid_queues_no_state:
-  "\<lbrace>Invariants_H.valid_queues and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))\<rbrace>
-     threadSet f t \<lbrace>\<lambda>_. Invariants_H.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 setObject_queues_unchanged_tcb
-             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
-                        objBits_simps addToQs_def
-             split del: if_split cong: if_cong)
-  apply (fastforce simp: inQ_def split: if_split_asm)
-  done
-
 lemma isRunnable_corres:
   "corres (\<lambda>ts runn. runnable ts = runn)
           (tcb_at t and pspace_aligned and pspace_distinct) \<top>
@@ -555,16 +530,6 @@ lemma tcbSchedDequeue_not_queued:
   apply (wp tg_sp' [where P=\<top>, simplified] | simp)+
   done
 
-lemma tcbSchedDequeue_not_in_queue:
-  "\<And>p. \<lbrace>Invariants_H.valid_queues and tcb_at' t and valid_objs'\<rbrace> tcbSchedDequeue t
-   \<lbrace>\<lambda>rv s. t \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (rule_tac Q="\<lambda>rv. Invariants_H.valid_queues and obj_at' (Not \<circ> tcbQueued) t"
-               in hoare_post_imp)
-   apply (fastforce simp: valid_queues_def valid_queues_no_bitmap_def obj_at'_def inQ_def )
-  apply (wp tcbSchedDequeue_not_queued tcbSchedDequeue_valid_queues |
-         simp add: valid_objs'_maxDomain valid_objs'_maxPriority)+
-  done
-
 lemma threadSet_ct_in_state':
   "(\<And>tcb. tcbState (f tcb) = tcbState tcb) \<Longrightarrow>
   \<lbrace>ct_in_state' test\<rbrace> threadSet f t \<lbrace>\<lambda>rv. ct_in_state' test\<rbrace>"
@@ -610,14 +575,19 @@ lemma tcbSchedDequeue_ct_in_state'[wp]:
 
 crunch cur[wp]: tcbSchedDequeue cur_tcb'
 
+crunches tcbSchedDequeue
+  for st_tcb_at'[wp]: "\<lambda>s. P (st_tcb_at' st tcbPtr s)"
+
 lemma sp_corres2:
-  "corres dc (valid_etcbs and weak_valid_sched_action and cur_tcb and pspace_aligned and pspace_distinct)
-             (Invariants_H.valid_queues and valid_queues' and tcb_at' t and
-             (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and valid_objs' and (\<lambda>_. x \<le> maxPriority))
-             (set_priority t x) (setPriority t x)"
+  "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])
+    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])
@@ -629,25 +599,28 @@ lemma sp_corres2:
            apply ((clarsimp
                    | wp hoare_weak_lift_imp hoare_vcg_if_lift hoare_wp_combs gts_wp
                         isRunnable_wp)+)[4]
-       apply (wp hoare_vcg_imp_lift' hoare_vcg_if_lift hoare_vcg_all_lift)
-      apply clarsimp
-      apply ((wp hoare_drop_imps hoare_vcg_if_lift hoare_vcg_all_lift
-                 isRunnable_wp threadSet_pred_tcb_no_state threadSet_valid_queues_no_state
-                 threadSet_valid_queues'_no_state threadSet_cur threadSet_valid_objs_tcbPriority_update
-                 threadSet_weak_sch_act_wf threadSet_ct_in_state'[simplified ct_in_state'_def]
-              | simp add: etcb_relation_def)+)[1]
-     apply ((wp hoare_vcg_imp_lift' hoare_vcg_if_lift hoare_vcg_all_lift hoare_vcg_disj_lift
-                tcbSchedDequeue_not_in_queue tcbSchedDequeue_valid_queues
-                tcbSchedDequeue_ct_in_state'[simplified ct_in_state'_def]
-             | simp add: etcb_relation_def)+)[2]
+       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 (force simp: state_relation_def elim: valid_objs'_maxDomain valid_objs'_maxPriority)
+  apply clarsimp
   done
 
 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)"
+  "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)
@@ -673,6 +646,9 @@ 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>
@@ -680,10 +656,8 @@ lemma out_corresT:
                \<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
-  apply (clarsimp simp add: threadset_corresT [OF _ x y e])
+  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]
@@ -692,32 +666,40 @@ lemma tcbSchedDequeue_sch_act_simple[wp]:
   "tcbSchedDequeue t \<lbrace>sch_act_simple\<rbrace>"
   by (wpsimp simp: sch_act_simple_def)
 
+lemma tcbSchedNext_update_tcb_cte_cases:
+  "(a, b) \<in> ran tcb_cte_cases \<Longrightarrow> a (tcbPriority_update f tcb) = a tcb"
+  unfolding tcb_cte_cases_def
+  by (case_tac tcb; fastforce simp: objBits_simps')
+
+lemma threadSet_priority_invs':
+  "\<lbrace>invs' and tcb_at' t and K (p \<le> maxPriority)\<rbrace>
+   threadSet (tcbPriority_update (\<lambda>_. p)) t
+   \<lbrace>\<lambda>_. invs'\<rbrace>"
+  apply (rule hoare_gen_asm)
+  apply (simp add: invs'_def valid_state'_def split del: if_split)
+  apply (wp threadSet_valid_pspace'
+            threadSet_sch_actT_P[where P=False, simplified]
+            threadSet_state_refs_of'T[where f'=id]
+            threadSet_iflive'T
+            threadSet_ifunsafe'T
+            threadSet_idle'T
+            valid_irq_node_lift
+            valid_irq_handlers_lift''
+            threadSet_ctes_ofT
+            threadSet_not_inQ
+            threadSet_ct_idle_or_in_cur_domain'
+            threadSet_cur
+            untyped_ranges_zero_lift
+            sym_heap_sched_pointers_lift threadSet_valid_sched_pointers
+            threadSet_tcbSchedPrevs_of threadSet_tcbSchedNexts_of
+         | clarsimp simp: cteCaps_of_def tcbSchedNext_update_tcb_cte_cases | rule refl)+
+  apply (clarsimp simp: o_def)
+  by (auto simp: obj_at'_def)
+
 lemma setP_invs':
   "\<lbrace>invs' and tcb_at' t and K (p \<le> maxPriority)\<rbrace> setPriority t p \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (rule hoare_gen_asm)
-  apply (simp add: setPriority_def)
-  apply (wp rescheduleRequired_all_invs_but_ct_not_inQ)
-    apply simp
-    apply (wp hoare_vcg_conj_lift hoare_vcg_imp_lift')
-      unfolding st_tcb_at'_def
-      apply (strengthen not_obj_at'_strengthen, wp)
-     apply (wp hoare_vcg_imp_lift')
-      apply (rule_tac Q="\<lambda>rv s. invs' s" in hoare_post_imp)
-       apply (clarsimp simp: invs_sch_act_wf' invs'_def invs_queues)
-       apply (clarsimp simp: valid_state'_def)
-      apply (wp hoare_drop_imps threadSet_invs_trivial,
-             simp_all add: inQ_def cong: conj_cong)[1]
-     apply (wp hoare_drop_imps threadSet_invs_trivial,
-            simp_all add: inQ_def cong: conj_cong)[1]
-    apply (wp hoare_drop_imps threadSet_invs_trivial,
-           simp_all add: inQ_def cong: conj_cong)[1]
-   apply (rule_tac Q="\<lambda>_. invs' and obj_at' (Not \<circ> tcbQueued) t
-                                  and (\<lambda>s. \<forall>d p. t \<notin> set (ksReadyQueues s (d,p)))"
-              in hoare_post_imp)
-    apply (clarsimp simp: obj_at'_def inQ_def)
-   apply (wp tcbSchedDequeue_not_queued)+
-  apply clarsimp
-  done
+  unfolding setPriority_def
+  by (wpsimp wp: rescheduleRequired_invs' threadSet_priority_invs')
 
 crunches setPriority, setMCPriority
   for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
@@ -984,13 +966,6 @@ lemma setMCPriority_valid_objs'[wp]:
 crunch sch_act_simple[wp]: setMCPriority sch_act_simple
   (wp: ssa_sch_act_simple crunch_wps rule: sch_act_simple_lift simp: crunch_simps)
 
-(* For some reason, when this was embedded in a larger expression clarsimp wouldn't remove it.
-   Adding it as a simp rule does *)
-lemma inQ_tc_corres_helper:
-  "(\<forall>d p. (\<exists>tcb. tcbQueued tcb \<and> tcbPriority tcb = p \<and> tcbDomain tcb = d \<and>
-          (tcbQueued tcb \<longrightarrow> tcbDomain tcb \<noteq> d)) \<longrightarrow> a \<notin> set (ksReadyQueues s (d, p)))"
-  by clarsimp
-
 abbreviation "valid_option_prio \<equiv> case_option True (\<lambda>(p, auth). p \<le> maxPriority)"
 
 definition valid_tcb_invocation :: "tcbinvocation \<Rightarrow> bool" where
@@ -1012,35 +987,29 @@ lemma thread_set_ipc_weak_valid_sched_action:
               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_helper2:
-  "is_aligned a msg_align_bits \<Longrightarrow>
-   \<lbrace>invs' and tcb_at' t\<rbrace>
-   threadSet (tcbIPCBuffer_update (\<lambda>_. a)) t
-   \<lbrace>\<lambda>x s. Invariants_H.valid_queues s \<and> valid_queues' s\<rbrace>"
-  by (wp threadSet_invs_trivial
-      | strengthen  invs_valid_queues' invs_queues invs_weak_sch_act_wf
-      | clarsimp simp: inQ_def )+
-
 lemma threadcontrol_corres_helper3:
-  "\<lbrace> einvs and simple_sched_action\<rbrace>
+  "\<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>x. weak_valid_sched_action and valid_etcbs \<rbrace>"
-  apply (rule hoare_pre)
-   apply (wp check_cap_inv | simp add:)+
-  by (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)
+   \<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 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>x. Invariants_H.valid_queues and valid_queues'\<rbrace>"
-  apply (wp
-       | strengthen  invs_valid_queues' invs_queues invs_weak_sch_act_wf
-       | clarsimp simp: )+
+         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>_ 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)
@@ -1059,73 +1028,45 @@ lemma is_valid_vtable_root_simp:
   by (simp add: is_valid_vtable_root_def split: cap.splits arch_cap.splits option.splits)
 
 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 \<and> tcbDomain (F tcb) = tcbDomain tcb"
-  assumes a: "\<forall>tcb. tcbBoundNotification (F tcb) = tcbBoundNotification 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> tcb_at' t s \<and> (\<forall>tcb. is_aligned (tcbIPCBuffer (F tcb)) msg_align_bits)
-        \<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. \<not> tcbQueued tcb \<and> tcbQueued (F tcb)) \<longrightarrow> ex_nonz_cap_to' t s \<and> t \<noteq> ksCurThread s)
-        \<and> (\<forall>tcb. tcbQueued (F tcb) \<and> ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> tcbQueued tcb \<or> t \<noteq> ksCurThread s)\<rbrace>
-        threadSet F t
-   \<lbrace>\<lambda>rv. invs'\<rbrace>"
-proof -
-  from z have domains: "\<And>tcb. tcbDomain (F tcb) = tcbDomain tcb" by blast
-  note threadSet_sch_actT_P[where P=False, simplified]
-  have y: "\<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 valid_state'_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_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_cur
-              untyped_ranges_zero_lift
-            |clarsimp simp: y z a domains cteCaps_of_def |rule refl)+
-    apply (clarsimp simp: obj_at'_def pred_tcb_at'_def)
-    apply (clarsimp simp: cur_tcb'_def valid_irq_node'_def valid_queues'_def o_def)
-    by (fastforce simp: domains ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def z a)
-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 objBits_simps addToQs_def
-             split del: if_split cong: if_cong)
-  apply (fastforce simp: 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>"
@@ -1179,6 +1120,12 @@ crunches option_update_thread
   for aligned[wp]: "pspace_aligned"
   and distinct[wp]: "pspace_distinct"
 
+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'" and y: "newroot_rel f f'"
       and z: "(case g of None \<Rightarrow> g' = None
@@ -1370,10 +1317,20 @@ proof -
              apply (rule corres_split[OF getCurThread_corres], clarsimp)
                apply (rule corres_when[OF refl rescheduleRequired_corres])
               apply (wpsimp wp: gct_wp)+
-            apply (wp thread_set_ipc_weak_valid_sched_action|wp (once) hoare_drop_imp)+
-           apply simp
-           apply (wp threadcontrol_corres_helper2 | wpc | simp)+
-          apply (wp|strengthen einvs_valid_etcbs)+
+            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)+
+          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
@@ -1402,7 +1359,7 @@ proof -
                    cap_delete_valid_cap cteDelete_deletes
                    cteDelete_invs'
                    | strengthen use_no_cap_to_obj_asid_strg
-                   | clarsimp simp: inQ_def inQ_tc_corres_helper)+
+                   | 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)
@@ -1485,36 +1442,16 @@ proof -
                                  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
-                                 cap_delete_deletes
+                                 check_cap_inv[where P=simple_sched_action]
+                                 cap_delete_deletes hoare_drop_imps
                                  cap_delete_valid_cap
-                           simp: ran_tcb_cap_cases)
+                           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_drop_imps)
-              apply ((wpsimp wp: hoare_vcg_const_imp_lift hoare_vcg_imp_lift' hoare_vcg_all_lift
-                                 threadSet_cte_wp_at' threadSet_invs_trivialT2 cteDelete_invs'
-                           simp: tcb_cte_cases_def cteSizeBits_def), (fastforce+)[6])
-                  apply wpsimp
-                  apply (wpsimp wp: hoare_vcg_const_imp_lift hoare_drop_imps hoare_vcg_all_lift
-                                    threadSet_invs_trivialT2 threadSet_cte_wp_at'
-                              simp: tcb_cte_cases_def cteSizeBits_def, (fastforce+)[6])
-                  apply wpsimp
-                  apply (wpsimp wp: hoare_vcg_const_imp_lift hoare_drop_imps hoare_vcg_all_lift
-                                    rescheduleRequired_invs' threadSet_cte_wp_at'
-                              simp: tcb_cte_cases_def)
-                 apply (wpsimp wp: hoare_vcg_const_imp_lift hoare_drop_imps hoare_vcg_all_lift
-                                   rescheduleRequired_invs' threadSet_invs_trivialT2 threadSet_cte_wp_at'
-                             simp: tcb_cte_cases_def cteSizeBits_def, (fastforce+)[6])
-                 apply wpsimp
-                 apply (wpsimp wp: hoare_vcg_const_imp_lift hoare_drop_imps hoare_vcg_all_lift
-                                   rescheduleRequired_invs' threadSet_invs_trivialT2 threadSet_cte_wp_at'
-                             simp: tcb_cte_cases_def cteSizeBits_def, (fastforce+)[6])
-                 apply wpsimp
-                 apply (wpsimp wp: hoare_vcg_const_imp_lift hoare_drop_imps hoare_vcg_all_lift
-                                   rescheduleRequired_invs' threadSet_cap_to' threadSet_invs_trivialT2
-                                   threadSet_cte_wp_at' hoare_drop_imps
-                               simp: tcb_cte_cases_def cteSizeBits_def)
-                apply (clarsimp)
+               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_lift_R hoare_vcg_all_lift
                                    hoare_vcg_const_imp_lift_R hoare_vcg_const_imp_lift
                                    threadSet_valid_objs' thread_set_not_state_valid_sched
@@ -1527,9 +1464,9 @@ proof -
                         | strengthen tcb_cap_always_valid_strg
                                    tcb_at_invs
                                    use_no_cap_to_obj_asid_strg
-                        | (erule exE, clarsimp simp: word_bits_def))+)
+                        | (erule exE, clarsimp simp: word_bits_def) | wp (once) hoare_drop_imps)+)
                 apply (strengthen valid_tcb_ipc_buffer_update)
-                apply (strengthen invs_valid_objs')
+                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
@@ -1653,7 +1590,7 @@ lemma setSchedulerAction_invs'[wp]:
   apply (simp add: setSchedulerAction_def)
   apply wp
   apply (clarsimp simp add: invs'_def valid_state'_def valid_irq_node'_def
-                valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs cur_tcb'_def
+                valid_queues_def bitmapQ_defs cur_tcb'_def
                 ct_not_inQ_def)
   apply (simp add: ct_idle_or_in_cur_domain'_def)
   done
@@ -1783,8 +1720,8 @@ lemma invokeTCB_corres:
            apply (rule TcbAcc_R.rescheduleRequired_corres)
           apply (rule corres_trivial, simp)
          apply (wpsimp wp: hoare_drop_imp)+
-   apply (clarsimp simp: valid_sched_weak_strg einvs_valid_etcbs invs_distinct)
-  apply (clarsimp simp: invs_valid_queues' invs_queues)
+   apply (fastforce dest: valid_sched_valid_queues simp: valid_sched_weak_strg einvs_valid_etcbs)
+  apply fastforce
   done
 
 lemma tcbBoundNotification_caps_safe[simp]:
@@ -1799,6 +1736,10 @@ lemma valid_bound_ntfn_lift:
   apply (wp typ_at_lifts[OF P])+
   done
 
+crunches 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
@@ -1811,7 +1752,7 @@ lemma bindNotification_invs':
   apply (simp add: bindNotification_def invs'_def valid_state'_def)
   apply (rule hoare_seq_ext[OF _ get_ntfn_sp'])
   apply (rule hoare_pre)
-   apply (wp set_ntfn_valid_pspace' sbn_sch_act' sbn_valid_queues valid_irq_node_lift
+   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)+
@@ -2037,12 +1978,6 @@ lemma decodeSetMCPriority_corres:
       apply (clarsimp simp: newroot_rel_def elim!: is_thread_cap.elims(2))
   by (wpsimp simp: valid_cap_def valid_cap'_def)+
 
-lemma valid_objs'_maxPriority':
-  "\<And>s t. \<lbrakk> valid_objs' s; tcb_at' t s \<rbrakk> \<Longrightarrow> obj_at' (\<lambda>tcb. tcbMCP tcb \<le> maxPriority) t s"
-  apply (erule (1) valid_objs_valid_tcbE)
-  apply (clarsimp simp: valid_tcb'_def)
-  done
-
 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_def)
diff --git a/proof/refine/RISCV64/Untyped_R.thy b/proof/refine/RISCV64/Untyped_R.thy
index 2f1d77bac5..09b5873f65 100644
--- a/proof/refine/RISCV64/Untyped_R.thy
+++ b/proof/refine/RISCV64/Untyped_R.thy
@@ -1340,16 +1340,6 @@ crunch nosch[wp]: insertNewCaps "\<lambda>s. P (ksSchedulerAction s)"
 
 crunch exst[wp]: set_cdt "\<lambda>s. P (exst s)"
 
-(*FIXME: Move to StateRelation*)
-lemma state_relation_schact[elim!]:
-  "(s,s') \<in> state_relation \<Longrightarrow> sched_act_relation (scheduler_action s) (ksSchedulerAction s')"
-  apply (simp add: state_relation_def)
-  done
-
-lemma state_relation_queues[elim!]: "(s,s') \<in> state_relation \<Longrightarrow> ready_queues_relation (ready_queues s) (ksReadyQueues s')"
-  apply (simp add: state_relation_def)
-  done
-
 lemma set_original_symb_exec_l:
   "corres_underlying {(s, s'). f (kheap s) (exst s) s'} nf 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)
@@ -1376,6 +1366,10 @@ lemma updateNewFreeIndex_noop_psp_corres:
         | simp add: updateTrackedFreeIndex_def getSlotCap_def)+
   done
 
+crunches 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]
 shows
@@ -3622,8 +3616,8 @@ lemma updateFreeIndex_clear_invs':
        apply (simp add:updateCap_def)
        apply (wp setCTE_irq_handlers' getCTE_wp)
       apply (simp add:updateCap_def)
-      apply (wp irqs_masked_lift valid_queues_lift' cur_tcb_lift ct_idle_or_in_cur_domain'_lift
-                hoare_vcg_disj_lift untyped_ranges_zero_lift getCTE_wp
+      apply (wp irqs_masked_lift cur_tcb_lift ct_idle_or_in_cur_domain'_lift
+                hoare_vcg_disj_lift untyped_ranges_zero_lift getCTE_wp valid_bitmaps_lift
                | wp (once) hoare_use_eq[where f="gsUntypedZeroRanges"]
                | simp add: getSlotCap_def
                | simp add: cte_wp_at_ctes_of)+
@@ -4203,14 +4197,12 @@ context begin interpretation Arch . (*FIXME: arch_split*)
 lemma resetUntypedCap_corres:
   "untypinv_relation ui ui'
     \<Longrightarrow> corres (dc \<oplus> dc)
-    (invs 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)
   apply (rule corres_guard_imp)
@@ -5059,7 +5051,7 @@ lemma inv_untyped_corres':
       apply (clarsimp simp only: pred_conj_def invs ui)
       apply (strengthen vui)
       apply (cut_tac vui invs invs')
-      apply (clarsimp simp: cte_wp_at_caps_of_state valid_sched_etcbs)
+      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
@@ -5109,7 +5101,6 @@ crunches insertNewCap
   and global_refs': "\<lambda>s. P (global_refs' s)"
   and gsMaxObjectSize[wp]: "\<lambda>s. P (gsMaxObjectSize s)"
   and irq_states' [wp]: valid_irq_states'
-  and vq'[wp]: valid_queues'
   and irqs_masked' [wp]: irqs_masked'
   and valid_machine_state'[wp]: valid_machine_state'
   and pspace_domain_valid[wp]: pspace_domain_valid
@@ -5117,6 +5108,9 @@ crunches insertNewCap
   and tcbState_inv[wp]: "obj_at' (\<lambda>tcb. P (tcbState tcb)) 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 sched_queues_projs[wp]: "\<lambda>s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)"
+  and tcbQueueds_of[wp]: "\<lambda>s. P (tcbQueued |< tcbs_of' s)"
+  and valid_sched_pointers[wp]: valid_sched_pointers
   (wp: crunch_wps)
 
 crunch if_unsafe_then_cap'[wp]: updateNewFreeIndex "if_unsafe_then_cap'"
@@ -5273,8 +5267,8 @@ lemma insertNewCap_invs':
   apply (simp add: invs'_def valid_state'_def)
   apply (rule hoare_pre)
    apply (wp insertNewCap_valid_pspace' sch_act_wf_lift
-             valid_queues_lift cur_tcb_lift tcb_in_cur_domain'_lift
-             insertNewCap_valid_global_refs'
+             cur_tcb_lift tcb_in_cur_domain'_lift valid_bitmaps_lift
+             insertNewCap_valid_global_refs' sym_heap_sched_pointers_lift
              valid_arch_state_lift'
              valid_irq_node_lift insertNewCap_valid_irq_handlers)
   apply (clarsimp simp: cte_wp_at_ctes_of)
diff --git a/proof/refine/RISCV64/VSpace_R.thy b/proof/refine/RISCV64/VSpace_R.thy
index 67c56baa2f..d92b4ee74c 100644
--- a/proof/refine/RISCV64/VSpace_R.thy
+++ b/proof/refine/RISCV64/VSpace_R.thy
@@ -794,10 +794,6 @@ crunch norqL1[wp]: storePTE "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
 crunch norqL2[wp]: storePTE "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
   (simp: updateObject_default_def)
 
-lemma storePTE_valid_queues' [wp]:
-  "\<lbrace>valid_queues'\<rbrace> storePTE p pte \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  by (wp valid_queues_lift')
-
 lemma storePTE_iflive [wp]:
   "\<lbrace>if_live_then_nonz_cap'\<rbrace> storePTE p pte \<lbrace>\<lambda>rv. if_live_then_nonz_cap'\<rbrace>"
   apply (simp add: storePTE_def)
@@ -908,6 +904,11 @@ crunches storePTE
   and gsUntypedZeroRanges[wp]: "\<lambda>s. P (gsUntypedZeroRanges s)"
   (wp: setObject_ksPSpace_only updateObject_default_inv)
 
+lemma storePTE_tcbs_of'[wp]:
+  "storePTE c (pte::pte) \<lbrace>\<lambda>s. P' (tcbs_of' s)\<rbrace>"
+  unfolding storePTE_def
+  by setObject_easy_cases
+
 crunches storePTE
   for pspace_canonical'[wp]: "pspace_canonical'"
   and pspace_in_kernel_mappings'[wp]: "pspace_in_kernel_mappings'"
@@ -920,15 +921,12 @@ lemma storePTE_valid_objs[wp]:
   apply simp
   done
 
-lemma storePTE_valid_queues [wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> storePTE p pde \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  by (wp valid_queues_lift | simp add: pred_tcb_at'_def)+
-
 lemma storePTE_invs[wp]:
   "storePTE p pte \<lbrace>invs'\<rbrace>"
   unfolding invs'_def valid_state'_def valid_pspace'_def
   by (wpsimp wp: sch_act_wf_lift valid_global_refs_lift' irqs_masked_lift valid_arch_state_lift'
                  valid_irq_node_lift cur_tcb_lift valid_irq_handlers_lift'' untyped_ranges_zero_lift
+                 valid_bitmaps_lift
              simp: cteCaps_of_def o_def)
 
 lemma setASIDPool_valid_objs [wp]:
@@ -975,14 +973,6 @@ lemma setASIDPool_tcb_obj_at'[wp]:
   apply (clarsimp simp add: updateObject_default_def in_monad)
   done
 
-lemma setASIDPool_valid_queues [wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  by (wp valid_queues_lift | simp add: pred_tcb_at'_def)+
-
-lemma setASIDPool_valid_queues' [wp]:
-  "\<lbrace>valid_queues'\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  by (wp valid_queues_lift')
-
 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
@@ -1097,6 +1087,10 @@ 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]:
   "setObject p (ap::asidpool) \<lbrace>invs'\<rbrace>"
   apply (simp add: invs'_def valid_state'_def valid_pspace'_def)
@@ -1104,7 +1098,7 @@ lemma setASIDPool_invs [wp]:
             valid_arch_state_lift' valid_irq_node_lift
             cur_tcb_lift valid_irq_handlers_lift''
             untyped_ranges_zero_lift
-            updateObject_default_inv
+            updateObject_default_inv valid_bitmaps_lift
           | simp add: cteCaps_of_def
           | rule setObject_ksPSpace_only)+
   apply (clarsimp simp:  o_def)
diff --git a/proof/refine/RISCV64/orphanage/Orphanage.thy b/proof/refine/RISCV64/orphanage/Orphanage.thy
index 5d7f35c110..a26007ad1b 100644
--- a/proof/refine/RISCV64/orphanage/Orphanage.thy
+++ b/proof/refine/RISCV64/orphanage/Orphanage.thy
@@ -59,8 +59,7 @@ where
 definition
    all_queued_tcb_ptrs :: "kernel_state \<Rightarrow> machine_word set"
 where
-   "all_queued_tcb_ptrs s \<equiv>
-       { tcb_ptr. \<exists> priority. tcb_ptr : set ((ksReadyQueues s) priority) }"
+   "all_queued_tcb_ptrs s \<equiv> { tcb_ptr. obj_at' tcbQueued tcb_ptr s }"
 
 lemma st_tcb_at_neg':
   "(st_tcb_at' (\<lambda> ts. \<not> P ts) t s) = (tcb_at' t s \<and> \<not> st_tcb_at' P t s)"
@@ -107,8 +106,8 @@ lemma no_orphans_lift:
      "\<And> tcb_ptr. \<lbrace> \<lambda>s. tcb_ptr = ksCurThread s \<rbrace> f \<lbrace> \<lambda>_ s. tcb_ptr = ksCurThread s \<rbrace>"
    assumes st_tcb_at'_is_lifted:
      "\<And>P p. \<lbrace> \<lambda>s. st_tcb_at' P p s\<rbrace> f \<lbrace> \<lambda>_ s. st_tcb_at' P p s \<rbrace>"
-   assumes ksReadyQueues_is_lifted:
-     "\<And>P. \<lbrace> \<lambda>s. P (ksReadyQueues s)\<rbrace> f \<lbrace> \<lambda>_ s. P (ksReadyQueues s) \<rbrace>"
+   assumes tcbQueued_is_lifted:
+     "\<And>P tcb_ptr. f \<lbrace> \<lambda>s. obj_at' (\<lambda>tcb. P (tcbQueued tcb)) tcb_ptr s \<rbrace>"
    assumes ksSchedulerAction_is_lifted:
      "\<And>P. \<lbrace> \<lambda>s. P (ksSchedulerAction s)\<rbrace> f \<lbrace> \<lambda>_ s. P (ksSchedulerAction s) \<rbrace>"
    shows
@@ -119,7 +118,7 @@ lemma no_orphans_lift:
   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
     apply (rule ksCurThread_is_lifted)
    apply (wp hoare_vcg_disj_lift)
-    apply (rule ksReadyQueues_is_lifted)
+    apply (wpsimp wp: tcbQueued_is_lifted)
    apply (wp hoare_vcg_disj_lift)
     apply (rule typ_at'_is_lifted)
    apply (wp hoare_vcg_disj_lift)
@@ -139,13 +138,12 @@ lemma st_tcb_at'_all_active_tcb_ptrs_lift:
   by (clarsimp simp: all_active_tcb_ptrs_def)
      (rule st_tcb_at'_is_active_tcb_ptr_lift [OF assms])
 
-lemma ksQ_all_queued_tcb_ptrs_lift:
-  assumes "\<And>P p. \<lbrace>\<lambda>s. P (ksReadyQueues s p)\<rbrace> f \<lbrace>\<lambda>rv s. P (ksReadyQueues s p)\<rbrace>"
+lemma tcbQueued_all_queued_tcb_ptrs_lift:
+  assumes "\<And>Q P tcb_ptr. f \<lbrace>\<lambda>s. Q (obj_at' (\<lambda>tcb. P (tcbQueued tcb)) tcb_ptr s)\<rbrace>"
   shows "\<lbrace>\<lambda>s. P (t \<in> all_queued_tcb_ptrs s)\<rbrace> f \<lbrace>\<lambda>_ s. P (t \<in> all_queued_tcb_ptrs s)\<rbrace>"
   apply (clarsimp simp: all_queued_tcb_ptrs_def)
   apply (rule_tac P=P in P_bool_lift)
    apply (wp hoare_vcg_ex_lift assms)
-  apply (clarsimp)
   apply (wp hoare_vcg_all_lift assms)
   done
 
@@ -180,6 +178,11 @@ lemma almost_no_orphans_disj:
   apply (auto intro: pred_tcb_at')
   done
 
+lemma all_queued_tcb_ptrs_ksReadyQueues_update[simp]:
+  "tcb_ptr \<in> all_queued_tcb_ptrs (ksReadyQueues_update f s) = (tcb_ptr \<in> all_queued_tcb_ptrs s)"
+  unfolding all_queued_tcb_ptrs_def
+  by (clarsimp simp: obj_at'_def)
+
 lemma no_orphans_update_simps[simp]:
   "no_orphans (gsCNodes_update f s) = no_orphans s"
   "no_orphans (gsUserPages_update g s) = no_orphans s"
@@ -243,6 +246,12 @@ crunch no_orphans [wp]: removeFromBitmap "no_orphans"
 crunch almost_no_orphans [wp]: addToBitmap "almost_no_orphans x"
 crunch almost_no_orphans [wp]: removeFromBitmap "almost_no_orphans x"
 
+lemma setCTE_tcbQueued[wp]:
+  "setCTE ptr v \<lbrace>\<lambda>s. Q (obj_at' (\<lambda>tcb. P (tcbQueued tcb)) t s)\<rbrace>"
+  apply (simp add: setCTE_def)
+  apply (rule setObject_cte_obj_at_tcb', simp_all)
+  done
+
 lemma setCTE_no_orphans [wp]:
   "\<lbrace> \<lambda>s. no_orphans s \<rbrace>
    setCTE p cte
@@ -256,7 +265,7 @@ lemma setCTE_almost_no_orphans [wp]:
    setCTE p cte
    \<lbrace> \<lambda>rv s. almost_no_orphans tcb_ptr s \<rbrace>"
   unfolding almost_no_orphans_disj all_queued_tcb_ptrs_def
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift setCTE_typ_at' setCTE_pred_tcb_at')
+  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift setCTE_typ_at' setCTE_pred_tcb_at')
   done
 
 crunch no_orphans [wp]: activateIdleThread "no_orphans"
@@ -266,128 +275,131 @@ lemma asUser_no_orphans [wp]:
    asUser thread f
    \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
   unfolding no_orphans_disj all_queued_tcb_ptrs_def
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
+  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift)
   done
 
+lemma threadSet_all_queued_tcb_ptrs:
+  "\<forall>tcb. tcbQueued (F tcb) = tcbQueued tcb \<Longrightarrow> threadSet F tptr \<lbrace>\<lambda>s. P (t \<in> all_queued_tcb_ptrs s)\<rbrace>"
+  unfolding almost_no_orphans_disj all_queued_tcb_ptrs_def
+  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_st_tcb_at2 threadSet_wp)
+  apply (erule rsubst[where P=P])
+  apply (clarsimp simp: obj_at'_def ps_clear_upd objBits_simps)
+  done
+
+crunches removeFromBitmap, addToBitmap, setQueue
+  for all_queued_tcb_ptrs[wp]: "\<lambda>s. P (t \<in> all_queued_tcb_ptrs s)"
+  (wp: tcbQueued_all_queued_tcb_ptrs_lift)
+
+crunches tcbQueuePrepend, tcbQueueAppend
+  for all_queued_tcb_ptrs[wp]: "\<lambda>s. P (t \<in> all_queued_tcb_ptrs s)"
+  (wp: threadSet_all_queued_tcb_ptrs ignore: threadSet)
+
+lemma tcbQueued_update_True_all_queued_tcb_ptrs[wp]:
+  "\<lbrace>\<lambda>s. tcb_ptr \<noteq> tcb_ptr' \<longrightarrow> tcb_ptr' \<in> all_queued_tcb_ptrs s\<rbrace>
+   threadSet (tcbQueued_update (\<lambda>_. True)) tcb_ptr
+   \<lbrace>\<lambda>_ s. tcb_ptr' \<in> all_queued_tcb_ptrs s\<rbrace>"
+  apply (wpsimp wp: threadSet_wp)
+  apply (fastforce simp: all_queued_tcb_ptrs_def obj_at'_def ps_clear_upd objBits_simps)
+  done
+
+lemma tcbSchedEnqueue_all_queued_tcb_ptrs[wp]:
+  "\<lbrace>\<lambda>s. tcb_ptr \<noteq> tcb_ptr' \<longrightarrow> tcb_ptr \<in> all_queued_tcb_ptrs s\<rbrace>
+   tcbSchedEnqueue tcb_ptr'
+   \<lbrace>\<lambda>_ s. tcb_ptr \<in> all_queued_tcb_ptrs s\<rbrace>"
+  unfolding tcbSchedEnqueue_def tcbQueuePrepend_def
+  apply (wpsimp wp: hoare_vcg_imp_lift' threadGet_wp
+         | wpsimp wp: threadSet_all_queued_tcb_ptrs)+
+  apply (clarsimp simp: all_queued_tcb_ptrs_def obj_at'_def)
+  done
+
+lemmas tcbSchedEnqueue_all_queued_tcb_ptrs'[wp] =
+  tcbSchedEnqueue_all_queued_tcb_ptrs[simplified all_queued_tcb_ptrs_def, simplified]
+
+lemma tcbSchedAppend_all_queued_tcb_ptrs[wp]:
+  "\<lbrace>\<lambda>s. tcb_ptr \<noteq> tcb_ptr' \<longrightarrow> tcb_ptr \<in> all_queued_tcb_ptrs s\<rbrace>
+   tcbSchedAppend tcb_ptr'
+   \<lbrace>\<lambda>_ s. tcb_ptr \<in> all_queued_tcb_ptrs s\<rbrace>"
+  unfolding tcbSchedAppend_def tcbQueueAppend_def
+  apply (wpsimp wp: hoare_vcg_imp_lift' threadGet_wp
+         | wpsimp wp: threadSet_all_queued_tcb_ptrs)+
+  apply (clarsimp simp: all_queued_tcb_ptrs_def obj_at'_def)
+  done
+
+lemmas tcbSchedAppend_all_queued_tcb_ptrs'[wp] =
+  tcbSchedAppend_all_queued_tcb_ptrs[simplified all_queued_tcb_ptrs_def, simplified]
+
 lemma threadSet_no_orphans:
-  "\<forall>tcb. \<not> is_active_thread_state (tcbState tcb) \<longrightarrow> \<not> is_active_thread_state (tcbState (F tcb)) \<Longrightarrow>
-   \<lbrace> \<lambda>s. no_orphans s \<rbrace>
-   threadSet F tptr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+  "\<lbrakk>\<forall>tcb. \<not> is_active_thread_state (tcbState tcb) \<longrightarrow> \<not> is_active_thread_state (tcbState (F tcb));
+    \<forall>tcb. tcbQueued (F tcb) = tcbQueued tcb\<rbrakk>
+   \<Longrightarrow> threadSet F tptr \<lbrace>no_orphans\<rbrace>"
   unfolding no_orphans_disj all_queued_tcb_ptrs_def
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_st_tcb_at2 | clarsimp)+
-  done
+  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_st_tcb_at2)
 
-lemma threadSet_almost_no_orphans:
-  "\<forall>tcb. \<not> is_active_thread_state (tcbState tcb) \<longrightarrow> \<not> is_active_thread_state (tcbState (F tcb)) \<Longrightarrow>
-   \<lbrace> \<lambda>s. almost_no_orphans ptr s \<rbrace>
-   threadSet F tptr
-   \<lbrace> \<lambda>rv s. almost_no_orphans ptr s \<rbrace>"
-  unfolding almost_no_orphans_disj all_queued_tcb_ptrs_def
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_st_tcb_at2 | clarsimp)+
+lemma tcbQueued_update_True_no_orphans:
+  "\<lbrace>almost_no_orphans tptr and tcb_at' tptr\<rbrace>
+   threadSet (tcbQueued_update (\<lambda>_. True)) tptr
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
+  unfolding no_orphans_disj
+  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_st_tcb_at2)
+  apply (fastforce simp: almost_no_orphans_def all_active_tcb_ptrs_def
+                         tcb_at_typ_at' st_tcb_at_neg' is_active_tcb_ptr_def)
   done
 
-lemma setQueue_no_orphans_enq:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> set (ksReadyQueues s (d, prio)) \<subseteq> set qs \<rbrace>
-   setQueue d prio qs
-   \<lbrace> \<lambda>_ s. no_orphans s \<rbrace>"
-  unfolding setQueue_def
-  apply wp
-  apply (clarsimp simp: no_orphans_def all_queued_tcb_ptrs_def
-                  split: if_split_asm)
+lemma tcbQueued_update_True_almost_no_orphans:
+  "threadSet (tcbQueued_update (\<lambda>_. True)) tptr' \<lbrace>almost_no_orphans tptr\<rbrace>"
+  unfolding almost_no_orphans_disj
+  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift' hoare_vcg_disj_lift threadSet_st_tcb_at2)
   apply fastforce
   done
 
-lemma setQueue_almost_no_orphans_enq:
-  "\<lbrace> \<lambda>s. almost_no_orphans tcb_ptr s \<and> set (ksReadyQueues s (d, prio)) \<subseteq> set qs \<and> tcb_ptr \<in> set qs \<rbrace>
-   setQueue d prio qs
-   \<lbrace> \<lambda>_ s. no_orphans s \<rbrace>"
+lemma threadSet_almost_no_orphans:
+  "\<lbrakk>\<forall>tcb. \<not> is_active_thread_state (tcbState tcb) \<longrightarrow> \<not> is_active_thread_state (tcbState (F tcb));
+    \<forall>tcb. tcbQueued (F tcb) = tcbQueued tcb\<rbrakk>
+   \<Longrightarrow> threadSet F tptr \<lbrace>almost_no_orphans ptr\<rbrace>"
+  unfolding almost_no_orphans_disj all_queued_tcb_ptrs_def
+  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_st_tcb_at2)
+
+lemma setQueue_no_orphans[wp]:
+  "setQueue d prio qs \<lbrace>no_orphans\<rbrace>"
   unfolding setQueue_def
   apply wp
-  apply (clarsimp simp: no_orphans_def almost_no_orphans_def all_queued_tcb_ptrs_def
-                  split: if_split_asm)
-  apply fastforce
+  apply (clarsimp simp: no_orphans_def)
   done
 
-lemma setQueue_almost_no_orphans_enq_lift:
-  "\<lbrace> \<lambda>s. almost_no_orphans tcb_ptr s \<and> set (ksReadyQueues s (d, prio)) \<subseteq> set qs \<rbrace>
-   setQueue d prio qs
-   \<lbrace> \<lambda>_ s. almost_no_orphans tcb_ptr s \<rbrace>"
+lemma setQueue_almost_no_orphans[wp]:
+  "setQueue d prio qs \<lbrace>almost_no_orphans tptr\<rbrace>"
   unfolding setQueue_def
   apply wp
-  apply (clarsimp simp: almost_no_orphans_def all_queued_tcb_ptrs_def
-                  split: if_split_asm)
-  apply fastforce
+  apply (clarsimp simp: almost_no_orphans_def)
   done
 
 lemma tcbSchedEnqueue_no_orphans[wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<rbrace>
-   tcbSchedEnqueue tcb_ptr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
-  unfolding tcbSchedEnqueue_def
-  apply (wp setQueue_no_orphans_enq threadSet_no_orphans | clarsimp simp: unless_def)+
-   apply (wp getObject_tcb_wp | clarsimp simp: threadGet_def)+
-  apply (drule obj_at_ko_at')
-  apply auto
+  "tcbSchedEnqueue tcb_ptr \<lbrace>no_orphans\<rbrace>"
+  unfolding tcbSchedEnqueue_def tcbQueuePrepend_def
+  apply (wpsimp wp: tcbQueued_update_True_no_orphans threadSet_almost_no_orphans threadGet_wp)
+  apply (fastforce simp: no_orphans_strg_almost)
   done
 
 lemma tcbSchedAppend_no_orphans[wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<rbrace>
-   tcbSchedAppend tcb_ptr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
-  unfolding tcbSchedAppend_def
-  apply (wp setQueue_no_orphans_enq threadSet_no_orphans | clarsimp simp: unless_def)+
-   apply (wp getObject_tcb_wp | clarsimp simp: threadGet_def)+
-  apply (drule obj_at_ko_at')
-  apply auto
-  done
-
-lemma ko_at_obj_at':
-  "ko_at' ko p s \<and> P ko \<Longrightarrow> obj_at' P p s"
-  unfolding  obj_at'_def
-  apply clarsimp
-  done
-
-lemma queued_in_queue:
-  "\<lbrakk>valid_queues' s; ko_at' tcb tcb_ptr s; tcbQueued tcb\<rbrakk> \<Longrightarrow>
-   \<exists> p. tcb_ptr \<in> set (ksReadyQueues s p)"
-  unfolding valid_queues'_def
-   apply (drule_tac x="tcbDomain tcb" in spec)
-   apply (drule_tac x="tcbPriority tcb" in spec)
-   apply (drule_tac x="tcb_ptr" in spec)
-   apply (drule mp)
-    apply (rule ko_at_obj_at')
-    apply (auto simp: inQ_def)
+  "tcbSchedAppend tcb_ptr \<lbrace>no_orphans\<rbrace>"
+  unfolding tcbSchedAppend_def tcbQueueAppend_def
+  apply (wpsimp wp: tcbQueued_update_True_no_orphans threadSet_almost_no_orphans threadGet_wp)
+  apply (fastforce simp: no_orphans_strg_almost)
   done
 
 lemma tcbSchedEnqueue_almost_no_orphans:
-  "\<lbrace> \<lambda>s. almost_no_orphans tcb_ptr s \<and> valid_queues' s \<rbrace>
+  "\<lbrace>almost_no_orphans tcb_ptr\<rbrace>
    tcbSchedEnqueue tcb_ptr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
-  unfolding tcbSchedEnqueue_def
-  apply simp
-  apply (wp setQueue_almost_no_orphans_enq[where tcb_ptr=tcb_ptr] threadSet_no_orphans
-            | clarsimp)+
-   apply (wp getObject_tcb_wp | clarsimp simp: threadGet_def)+
-  apply normalise_obj_at'
-  apply (rule_tac x=ko in exI)
-  apply (clarsimp simp: subset_insertI)
-  apply (unfold no_orphans_def almost_no_orphans_def)
-  apply clarsimp
-  apply (drule(2) queued_in_queue)
-  apply (fastforce simp: all_queued_tcb_ptrs_def)
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
+  unfolding tcbSchedEnqueue_def tcbQueuePrepend_def
+  apply (wpsimp wp: tcbQueued_update_True_no_orphans threadSet_almost_no_orphans threadGet_wp)
+  apply (fastforce simp: no_orphans_def almost_no_orphans_def all_queued_tcb_ptrs_def obj_at'_def)
   done
 
 lemma tcbSchedEnqueue_almost_no_orphans_lift:
-  "\<lbrace> \<lambda>s. almost_no_orphans ptr s \<rbrace>
-   tcbSchedEnqueue tcb_ptr
-   \<lbrace> \<lambda>rv s. almost_no_orphans ptr s \<rbrace>"
-  unfolding tcbSchedEnqueue_def
-  apply (wp setQueue_almost_no_orphans_enq_lift threadSet_almost_no_orphans | clarsimp simp: unless_def)+
-   apply (wp getObject_tcb_wp | clarsimp simp: threadGet_def)+
-  apply (drule obj_at_ko_at')
-  apply auto
-  done
+  "tcbSchedEnqueue tcb_ptr \<lbrace>almost_no_orphans ptr\<rbrace>"
+  unfolding tcbSchedEnqueue_def tcbQueuePrepend_def
+  by (wpsimp wp: tcbQueued_update_True_almost_no_orphans threadSet_almost_no_orphans)
 
 lemma ssa_no_orphans:
   "\<lbrace> \<lambda>s. no_orphans s \<and>
@@ -419,124 +431,70 @@ lemma ssa_almost_no_orphans_lift [wp]:
   apply auto
   done
 
-lemma tcbSchedEnqueue_inQueue [wp]:
-  "\<lbrace> \<lambda>s. valid_queues' s \<rbrace>
-   tcbSchedEnqueue tcb_ptr
-   \<lbrace> \<lambda>rv s. tcb_ptr \<in> all_queued_tcb_ptrs s \<rbrace>"
-  unfolding tcbSchedEnqueue_def all_queued_tcb_ptrs_def
-  apply (wp | clarsimp simp: unless_def)+
-   apply (rule_tac Q="\<lambda>rv. \<top>" in hoare_post_imp)
-    apply fastforce
-   apply (wp getObject_tcb_wp | clarsimp simp: threadGet_def)+
-  apply (fastforce simp: obj_at'_def valid_queues'_def inQ_def)
-  done
-
-lemma tcbSchedAppend_inQueue [wp]:
-  "\<lbrace> \<lambda>s. valid_queues' s \<rbrace>
-   tcbSchedAppend tcb_ptr
-   \<lbrace> \<lambda>rv s. tcb_ptr \<in> all_queued_tcb_ptrs s \<rbrace>"
-  unfolding tcbSchedAppend_def all_queued_tcb_ptrs_def
-  apply (wp | clarsimp simp: unless_def)+
-   apply (rule_tac Q="\<lambda>rv. \<top>" in hoare_post_imp)
-    apply fastforce
-   apply (wp getObject_tcb_wp | clarsimp simp: threadGet_def)+
-  apply (fastforce simp: obj_at'_def valid_queues'_def inQ_def)
-  done
-
 lemma rescheduleRequired_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<rbrace>
-   rescheduleRequired
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+  "rescheduleRequired \<lbrace>no_orphans\<rbrace>"
   unfolding rescheduleRequired_def
-  apply (wp tcbSchedEnqueue_no_orphans hoare_vcg_all_lift ssa_no_orphans | wpc | clarsimp)+
-   apply (wps tcbSchedEnqueue_nosch, wp hoare_weak_lift_imp)
-   apply (rename_tac word t p)
-   apply (rule_tac P="word = t" in hoare_gen_asm)
-   apply (wp hoare_disjI1 | clarsimp)+
-  done
+  by (wpsimp wp: ssa_no_orphans hoare_vcg_all_lift hoare_vcg_imp_lift' hoare_vcg_disj_lift | wpc)+
 
 lemma rescheduleRequired_almost_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. almost_no_orphans tcb_ptr s \<and> valid_queues' s \<rbrace>
-   rescheduleRequired
-   \<lbrace> \<lambda>rv s. almost_no_orphans tcb_ptr s \<rbrace>"
+  "rescheduleRequired \<lbrace>almost_no_orphans tcb_ptr\<rbrace>"
   unfolding rescheduleRequired_def
-  apply (wp tcbSchedEnqueue_almost_no_orphans_lift hoare_vcg_all_lift | wpc | clarsimp)+
-   apply (wps tcbSchedEnqueue_nosch, wp hoare_weak_lift_imp)
-   apply (rename_tac word t p)
-   apply (rule_tac P="word = t" in hoare_gen_asm)
-   apply (wp hoare_disjI1 | clarsimp)+
-  done
+  by (wpsimp wp: ssa_almost_no_orphans_lift hoare_vcg_all_lift tcbSchedEnqueue_almost_no_orphans_lift
+                 hoare_vcg_imp_lift' hoare_vcg_disj_lift)
 
 lemma setThreadState_current_no_orphans:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> ksCurThread s = tcb_ptr \<and> valid_queues' s \<rbrace>
+  "\<lbrace>\<lambda>s. no_orphans s \<and> ksCurThread s = tcb_ptr\<rbrace>
    setThreadState state tcb_ptr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding setThreadState_def
-  apply (wp | clarsimp)+
-  apply (rule_tac Q="\<lambda>rv s. valid_queues' s \<and> no_orphans s" in hoare_post_imp)
-   apply clarsimp
-  apply (wp threadSet_valid_queues')
-   apply (unfold no_orphans_disj all_queued_tcb_ptrs_def)
-   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_pred_tcb_at_state)
-   apply (auto simp: inQ_def)
+  apply wpsimp
+  unfolding no_orphans_disj
+   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_pred_tcb_at_state
+             threadSet_all_queued_tcb_ptrs
+          | fastforce)+
   done
 
 lemma setThreadState_isRestart_no_orphans:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> st_tcb_at' isRestart tcb_ptr s \<and> valid_queues' s\<rbrace>
+  "\<lbrace>no_orphans and st_tcb_at' isRestart tcb_ptr\<rbrace>
    setThreadState state tcb_ptr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_ . no_orphans\<rbrace>"
   unfolding setThreadState_def
-  apply (wp | clarsimp)+
-  apply (rule_tac Q="\<lambda>rv s. valid_queues' s \<and> no_orphans s" in hoare_post_imp)
-   apply clarsimp
-  apply (wp threadSet_valid_queues')
-   apply (unfold no_orphans_disj all_queued_tcb_ptrs_def is_active_thread_state_def)
-   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_pred_tcb_at_state)
-   apply (auto simp: st_tcb_at_double_neg' st_tcb_at_neg' inQ_def)
+  apply wpsimp
+   unfolding no_orphans_disj
+   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_pred_tcb_at_state
+             threadSet_all_queued_tcb_ptrs
+          | fastforce)+
+  apply (auto simp: is_active_thread_state_def st_tcb_at_double_neg' st_tcb_at_neg')
   done
 
 lemma setThreadState_almost_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s\<rbrace>
-   setThreadState state tcb_ptr
-   \<lbrace> \<lambda>rv s. almost_no_orphans tcb_ptr s \<rbrace>"
+  "\<lbrace>no_orphans\<rbrace> setThreadState state tcb_ptr \<lbrace>\<lambda>_. almost_no_orphans tcb_ptr\<rbrace>"
   unfolding setThreadState_def
-  apply (wp | clarsimp)+
-  apply (rule_tac Q="\<lambda>rv s. valid_queues' s \<and> almost_no_orphans tcb_ptr s" in hoare_post_imp)
-   apply clarsimp
-  apply (wp threadSet_valid_queues')
-   apply (unfold no_orphans_disj almost_no_orphans_disj all_queued_tcb_ptrs_def)
-   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_pred_tcb_at_state)
-   apply (auto simp: inQ_def)
+  apply wpsimp
+   apply (unfold no_orphans_disj almost_no_orphans_disj)
+   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_pred_tcb_at_state
+             threadSet_all_queued_tcb_ptrs
+          | fastforce)+
   done
 
 lemma setThreadState_not_active_no_orphans:
-  "\<not> is_active_thread_state state \<Longrightarrow>
-   \<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<rbrace>
-   setThreadState state tcb_ptr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+  "\<not> is_active_thread_state state \<Longrightarrow> setThreadState state tcb_ptr \<lbrace>no_orphans\<rbrace>"
   unfolding setThreadState_def
-  apply (wp | clarsimp)+
-  apply (rule_tac Q="\<lambda>rv s. valid_queues' s \<and> no_orphans s" in hoare_post_imp)
-   apply clarsimp
-  apply (wp threadSet_valid_queues')
-   apply (unfold no_orphans_disj all_queued_tcb_ptrs_def is_active_thread_state_def)
-   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_pred_tcb_at_state)
-   apply (auto simp: isRunning_def isRestart_def inQ_def)
+  apply wpsimp
+   apply (unfold no_orphans_disj)
+   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_pred_tcb_at_state
+             threadSet_all_queued_tcb_ptrs
+          | fastforce)+
   done
 
 lemma setThreadState_not_active_almost_no_orphans:
-  "\<not> is_active_thread_state state \<Longrightarrow>
-   \<lbrace> \<lambda>s. almost_no_orphans thread s \<and> valid_queues' s \<rbrace>
-   setThreadState state tcb_ptr
-   \<lbrace> \<lambda>rv s. almost_no_orphans thread s \<rbrace>"
+  "\<not> is_active_thread_state state \<Longrightarrow> setThreadState state tcb_ptr \<lbrace>almost_no_orphans thread\<rbrace>"
   unfolding setThreadState_def
-  apply (wp | clarsimp)+
-  apply (rule_tac Q="\<lambda>rv s. valid_queues' s \<and> almost_no_orphans thread s" in hoare_post_imp)
-   apply clarsimp
-  apply (wp threadSet_valid_queues')
-   apply (unfold almost_no_orphans_disj all_queued_tcb_ptrs_def is_active_thread_state_def)
-   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_pred_tcb_at_state)
-   apply (auto simp: isRunning_def isRestart_def inQ_def)
+  apply wpsimp
+   apply (unfold almost_no_orphans_disj)
+   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift threadSet_pred_tcb_at_state
+             threadSet_all_queued_tcb_ptrs
+          | fastforce)+
   done
 
 lemma activateThread_no_orphans [wp]:
@@ -548,46 +506,63 @@ lemma activateThread_no_orphans [wp]:
   apply (auto simp: ct_in_state'_def pred_tcb_at'_def obj_at'_def isRestart_def)
   done
 
-lemma setQueue_no_orphans_deq:
-  "\<lbrace> \<lambda>s. \<exists> tcb_ptr. no_orphans s \<and> \<not> is_active_tcb_ptr tcb_ptr s \<and>
-        queue = [x\<leftarrow>((ksReadyQueues s) (d, priority)). x \<noteq> tcb_ptr] \<rbrace>
-   setQueue d priority queue
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
-  unfolding setQueue_def
-  apply (wp | clarsimp)+
-  apply (fastforce simp: no_orphans_def all_queued_tcb_ptrs_def
-                        all_active_tcb_ptrs_def is_active_tcb_ptr_def)
+crunches removeFromBitmap, tcbQueueRemove, setQueue
+  for almost_no_orphans[wp]: "almost_no_orphans thread"
+  and no_orphans[wp]: no_orphans
+  and all_queued_tcb_ptrs[wp]: "\<lambda>s. tcb_ptr \<in> all_queued_tcb_ptrs s"
+  (wp: crunch_wps)
+
+lemma tcbQueued_update_False_all_queued_tcb_ptrs:
+  "\<lbrace>\<lambda>s. tcb_ptr \<noteq> tcb_ptr' \<and> tcb_ptr' \<in> all_queued_tcb_ptrs s\<rbrace>
+   threadSet (tcbQueued_update (\<lambda>_. False)) tcb_ptr
+   \<lbrace>\<lambda>_ s. tcb_ptr' \<in> all_queued_tcb_ptrs s\<rbrace>"
+  apply (wpsimp wp: threadSet_wp)
+  apply (clarsimp simp: all_queued_tcb_ptrs_def obj_at'_def projectKOs ps_clear_upd)
   done
 
-lemma setQueue_almost_no_orphans_deq [wp]:
-  "\<lbrace> \<lambda>s. almost_no_orphans tcb_ptr s \<and>
-        queue = [x\<leftarrow>((ksReadyQueues s) (d, priority)). x \<noteq> tcb_ptr] \<rbrace>
-   setQueue d priority queue
-   \<lbrace> \<lambda>rv s. almost_no_orphans tcb_ptr s \<rbrace>"
-  unfolding setQueue_def
-  apply (wp | clarsimp)+
-  apply (fastforce simp: almost_no_orphans_def all_queued_tcb_ptrs_def
-                        all_active_tcb_ptrs_def is_active_tcb_ptr_def)
+lemma tcbSchedDequeue_all_queued_tcb_ptrs_other:
+  "\<lbrace>\<lambda>s. tcb_ptr \<noteq> tcb_ptr' \<and> tcb_ptr' \<in> all_queued_tcb_ptrs s\<rbrace>
+   tcbSchedDequeue tcb_ptr
+   \<lbrace>\<lambda>_ s. tcb_ptr' \<in> all_queued_tcb_ptrs s\<rbrace>"
+  unfolding tcbSchedDequeue_def
+  by (wpsimp wp: tcbQueued_update_False_all_queued_tcb_ptrs threadGet_wp)
+
+lemma tcbQueued_update_False_almost_no_orphans:
+  "\<lbrace>no_orphans\<rbrace>
+   threadSet (tcbQueued_update (\<lambda>_. False)) tptr
+   \<lbrace>\<lambda>_. almost_no_orphans tptr\<rbrace>"
+  apply (wpsimp wp: threadSet_wp)
+  apply (clarsimp simp: no_orphans_def almost_no_orphans_def)
+  apply (rename_tac tcb_ptr)
+  apply (case_tac "tcb_ptr = tptr")
+   apply fastforce
+  apply (fastforce simp: all_queued_tcb_ptrs_def obj_at'_def projectKOs all_active_tcb_ptrs_def
+                         is_active_tcb_ptr_def st_tcb_at'_def ps_clear_upd)
   done
 
 lemma tcbSchedDequeue_almost_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<rbrace>
-   tcbSchedDequeue thread
-   \<lbrace> \<lambda>rv s. almost_no_orphans thread s \<rbrace>"
+  "\<lbrace>no_orphans\<rbrace> tcbSchedDequeue thread \<lbrace>\<lambda>_. almost_no_orphans thread\<rbrace>"
   unfolding tcbSchedDequeue_def
-  apply (wp threadSet_almost_no_orphans | simp cong: if_cong)+
-  apply (simp add:no_orphans_strg_almost cong: if_cong)
+  apply (wpsimp wp: tcbQueued_update_False_almost_no_orphans threadGet_wp)
+  apply (simp add: no_orphans_strg_almost)
   done
 
-lemma tcbSchedDequeue_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> \<not> is_active_tcb_ptr tcb_ptr s \<rbrace>
-   tcbSchedDequeue tcb_ptr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
-  unfolding tcbSchedDequeue_def
-  apply (wp setQueue_no_orphans_deq threadSet_no_orphans | clarsimp)+
-   apply (wp getObject_tcb_wp | clarsimp simp: threadGet_def)+
-  apply (drule obj_at_ko_at')
-  apply auto
+lemma tcbSchedDequeue_no_orphans[wp]:
+  "\<lbrace>\<lambda>s. no_orphans s \<and> \<not> is_active_tcb_ptr tcbPtr s \<and> tcb_at' tcbPtr s\<rbrace>
+   tcbSchedDequeue tcbPtr
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
+  supply disj_not1[simp del]
+  unfolding no_orphans_disj almost_no_orphans_disj
+  apply (rule hoare_allI)
+  apply (rename_tac tcb_ptr)
+  apply (case_tac "tcb_ptr = tcbPtr")
+   apply (rule_tac Q="\<lambda>_ s. st_tcb_at' (\<lambda>state. \<not> is_active_thread_state state) tcbPtr s"
+                in hoare_post_imp)
+    apply fastforce
+   apply wpsimp
+   apply (clarsimp simp: st_tcb_at'_def obj_at'_def projectKOs is_active_tcb_ptr_def disj_not1)
+  apply (wpsimp wp: tcbQueued_update_False_all_queued_tcb_ptrs hoare_vcg_disj_lift
+              simp: tcbSchedDequeue_def)
   done
 
 crunches setVMRoot
@@ -595,17 +570,15 @@ crunches setVMRoot
   (wp: crunch_wps)
 
 lemma switchToIdleThread_no_orphans' [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and>
-          (is_active_tcb_ptr (ksCurThread s) s
-             \<longrightarrow> ksCurThread s \<in> all_queued_tcb_ptrs s) \<rbrace>
+  "\<lbrace>\<lambda>s. no_orphans s
+        \<and> (is_active_tcb_ptr (ksCurThread s) s \<longrightarrow> ksCurThread s \<in> all_queued_tcb_ptrs s)\<rbrace>
    switchToIdleThread
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
-  unfolding switchToIdleThread_def setCurThread_def RISCV64_H.switchToIdleThread_def
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
+  supply disj_not1[simp del]
+  apply (clarsimp simp: switchToIdleThread_def setCurThread_def RISCV64_H.switchToIdleThread_def)
   apply (simp add: no_orphans_disj all_queued_tcb_ptrs_def)
-  apply (wp hoare_vcg_all_lift hoare_vcg_imp_lift hoare_vcg_disj_lift
-       | clarsimp)+
-  apply (auto simp: no_orphans_disj all_queued_tcb_ptrs_def is_active_tcb_ptr_def
-                    st_tcb_at_neg' tcb_at_typ_at')
+  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift hoare_drop_imps)
+  apply (force simp: is_active_tcb_ptr_def st_tcb_at_neg' typ_at_tcb')
   done
 
 crunch no_orphans [wp]: "Arch.switchToThread" "no_orphans"
@@ -613,13 +586,9 @@ crunch no_orphans [wp]: "Arch.switchToThread" "no_orphans"
 
 crunch ksCurThread [wp]: "Arch.switchToThread" "\<lambda> s. P (ksCurThread s)"
 
-lemma ArchThreadDecls_H_switchToThread_all_queued_tcb_ptrs [wp]:
-  "\<lbrace> \<lambda>s. P (all_queued_tcb_ptrs s) \<rbrace>
-   Arch.switchToThread tcb_ptr
-   \<lbrace> \<lambda>rv s. P (all_queued_tcb_ptrs s) \<rbrace>"
-  unfolding RISCV64_H.switchToThread_def all_queued_tcb_ptrs_def
-  apply (wp | clarsimp)+
-  done
+crunches Arch.switchToThread
+  for all_queued_tcb_ptrs[wp]: "\<lambda>s. P (t \<in> all_queued_tcb_ptrs s)"
+  (wp: tcbQueued_all_queued_tcb_ptrs_lift)
 
 crunch ksSchedulerAction [wp]: "Arch.switchToThread" "\<lambda>s. P (ksSchedulerAction s)"
 
@@ -635,22 +604,6 @@ lemma setCurThread_no_orphans [wp]:
   apply auto
   done
 
-lemma tcbSchedDequeue_all_queued_tcb_ptrs:
-  "\<lbrace>\<lambda>s. x \<in> all_queued_tcb_ptrs s \<and> x \<noteq> t \<rbrace>
-   tcbSchedDequeue t \<lbrace>\<lambda>_ s. x \<in> all_queued_tcb_ptrs s\<rbrace>"
-  apply (rule_tac Q="(\<lambda>s. x \<in> all_queued_tcb_ptrs s) and K (x \<noteq> t)"
-           in hoare_pre_imp, clarsimp)
-  apply (rule hoare_gen_asm)
-  apply (clarsimp simp: tcbSchedDequeue_def all_queued_tcb_ptrs_def)
-  apply (rule hoare_pre)
-   apply (wp, clarsimp)
-       apply (wp hoare_vcg_ex_lift)+
-     apply (rename_tac d p)
-     apply (rule_tac Q="\<lambda>_ s. x \<in> set (ksReadyQueues s (d, p))"
-                     in hoare_post_imp, clarsimp)
-     apply (wp hoare_vcg_all_lift | simp)+
-  done
-
 lemma tcbSchedDequeue_all_active_tcb_ptrs[wp]:
   "\<lbrace>\<lambda>s. P (t' \<in> all_active_tcb_ptrs s)\<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>_ s. P (t' \<in> all_active_tcb_ptrs s)\<rbrace>"
   by (clarsimp simp: all_active_tcb_ptrs_def is_active_tcb_ptr_def) wp
@@ -673,8 +626,11 @@ lemma setCurThread_almost_no_orphans:
 lemmas ArchThreadDecls_H_switchToThread_all_active_tcb_ptrs[wp] =
   st_tcb_at'_all_active_tcb_ptrs_lift [OF Arch_switchToThread_pred_tcb']
 
-lemmas ArchThreadDecls_H_switchToThread_all_queued_tcb_ptrs_lift[wp] =
-  ksQ_all_queued_tcb_ptrs_lift [OF ArchThreadDecls_H_RISCV64_H_switchToThread_ksQ]
+lemma arch_switch_thread_tcbQueued[wp]:
+  "Arch.switchToThread t \<lbrace>\<lambda>s. Q (obj_at' (\<lambda>tcb. P (tcbQueued tcb)) tcb_ptr s)\<rbrace>"
+  apply (simp add: RISCV64_H.switchToThread_def)
+  apply (wp)
+  done
 
 lemma ThreadDecls_H_switchToThread_no_orphans:
   "\<lbrace> \<lambda>s. no_orphans s \<and>
@@ -684,16 +640,9 @@ lemma ThreadDecls_H_switchToThread_no_orphans:
    ThreadDecls_H.switchToThread tcb_ptr
    \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
   unfolding Thread_H.switchToThread_def
-  apply (wp setCurThread_almost_no_orphans
-            tcbSchedDequeue_almost_no_orphans)
-    apply (wps tcbSchedDequeue_ct')
-    apply (wp tcbSchedDequeue_all_queued_tcb_ptrs hoare_convert_imp)+
-    apply (wps)
-    apply (wp)+
-   apply (wps)
-   apply (wp)
-  apply (clarsimp)
-  done
+  by (wpsimp wp: setCurThread_almost_no_orphans hoare_vcg_imp_lift'
+                 tcbSchedDequeue_all_queued_tcb_ptrs_other
+      | wps)+
 
 lemma findM_failure':
   "\<lbrakk> \<And>x S. \<lbrace> \<lambda>s. P S s \<rbrace> f x \<lbrace> \<lambda>rv s. \<not> rv \<longrightarrow> P (insert x S) s \<rbrace> \<rbrakk> \<Longrightarrow>
@@ -711,22 +660,6 @@ lemma findM_failure':
 
 lemmas findM_failure = findM_failure'[where S="{}", simplified]
 
-lemma tcbSchedEnqueue_inQueue_eq:
-  "\<lbrace> valid_queues' and K (tcb_ptr = tcb_ptr') \<rbrace>
-   tcbSchedEnqueue tcb_ptr
-   \<lbrace> \<lambda>rv s. tcb_ptr' \<in> all_queued_tcb_ptrs s \<rbrace>"
-  apply (rule hoare_gen_asm, simp)
-  apply wp
-  done
-
-lemma tcbSchedAppend_inQueue_eq:
-  "\<lbrace> valid_queues' and K (tcb_ptr = tcb_ptr') \<rbrace>
-   tcbSchedAppend tcb_ptr
-   \<lbrace> \<lambda>rv s. tcb_ptr' \<in> all_queued_tcb_ptrs s \<rbrace>"
-  apply (rule hoare_gen_asm, simp)
-  apply wp
-  done
-
 lemma findM_on_success:
   "\<lbrakk> \<And>x. \<lbrace> P x \<rbrace> f x \<lbrace> \<lambda>rv s. rv \<rbrace>; \<And>x y. \<lbrace> P x \<rbrace> f y \<lbrace> \<lambda>rv. P x \<rbrace> \<rbrakk> \<Longrightarrow>
    \<lbrace> \<lambda>s. \<exists>x \<in> set xs. P x s \<rbrace> findM f xs \<lbrace> \<lambda>rv s. \<exists> y. rv = Some y \<rbrace>"
@@ -738,66 +671,32 @@ lemma findM_on_success:
 
 crunch st_tcb' [wp]: switchToThread "\<lambda>s. P' (st_tcb_at' P t s)"
 
-lemma setQueue_deq_not_empty:
-  "\<lbrace> \<lambda>s. (\<exists>tcb. tcb \<in> set (ksReadyQueues s p) \<and> st_tcb_at' P tcb s) \<and>
-         (\<exists>tcb_ptr. \<not> st_tcb_at' P tcb_ptr s \<and>
-                    queue = [x\<leftarrow>((ksReadyQueues s) (d, priority)). x \<noteq> tcb_ptr]) \<rbrace>
-   setQueue d priority queue
-   \<lbrace> \<lambda>rv s. \<exists>tcb. tcb \<in> set (ksReadyQueues s p) \<and> st_tcb_at' P tcb s \<rbrace>"
-  unfolding setQueue_def
-  apply wp
-  apply auto
-  done
-
-lemma tcbSchedDequeue_not_empty:
-  "\<lbrace> \<lambda>s. (\<exists>tcb. tcb \<in> set (ksReadyQueues s p) \<and> st_tcb_at' P tcb s) \<and> \<not> st_tcb_at' P thread s \<rbrace>
-   tcbSchedDequeue thread
-   \<lbrace> \<lambda>rv s. \<exists>tcb. tcb \<in> set (ksReadyQueues s p) \<and> st_tcb_at' P tcb s \<rbrace>"
-  unfolding tcbSchedDequeue_def
-  apply wp
-         apply (wp hoare_vcg_ex_lift threadSet_pred_tcb_no_state)
-         apply clarsimp
-        apply (wp setQueue_deq_not_empty)
-       apply clarsimp
-       apply (rule hoare_pre_post, assumption)
-       apply (clarsimp simp: bitmap_fun_defs)
-       apply wp
-       apply clarsimp
-      apply clarsimp
-      apply (wp setQueue_deq_not_empty)+
-   apply (rule_tac Q="\<lambda>rv s. \<not> st_tcb_at' P thread s" in hoare_post_imp)
-    apply fastforce
-   apply (wp weak_if_wp | clarsimp)+
-  done
-
 lemmas switchToThread_all_active_tcb_ptrs[wp] =
   st_tcb_at'_all_active_tcb_ptrs_lift [OF switchToThread_st_tcb']
 
 (* ksSchedulerAction s = ChooseNewThread *)
 lemma chooseThread_no_orphans [wp]:
-  notes hoare_TrueI[simp]
-  shows
-  "\<lbrace>\<lambda>s. no_orphans s \<and> all_invs_but_ct_idle_or_in_cur_domain' s \<and>
-          (is_active_tcb_ptr (ksCurThread s) s
-             \<longrightarrow> ksCurThread s \<in> all_queued_tcb_ptrs s)\<rbrace>
+  "\<lbrace>\<lambda>s. no_orphans s \<and> all_invs_but_ct_idle_or_in_cur_domain' s
+        \<and> (is_active_tcb_ptr (ksCurThread s) s \<longrightarrow> ksCurThread s \<in> all_queued_tcb_ptrs s)\<rbrace>
    chooseThread
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   (is "\<lbrace>?PRE\<rbrace> _ \<lbrace>_\<rbrace>")
   unfolding chooseThread_def Let_def
   supply if_split[split del]
   apply (simp only: return_bind, simp)
-  apply (rule hoare_seq_ext[where B="\<lambda>rv s. ?PRE s \<and> rv = ksCurDomain s"])
-   apply (rule_tac B="\<lambda>rv s. ?PRE s \<and> curdom = ksCurDomain s \<and>
-    rv = ksReadyQueuesL1Bitmap s curdom" in hoare_seq_ext)
+  apply (intro hoare_seq_ext[OF _ stateAssert_sp])
+  apply (rule hoare_seq_ext[where B="\<lambda>rv s. ?PRE s \<and> ksReadyQueues_asrt s \<and> ready_qs_runnable s
+                                            \<and> rv = ksCurDomain s"])
+   apply (rule_tac B="\<lambda>rv s. ?PRE s \<and> ksReadyQueues_asrt s \<and> ready_qs_runnable s
+                             \<and> curdom = ksCurDomain s \<and> rv = ksReadyQueuesL1Bitmap s curdom"
+                in hoare_seq_ext)
     apply (rename_tac l1)
     apply (case_tac "l1 = 0")
      (* switch to idle thread *)
      apply (simp, wp, simp)
     (* we have a thread to switch to *)
-    apply (clarsimp simp: bitmap_fun_defs)
     apply (wp assert_inv ThreadDecls_H_switchToThread_no_orphans)
-    apply (clarsimp simp: all_invs_but_ct_idle_or_in_cur_domain'_def valid_state'_def
-                          valid_queues_def st_tcb_at'_def)
+    apply (clarsimp simp: all_invs_but_ct_idle_or_in_cur_domain'_def st_tcb_at'_def)
     apply (fastforce dest!: lookupBitmapPriority_obj_at' elim: obj_at'_weaken
                      simp: all_active_tcb_ptrs_def)
    apply (wpsimp simp: bitmap_fun_defs)
@@ -805,42 +704,6 @@ lemma chooseThread_no_orphans [wp]:
     apply (wpsimp simp: curDomain_def simp: invs_no_cicd_ksCurDomain_maxDomain')+
   done
 
-lemma valid_queues'_ko_atD:
-  "valid_queues' s \<Longrightarrow> ko_at' tcb t s \<Longrightarrow> tcbQueued tcb
-    \<Longrightarrow> t \<in> set (ksReadyQueues s (tcbDomain tcb, tcbPriority tcb))"
-  apply (simp add: valid_queues'_def)
-  apply (elim allE, erule mp)
-  apply normalise_obj_at'
-  apply (simp add: inQ_def)
-  done
-
-lemma tcbSchedAppend_in_ksQ:
-  "\<lbrace>valid_queues' and tcb_at' t\<rbrace> tcbSchedAppend t
-   \<lbrace>\<lambda>r s. \<exists>domain priority. t \<in> set (ksReadyQueues s (domain, priority))\<rbrace>"
-  apply (rule_tac Q="\<lambda>s. \<exists>d p. valid_queues' s \<and>
-                             obj_at' (\<lambda>tcb. tcbPriority tcb = p) t s \<and>
-                             obj_at' (\<lambda>tcb. tcbDomain tcb = d) t s"
-           in hoare_pre_imp)
-   apply (clarsimp simp: tcb_at'_has_tcbPriority tcb_at'_has_tcbDomain)
-  apply (rule hoare_vcg_ex_lift)+
-  apply (simp add: tcbSchedAppend_def unless_def)
-  apply wpsimp
-     apply (rule_tac Q="\<lambda>rv s. tdom = d \<and> rv = p \<and> obj_at' (\<lambda>tcb. tcbPriority tcb = p) t s
-                            \<and> obj_at' (\<lambda>tcb. tcbDomain tcb = d) t s"
-             in hoare_post_imp, clarsimp)
-     apply (wp, (wp threadGet_const)+)
-   apply (rule_tac Q="\<lambda>rv s.
-             obj_at' (\<lambda>tcb. tcbPriority tcb = p) t s \<and>
-             obj_at' (\<lambda>tcb. tcbDomain tcb = d) t s \<and>
-             obj_at' (\<lambda>tcb. tcbQueued tcb = rv) t s \<and>
-             (rv \<longrightarrow> t \<in> set (ksReadyQueues s (d, p)))" in hoare_post_imp)
-   apply (clarsimp simp: o_def elim!: obj_at'_weakenE)
-   apply (wp threadGet_obj_at' hoare_vcg_imp_lift threadGet_const)
-  apply clarsimp
-  apply normalise_obj_at'
-  apply (drule(1) valid_queues'_ko_atD, simp+)
-  done
-
 lemma hoare_neg_imps:
   "\<lbrace>P\<rbrace> f \<lbrace>\<lambda> rv s. \<not> R rv s\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>r s. R r s \<longrightarrow> Q r s\<rbrace>"
   by (auto simp: valid_def)
@@ -864,7 +727,7 @@ lemma ThreadDecls_H_switchToThread_ct [wp]:
 crunch no_orphans [wp]: nextDomain no_orphans
 (wp: no_orphans_lift simp: Let_def)
 
-crunch ksQ [wp]: nextDomain "\<lambda>s. P (ksReadyQueues s p)"
+crunch tcbQueued[wp]: nextDomain "\<lambda>s. Q (obj_at' (\<lambda>tcb. P (tcbQueued tcb)) tcb_ptr s)"
 (simp: Let_def)
 
 crunch st_tcb_at' [wp]: nextDomain "\<lambda>s. P (st_tcb_at' P' p s)"
@@ -876,41 +739,6 @@ crunch ct' [wp]: nextDomain "\<lambda>s. P (ksCurThread s)"
 crunch sch_act_not [wp]: nextDomain "sch_act_not t"
 (simp: Let_def)
 
-lemma tcbSchedEnqueue_in_ksQ:
-  "\<lbrace>valid_queues' and tcb_at' t\<rbrace> tcbSchedEnqueue t
-   \<lbrace>\<lambda>r s. \<exists>domain priority. t \<in> set (ksReadyQueues s (domain, priority))\<rbrace>"
-  apply (rule_tac Q="\<lambda>s. \<exists>d p. valid_queues' s \<and>
-                             obj_at' (\<lambda>tcb. tcbPriority tcb = p) t s \<and>
-                             obj_at' (\<lambda>tcb. tcbDomain tcb = d) t s"
-           in hoare_pre_imp)
-   apply (clarsimp simp: tcb_at'_has_tcbPriority tcb_at'_has_tcbDomain)
-  apply (rule hoare_vcg_ex_lift)+
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply (wpsimp simp: if_apply_def2)
-     apply (rule_tac Q="\<lambda>rv s. tdom = d \<and> rv = p \<and> obj_at' (\<lambda>tcb. tcbPriority tcb = p) t s
-                             \<and> obj_at' (\<lambda>tcb. tcbDomain tcb = d) t s"
-              in hoare_post_imp, clarsimp)
-     apply (wp, (wp threadGet_const)+)
-   apply (rule_tac Q="\<lambda>rv s.
-              obj_at' (\<lambda>tcb. tcbPriority tcb = p) t s \<and>
-              obj_at' (\<lambda>tcb. tcbDomain tcb = d) t s \<and>
-              obj_at' (\<lambda>tcb. tcbQueued tcb = rv) t s \<and>
-              (rv \<longrightarrow> t \<in> set (ksReadyQueues s (d, p)))" in hoare_post_imp)
-    apply (clarsimp simp: o_def elim!: obj_at'_weakenE)
-   apply (wp threadGet_obj_at' hoare_vcg_imp_lift threadGet_const)
-  apply clarsimp
-  apply normalise_obj_at'
-  apply (frule(1) valid_queues'_ko_atD, simp+)
-  done
-
-lemma tcbSchedEnqueue_in_ksQ':
-  "\<lbrace>valid_queues' and tcb_at' t and K (t = t')\<rbrace>
-     tcbSchedEnqueue t'
-   \<lbrace>\<lambda>r s. \<exists>domain priority. t \<in> set (ksReadyQueues s (domain, priority))\<rbrace>"
-  apply (rule hoare_gen_asm)
-  apply (wp tcbSchedEnqueue_in_ksQ | clarsimp)+
-  done
-
 lemma all_invs_but_ct_idle_or_in_cur_domain'_strg:
   "invs' s \<longrightarrow> all_invs_but_ct_idle_or_in_cur_domain' s"
   by (clarsimp simp: invs'_to_invs_no_cicd'_def)
@@ -919,67 +747,6 @@ lemma setSchedulerAction_cnt_sch_act_not[wp]:
   "\<lbrace> \<top> \<rbrace> setSchedulerAction ChooseNewThread \<lbrace>\<lambda>rv s. sch_act_not x s\<rbrace>"
   by (rule hoare_pre, rule hoare_strengthen_post[OF setSchedulerAction_direct]) auto
 
-lemma tcbSchedEnqueue_in_ksQ_aqtp[wp]:
-  "\<lbrace>valid_queues' and tcb_at' t\<rbrace> tcbSchedEnqueue t
-   \<lbrace>\<lambda>r s. t \<in> all_queued_tcb_ptrs s\<rbrace>"
-  apply (clarsimp simp: all_queued_tcb_ptrs_def)
-  apply (rule tcbSchedEnqueue_in_ksQ)
-  done
-
-lemma tcbSchedEnqueue_in_ksQ_already_queued:
-  "\<lbrace>\<lambda>s. valid_queues' s \<and> tcb_at' t s \<and>
-    (\<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority))) \<rbrace>
-   tcbSchedEnqueue t
-   \<lbrace>\<lambda>r s. \<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority))\<rbrace>"
-  apply (case_tac "t'=t", wpsimp wp: tcbSchedEnqueue_in_ksQ)
-  apply (wpsimp simp:  tcbSchedEnqueue_def unless_def)
-     apply (rule_tac Q="\<lambda>_ s. \<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority))"
-              in hoare_post_imp)
-      apply metis
-     apply wpsimp+
-  done
-
-lemma tcbSchedAppend_in_ksQ_already_queued:
-  "\<lbrace>\<lambda>s. valid_queues' s \<and> tcb_at' t s \<and>
-    (\<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority))) \<rbrace>
-   tcbSchedAppend t
-   \<lbrace>\<lambda>r s. \<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority))\<rbrace>"
-  apply (case_tac "t'=t", wpsimp wp: tcbSchedAppend_in_ksQ)
-  apply (wpsimp simp:  tcbSchedAppend_def unless_def)
-     apply (rule_tac Q="\<lambda>_ s. \<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority))"
-              in hoare_post_imp)
-      apply metis
-     apply wpsimp+
-  done
-
-lemma tcbSchedEnqueue_in_ksQ'':
-  "\<lbrace>\<lambda>s. valid_queues' s \<and> tcb_at' t s \<and>
-    (t' \<noteq> t \<longrightarrow> (\<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority)))) \<rbrace>
-   tcbSchedEnqueue t
-   \<lbrace>\<lambda>r s. \<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority))\<rbrace>"
-  apply (case_tac "t'=t", wpsimp wp: tcbSchedEnqueue_in_ksQ)
-  apply clarsimp
-  apply (wpsimp simp:  tcbSchedEnqueue_def unless_def)
-     apply (rule_tac Q="\<lambda>_ s. \<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority))"
-              in hoare_post_imp)
-      apply metis
-     apply wpsimp+
-  done
-
-lemma tcbSchedAppend_in_ksQ'':
-  "\<lbrace>\<lambda>s. valid_queues' s \<and> tcb_at' t s \<and>
-    (t' \<noteq> t \<longrightarrow> (\<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority)))) \<rbrace>
-   tcbSchedAppend t
-   \<lbrace>\<lambda>r s. \<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority))\<rbrace>"
-  apply (case_tac "t'=t", wpsimp wp: tcbSchedAppend_in_ksQ)
-  apply clarsimp
-  apply (wpsimp simp:  tcbSchedAppend_def unless_def)
-     apply (rule_tac Q="\<lambda>_ s. \<exists>domain priority. t' \<in> set (ksReadyQueues s (domain, priority))"
-              in hoare_post_imp)
-      apply metis
-     apply wpsimp+
-  done
-
 crunches setSchedulerAction
   for pred_tcb_at': "\<lambda>s. P (pred_tcb_at' proj Q t s)"
   and ct': "\<lambda>s. P (ksCurThread s)"
@@ -998,12 +765,6 @@ lemma ct_active_st_tcb_at':
   apply (case_tac st, auto)
   done
 
-lemma tcbSchedEnqueue_in_ksQ_already_queued_aqtp:
-  "\<lbrace>\<lambda>s. valid_queues' s \<and> tcb_at' t s \<and>
-    t' \<in> all_queued_tcb_ptrs s \<rbrace> tcbSchedEnqueue t
-   \<lbrace>\<lambda>r s. t' \<in> all_queued_tcb_ptrs s \<rbrace>"
-  by (clarsimp simp: all_queued_tcb_ptrs_def tcbSchedEnqueue_in_ksQ_already_queued)
-
 (* FIXME move *)
 lemma invs_switchToThread_runnable':
   "\<lbrakk> invs' s ; ksSchedulerAction s = SwitchToThread t \<rbrakk> \<Longrightarrow> st_tcb_at' runnable' t s"
@@ -1036,17 +797,16 @@ lemma chooseThread_nosch:
   done
 
 lemma scheduleChooseNewThread_no_orphans:
-  "\<lbrace> invs' and no_orphans
-     and (\<lambda>s. ksSchedulerAction s = ChooseNewThread
-              \<and> (st_tcb_at' runnable' (ksCurThread s) s
-                 \<longrightarrow> (\<exists>d p. ksCurThread s \<in> set (ksReadyQueues s (d, p))))) \<rbrace>
+  "\<lbrace>invs' and no_orphans
+    and (\<lambda>s. ksSchedulerAction s = ChooseNewThread
+             \<and> (st_tcb_at' runnable' (ksCurThread s) s \<longrightarrow> ksCurThread s \<in> all_queued_tcb_ptrs s))\<rbrace>
    scheduleChooseNewThread
-   \<lbrace>\<lambda>_. no_orphans \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding scheduleChooseNewThread_def
      apply (wp add: ssa_no_orphans hoare_vcg_all_lift)
          apply (wp hoare_disjI1 chooseThread_nosch)+
     apply (wp nextDomain_invs_no_cicd' hoare_vcg_imp_lift
-               hoare_lift_Pf2 [OF ksQ_all_queued_tcb_ptrs_lift[OF nextDomain_ksQ]
+               hoare_lift_Pf2 [OF tcbQueued_all_queued_tcb_ptrs_lift[OF nextDomain_tcbQueued]
                                   nextDomain_ct']
                hoare_lift_Pf2 [OF st_tcb_at'_is_active_tcb_ptr_lift[OF nextDomain_st_tcb_at']
                                   nextDomain_ct']
@@ -1055,24 +815,25 @@ lemma scheduleChooseNewThread_no_orphans:
                        is_active_tcb_ptr_runnable')+
   done
 
+lemma setSchedulerAction_tcbQueued[wp]:
+  "setSchedulerAction sa \<lbrace>\<lambda>s. Q (obj_at' (\<lambda>tcb. P (tcbQueued tcb)) tcb_ptr s)\<rbrace>"
+  by wpsimp
+
 lemma schedule_no_orphans[wp]:
   notes ssa_wp[wp del]
   shows
-  "\<lbrace> \<lambda>s. no_orphans s \<and> invs' s \<rbrace>
-   schedule
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+  "\<lbrace>no_orphans and invs'\<rbrace> schedule \<lbrace>\<lambda>_. no_orphans\<rbrace>"
 proof -
 
   have do_switch_to:
     "\<And>candidate.
      \<lbrace>\<lambda>s. no_orphans s \<and> ksSchedulerAction s = SwitchToThread candidate
           \<and> st_tcb_at' runnable' candidate s
-          \<and> (st_tcb_at' runnable' (ksCurThread s) s
-             \<longrightarrow> (\<exists>d p. ksCurThread s \<in> set (ksReadyQueues s (d, p)))) \<rbrace>
-      do ThreadDecls_H.switchToThread candidate;
-         setSchedulerAction ResumeCurrentThread
-      od
-    \<lbrace>\<lambda>rv. no_orphans\<rbrace>"
+          \<and> (st_tcb_at' runnable' (ksCurThread s) s \<longrightarrow> ksCurThread s \<in> all_queued_tcb_ptrs s) \<rbrace>
+     do ThreadDecls_H.switchToThread candidate;
+        setSchedulerAction ResumeCurrentThread
+     od
+     \<lbrace>\<lambda>_. no_orphans\<rbrace>"
     apply (wpsimp wp: scheduleChooseNewThread_no_orphans ssa_no_orphans
                       hoare_vcg_all_lift ThreadDecls_H_switchToThread_no_orphans)+
      apply (rule_tac Q="\<lambda>_ s. (t = candidate \<longrightarrow> ksCurThread s = candidate) \<and>
@@ -1084,56 +845,43 @@ proof -
 
   have abort_switch_to_enq:
     "\<And>candidate.
-     \<lbrace>\<lambda>s. no_orphans s \<and> invs' s \<and> valid_queues' s
+     \<lbrace>\<lambda>s. no_orphans s \<and> invs' s
           \<and> ksSchedulerAction s = SwitchToThread candidate
-          \<and> (st_tcb_at' runnable' (ksCurThread s) s
-               \<longrightarrow> (\<exists>d p. ksCurThread s \<in> set (ksReadyQueues s (d, p)))) \<rbrace>
-       do tcbSchedEnqueue candidate;
-          setSchedulerAction ChooseNewThread;
-          scheduleChooseNewThread
-       od
-     \<lbrace>\<lambda>rv. no_orphans\<rbrace>"
-     apply (rule hoare_pre)
-     apply (wp scheduleChooseNewThread_no_orphans ssa_no_orphans setSchedulerAction_direct)
+          \<and> (st_tcb_at' runnable' (ksCurThread s) s \<longrightarrow> ksCurThread s \<in> all_queued_tcb_ptrs s) \<rbrace>
+     do tcbSchedEnqueue candidate;
+        setSchedulerAction ChooseNewThread;
+        scheduleChooseNewThread
+     od
+     \<lbrace>\<lambda>_. no_orphans\<rbrace>"
+    apply (wpsimp wp: scheduleChooseNewThread_no_orphans ssa_no_orphans setSchedulerAction_direct)
       apply (wpsimp wp: hoare_vcg_imp_lift' hoare_vcg_ex_lift
-                    simp: is_active_tcb_ptr_runnable' all_queued_tcb_ptrs_def
-             | rule hoare_lift_Pf2[where f=ksCurThread, OF setSchedulerAction_ksQ])+
-     apply (wp tcbSchedEnqueue_in_ksQ' tcbSchedEnqueue_no_orphans hoare_vcg_all_lift hoare_vcg_imp_lift' hoare_vcg_disj_lift)
-      apply (wp hoare_lift_Pf2[where f=ksCurThread, OF tcbSchedEnqueue_pred_tcb_at']
-                hoare_lift_Pf2[where f=ksCurThread, OF tcbSchedEnqueue_in_ksQ_already_queued]
-                tcbSchedEnqueue_no_orphans
-             | strengthen not_pred_tcb_at'_strengthen
-             | wp (once) hoare_vcg_imp_lift')+
-    apply (clarsimp)
-    apply (frule invs_sch_act_wf', clarsimp simp: pred_tcb_at')
-    apply (simp add: st_tcb_at_neg' tcb_at_invs')
+                  simp: is_active_tcb_ptr_runnable' all_queued_tcb_ptrs_def
+             | rule hoare_lift_Pf2[where f=ksCurThread, OF setSchedulerAction_tcbQueued])+
+     apply (wp hoare_vcg_all_lift hoare_vcg_imp_lift' hoare_vcg_disj_lift
+            | strengthen not_pred_tcb_at'_strengthen
+            | rule hoare_lift_Pf2[where f=ksCurThread])+
+    apply (simp add: st_tcb_at_neg' tcb_at_invs' all_queued_tcb_ptrs_def)
     done
 
   have abort_switch_to_app:
     "\<And>candidate.
-     \<lbrace>\<lambda>s. no_orphans s \<and> invs' s \<and> valid_queues' s
+     \<lbrace>\<lambda>s. no_orphans s \<and> invs' s
           \<and> ksSchedulerAction s = SwitchToThread candidate
           \<and> (st_tcb_at' runnable' (ksCurThread s) s
-             \<longrightarrow> (\<exists>d p. ksCurThread s \<in> set (ksReadyQueues s (d, p))) ) \<rbrace>
-       do tcbSchedAppend candidate;
-          setSchedulerAction ChooseNewThread;
-          scheduleChooseNewThread
-       od
-     \<lbrace>\<lambda>rv. no_orphans\<rbrace>"
-     apply (rule hoare_pre)
-     apply (wp scheduleChooseNewThread_no_orphans ssa_no_orphans setSchedulerAction_direct)
+             \<longrightarrow> ksCurThread s \<in> all_queued_tcb_ptrs s ) \<rbrace>
+     do tcbSchedAppend candidate;
+        setSchedulerAction ChooseNewThread;
+        scheduleChooseNewThread
+     od
+     \<lbrace>\<lambda>_. no_orphans\<rbrace>"
+    apply (wpsimp wp: scheduleChooseNewThread_no_orphans ssa_no_orphans setSchedulerAction_direct)
       apply (wpsimp wp: hoare_vcg_imp_lift' hoare_vcg_ex_lift
-                    simp: is_active_tcb_ptr_runnable' all_queued_tcb_ptrs_def
-             | rule hoare_lift_Pf2[where f=ksCurThread, OF setSchedulerAction_ksQ])+
-     apply (wp tcbSchedAppend_in_ksQ'' tcbSchedAppend_no_orphans hoare_vcg_all_lift hoare_vcg_imp_lift' hoare_vcg_disj_lift)
-      apply (wp hoare_lift_Pf2[where f=ksCurThread, OF tcbSchedAppend_pred_tcb_at']
-                hoare_lift_Pf2[where f=ksCurThread, OF tcbSchedAppend_in_ksQ_already_queued]
-                tcbSchedAppend_no_orphans
-             | strengthen not_pred_tcb_at'_strengthen
-             | wp (once) hoare_vcg_imp_lift')+
-    apply (clarsimp)
-    apply (frule invs_sch_act_wf', clarsimp simp: pred_tcb_at')
-    apply (simp add: st_tcb_at_neg' tcb_at_invs')
+                  simp: is_active_tcb_ptr_runnable' all_queued_tcb_ptrs_def
+             | rule hoare_lift_Pf2[where f=ksCurThread, OF setSchedulerAction_tcbQueued])+
+     apply (wp hoare_vcg_all_lift hoare_vcg_imp_lift' hoare_vcg_disj_lift
+            | strengthen not_pred_tcb_at'_strengthen
+            | rule hoare_lift_Pf2[where f=ksCurThread])+
+    apply (simp add: st_tcb_at_neg' tcb_at_invs' all_queued_tcb_ptrs_def)
     done
 
   show ?thesis
@@ -1147,24 +895,20 @@ proof -
         apply (wp ssa_no_orphans hoare_vcg_all_lift)
             apply (wp hoare_disjI1 chooseThread_nosch)
            apply (wp nextDomain_invs_no_cicd' hoare_vcg_imp_lift
-                     hoare_lift_Pf2 [OF ksQ_all_queued_tcb_ptrs_lift
-                                        [OF nextDomain_ksQ]
-                                        nextDomain_ct']
+                     hoare_lift_Pf2 [OF tcbQueued_all_queued_tcb_ptrs_lift
+                                      [OF nextDomain_tcbQueued]
+                                      nextDomain_ct']
                      hoare_lift_Pf2 [OF st_tcb_at'_is_active_tcb_ptr_lift
                                       [OF nextDomain_st_tcb_at']
                                       nextDomain_ct']
                      hoare_vcg_all_lift getDomainTime_wp)[2]
-          apply ((wp tcbSchedEnqueue_no_orphans tcbSchedEnqueue_in_ksQ'
-                     hoare_drop_imp
-                | clarsimp simp: all_queued_tcb_ptrs_def
-                | strengthen all_invs_but_ct_idle_or_in_cur_domain'_strg
-                | wps tcbSchedEnqueue_ct')+)[1]
-         apply ((wp tcbSchedEnqueue_no_orphans tcbSchedEnqueue_in_ksQ'
+          apply wpsimp
+         apply ((wp tcbSchedEnqueue_no_orphans tcbSchedEnqueue_all_queued_tcb_ptrs'
                     hoare_drop_imp
-               | clarsimp simp: all_queued_tcb_ptrs_def
-               | strengthen all_invs_but_ct_idle_or_in_cur_domain'_strg
-               | wps tcbSchedEnqueue_ct')+)[1]
-        apply wp[1]
+                 | clarsimp simp: all_queued_tcb_ptrs_def
+                 | strengthen all_invs_but_ct_idle_or_in_cur_domain'_strg
+                 | wps)+)[1]
+        apply wpsimp
        \<comment> \<open>action = SwitchToThread candidate\<close>
        apply (clarsimp)
        apply (rename_tac candidate)
@@ -1173,14 +917,11 @@ proof -
               apply (wp hoare_drop_imps)
              apply (wp add: tcbSchedEnqueue_no_orphans)+
         apply (clarsimp simp: conj_comms cong: conj_cong imp_cong split del: if_split)
-        apply (wp hoare_lift_Pf2[where f=ksCurThread, OF tcbSchedEnqueue_pred_tcb_at']
-                  hoare_lift_Pf2[where f=ksCurThread, OF tcbSchedEnqueue_in_ksQ']
-                  hoare_vcg_imp_lift'
+        apply (wp hoare_vcg_imp_lift'
                | strengthen not_pred_tcb_at'_strengthen)+
-    apply (clarsimp simp: comp_def)
-    apply (frule invs_queues)
-    apply (clarsimp simp: invs_valid_queues' tcb_at_invs' st_tcb_at_neg' is_active_tcb_ptr_runnable')
-    apply (fastforce simp: all_invs_but_ct_idle_or_in_cur_domain'_strg invs_switchToThread_runnable')
+        apply (wps | wpsimp wp: tcbSchedEnqueue_all_queued_tcb_ptrs')+
+    apply (fastforce simp: is_active_tcb_ptr_runnable' all_invs_but_ct_idle_or_in_cur_domain'_strg
+                           invs_switchToThread_runnable')
     done
 qed
 
@@ -1201,47 +942,42 @@ crunch no_orphans [wp]: completeSignal "no_orphans"
 (simp: crunch_simps wp: crunch_wps)
 
 lemma possibleSwitchTo_almost_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. almost_no_orphans target s \<and> valid_queues' s \<and> st_tcb_at' runnable' target s
-         \<and> weak_sch_act_wf (ksSchedulerAction s) s \<rbrace>
+  "\<lbrace>\<lambda>s. almost_no_orphans target s \<and> st_tcb_at' runnable' target s
+        \<and> weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
    possibleSwitchTo target
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding possibleSwitchTo_def
-  by (wp rescheduleRequired_valid_queues'_weak tcbSchedEnqueue_almost_no_orphans
+  by (wp tcbSchedEnqueue_almost_no_orphans
          ssa_almost_no_orphans hoare_weak_lift_imp
      | wpc | clarsimp
      | wp (once) hoare_drop_imp)+
 
 lemma possibleSwitchTo_almost_no_orphans':
-  "\<lbrace> \<lambda>s. almost_no_orphans target s \<and> valid_queues' s \<and> st_tcb_at' runnable' target s
-         \<and> sch_act_wf (ksSchedulerAction s) s \<rbrace>
+  "\<lbrace>\<lambda>s. almost_no_orphans target s \<and> st_tcb_at' runnable' target s
+        \<and> sch_act_wf (ksSchedulerAction s) s \<rbrace>
    possibleSwitchTo target
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   by wp (strengthen sch_act_wf_weak, assumption)
 
+crunches tcbQueueAppend, tcbQueuePrepend
+  for almost_no_orphans[wp]: "almost_no_orphans tcbPtr"
+
 lemma tcbSchedAppend_almost_no_orphans:
-  "\<lbrace> \<lambda>s. almost_no_orphans thread s \<and> valid_queues' s \<rbrace>
+  "\<lbrace>almost_no_orphans thread\<rbrace>
    tcbSchedAppend thread
-   \<lbrace> \<lambda>_ s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding tcbSchedAppend_def
-  apply (wp setQueue_almost_no_orphans_enq[where tcb_ptr=thread] threadSet_no_orphans
-            | clarsimp simp: unless_def | simp only: subset_insertI)+
-  apply (unfold threadGet_def)
-  apply (wp getObject_tcb_wp | clarsimp)+
-  apply (drule obj_at_ko_at', clarsimp)
-  apply (rule_tac x=ko in exI)
-  apply (clarsimp simp: almost_no_orphans_def no_orphans_def)
-  apply (drule queued_in_queue | simp)+
-  apply (auto simp: all_queued_tcb_ptrs_def)
+  apply (wpsimp wp: tcbQueued_update_True_no_orphans threadGet_wp)
+  apply (fastforce simp: almost_no_orphans_def no_orphans_def all_queued_tcb_ptrs_def obj_at'_def)
   done
 
 lemma no_orphans_is_almost[simp]:
   "no_orphans s \<Longrightarrow> almost_no_orphans t s"
   by (clarsimp simp: no_orphans_def almost_no_orphans_def)
 
-crunch no_orphans [wp]: decDomainTime no_orphans
-(wp: no_orphans_lift)
-
-crunch valid_queues' [wp]: decDomainTime valid_queues'
+crunches decDomainTime
+  for no_orphans [wp]: no_orphans
+  (wp: no_orphans_lift)
 
 lemma timerTick_no_orphans [wp]:
   "\<lbrace> \<lambda>s. no_orphans s \<and> invs' s \<rbrace>
@@ -1250,28 +986,18 @@ lemma timerTick_no_orphans [wp]:
   unfolding timerTick_def getDomainTime_def
   supply if_split[split del]
   apply (subst threadState_case_if)
-  apply (wpsimp wp: threadSet_no_orphans threadSet_valid_queues'
-                    threadSet_valid_queues' tcbSchedAppend_almost_no_orphans threadSet_sch_act
+  apply (wpsimp wp: threadSet_no_orphans tcbSchedAppend_almost_no_orphans
                     threadSet_almost_no_orphans threadSet_no_orphans tcbSchedAppend_sch_act_wf
                     hoare_drop_imp
                 simp: if_apply_def2
          | strengthen sch_act_wf_weak)+
-      apply (rule_tac Q="\<lambda>rv s. no_orphans s \<and> valid_queues' s \<and> tcb_at' thread s
-                                \<and> sch_act_wf  (ksSchedulerAction s) s" in hoare_post_imp)
-       apply (clarsimp simp: inQ_def)
-      apply (wp hoare_drop_imps | clarsimp)+
-  apply (auto split: if_split)
   done
 
-
 lemma handleDoubleFault_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<rbrace>
-   handleDoubleFault tptr ex1 ex2
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+  "\<lbrace>no_orphans\<rbrace> handleDoubleFault tptr ex1 ex2 \<lbrace>\<lambda>_. no_orphans \<rbrace>"
   unfolding handleDoubleFault_def
-  apply (wp setThreadState_not_active_no_orphans
-         | clarsimp simp: is_active_thread_state_def isRestart_def isRunning_def)+
-  done
+  by (wpsimp wp: setThreadState_not_active_no_orphans
+           simp: is_active_thread_state_def isRestart_def isRunning_def)+
 
 crunch st_tcb' [wp]: getThreadCallerSlot "st_tcb_at' (\<lambda>st. P st) t"
 
@@ -1307,82 +1033,50 @@ lemma setupCallerCap_almost_no_orphans [wp]:
          | clarsimp simp: is_active_thread_state_def isRestart_def isRunning_def)+
   done
 
-crunches doIPCTransfer, setMRs
-  for no_orphans [wp]: "no_orphans"
-  (wp: no_orphans_lift)
-
-crunch ksQ'[wp]: setEndpoint "\<lambda>s. P (ksReadyQueues s)"
-  (wp: setObject_queues_unchanged_tcb updateObject_default_inv)
+crunches cteInsert, setExtraBadge, setMessageInfo, transferCaps, copyMRs,
+         doNormalTransfer, doFaultTransfer, copyGlobalMappings
+  for tcbQueued[wp]: "obj_at' (\<lambda>tcb. P (tcbQueued tcb)) tcb_ptr"
+  (wp: crunch_wps simp: crunch_simps)
 
-crunch no_orphans [wp]: setEndpoint "no_orphans"
-  (wp: no_orphans_lift)
+crunches doIPCTransfer, setMRs, setEndpoint
+  for ksReadyQueues [wp]: "\<lambda>s. P (ksReadyQueues s)"
+  and no_orphans [wp]: "no_orphans"
+  (wp: no_orphans_lift updateObject_default_inv)
 
 lemma sendIPC_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s \<rbrace>
+  "\<lbrace>\<lambda>s. no_orphans s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s\<rbrace>
    sendIPC blocking call badge canGrant canGrantReply thread epptr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding sendIPC_def
   apply (wp hoare_drop_imps setThreadState_not_active_no_orphans sts_st_tcb'
             possibleSwitchTo_almost_no_orphans'
          | wpc
          | clarsimp simp: is_active_thread_state_def isRestart_def isRunning_def)+
-
-  apply (rule_tac Q="\<lambda>rv. no_orphans and valid_queues' and valid_objs' and ko_at' rv epptr
+  apply (rule_tac Q="\<lambda>rv. no_orphans and valid_objs' and ko_at' rv epptr
                           and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)" in hoare_post_imp)
    apply (fastforce simp: valid_objs'_def valid_obj'_def valid_ep'_def obj_at'_def)
   apply (wp get_ep_sp' | clarsimp)+
   done
 
 lemma sendFaultIPC_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s \<rbrace>
+  "\<lbrace>\<lambda>s. no_orphans s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s\<rbrace>
    sendFaultIPC tptr fault
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding sendFaultIPC_def
   apply (rule hoare_pre)
-   apply (wp threadSet_valid_queues' threadSet_no_orphans threadSet_valid_objs'
+   apply (wp threadSet_no_orphans threadSet_valid_objs'
              threadSet_sch_act | wpc | clarsimp)+
-    apply (rule_tac Q'="\<lambda>handlerCap s. no_orphans s \<and> valid_queues' s
-                                         \<and> valid_objs' s
-                                         \<and> sch_act_wf (ksSchedulerAction s) s"
-             in hoare_post_imp_R)
+    apply (rule_tac Q'="\<lambda>_ s. no_orphans s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s"
+                 in hoare_post_imp_R)
      apply (wp | clarsimp simp: inQ_def valid_tcb'_def tcb_cte_cases_def)+
   done
 
-lemma sendIPC_valid_queues' [wp]:
-  "\<lbrace> \<lambda>s. valid_queues' s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s \<rbrace>
-   sendIPC blocking call badge canGrant canGrantReply thread epptr
-   \<lbrace> \<lambda>rv s. valid_queues' s \<rbrace>"
-  unfolding sendIPC_def
-  apply (wpsimp wp: hoare_drop_imps)
-        apply (wpsimp | wp (once) sts_st_tcb' hoare_drop_imps)+
-  apply (rule_tac Q="\<lambda>rv. valid_queues' and valid_objs' and ko_at' rv epptr
-                          and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)" in hoare_post_imp)
-   apply (clarsimp)
-  apply (wp get_ep_sp' | clarsimp)+
-  done
-
-lemma sendFaultIPC_valid_queues' [wp]:
-  "\<lbrace> \<lambda>s. valid_queues' s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s \<rbrace>
-   sendFaultIPC tptr fault
-   \<lbrace> \<lambda>rv s. valid_queues' s \<rbrace>"
-  unfolding sendFaultIPC_def
-  apply (rule hoare_pre)
-   apply (wp threadSet_valid_queues' threadSet_valid_objs' threadSet_sch_act
-          | wpc | clarsimp)+
-    apply (rule_tac Q'="\<lambda>handlerCap s. valid_queues' s \<and> valid_objs' s
-                                         \<and> sch_act_wf (ksSchedulerAction s) s"
-             in hoare_post_imp_R)
-     apply (wp | clarsimp simp: inQ_def valid_tcb'_def tcb_cte_cases_def)+
-  done
-
-lemma handleFault_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s \<rbrace>
+lemma handleFault_no_orphans[wp]:
+  "\<lbrace>\<lambda>s. no_orphans s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s\<rbrace>
    handleFault tptr ex1
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding handleFault_def
-  apply (rule hoare_pre)
-   apply (wp | clarsimp)+
-  done
+  by wpsimp
 
 lemma replyFromKernel_no_orphans [wp]:
   "\<lbrace> \<lambda>s. no_orphans s \<rbrace>
@@ -1394,32 +1088,24 @@ lemma replyFromKernel_no_orphans [wp]:
 
 crunch inv [wp]: alignError "P"
 
-lemma createObjects_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> pspace_aligned' s \<and> pspace_no_overlap' ptr sz s \<and> pspace_distinct' s
-      \<and> n \<noteq> 0 \<and> range_cover ptr sz (objBitsKO val + gbits) n
-      \<and> \<not> case_option False (is_active_thread_state \<circ> tcbState) (projectKO_opt val) \<rbrace>
+lemma createObjects_no_orphans[wp]:
+  "\<lbrace>\<lambda>s. no_orphans s \<and> pspace_aligned' s \<and> pspace_no_overlap' ptr sz s \<and> pspace_distinct' s
+        \<and> n \<noteq> 0 \<and> range_cover ptr sz (objBitsKO val + gbits) n
+        \<and> \<not> case_option False (is_active_thread_state \<circ> tcbState) (projectKO_opt val)
+        \<and> \<not> case_option False tcbQueued (projectKO_opt val)\<rbrace>
    createObjects ptr n val gbits
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_ s. no_orphans s\<rbrace>"
   apply (clarsimp simp: no_orphans_def all_active_tcb_ptrs_def
                         is_active_tcb_ptr_def all_queued_tcb_ptrs_def)
   apply (simp only: imp_conv_disj pred_tcb_at'_def createObjects_def)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift createObjects_orig_obj_at2')
-  apply clarsimp
-  apply (erule(1) impE)
-  apply clarsimp
-  apply (drule_tac x = x in spec)
-  apply (erule impE)
-   apply (clarsimp simp: obj_at'_def split: option.splits)
-  apply simp
+  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift createObjects_orig_obj_at2'[where sz=sz])
+  apply (clarsimp simp: comp_def split: option.splits)
   done
 
-lemma copyGlobalMappings_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<rbrace>
-   copyGlobalMappings newPD
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+lemma copyGlobalMappings_no_orphans[wp]:
+  "copyGlobalMappings newPD \<lbrace>no_orphans\<rbrace>"
   unfolding no_orphans_disj all_queued_tcb_ptrs_def
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-  done
+  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift)
 
 crunch no_orphans [wp]: insertNewCap "no_orphans"
 (wp: hoare_drop_imps)
@@ -1565,43 +1251,45 @@ lemma mapM_x_match:
   by assumption
 
 lemma cancelAllIPC_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<rbrace>
-    cancelAllIPC epptr
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+  "\<lbrace>\<lambda>s. no_orphans s \<and> valid_objs' s \<and> pspace_aligned' s \<and> pspace_distinct' s\<rbrace>
+   cancelAllIPC epptr
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding cancelAllIPC_def
   apply (wp sts_valid_objs' set_ep_valid_objs' sts_st_tcb'
             hoare_vcg_const_Ball_lift tcbSchedEnqueue_almost_no_orphans
              | wpc
              | rule mapM_x_match,
                rename_tac list,
-               rule_tac V="\<lambda>_. valid_queues' and valid_objs'"
+               rule_tac V="\<lambda>_. valid_objs' and pspace_aligned' and pspace_distinct'"
                     and I="no_orphans and (\<lambda>s. \<forall>t\<in>set list. tcb_at' t s)"
                      in mapM_x_inv_wp2
              | clarsimp simp: valid_tcb_state'_def)+
-  apply (rule_tac Q="\<lambda>rv. no_orphans and valid_objs' and valid_queues' and ko_at' rv epptr"
+  apply (rule_tac Q="\<lambda>rv. no_orphans and valid_objs' and pspace_aligned' and pspace_distinct' and
+                          ko_at' rv epptr"
                  in hoare_post_imp)
    apply (fastforce simp: valid_obj'_def valid_ep'_def obj_at'_def)
   apply (wp get_ep_sp' | clarsimp)+
   done
 
 lemma cancelAllSignals_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<rbrace>
+  "\<lbrace>\<lambda>s. no_orphans s \<and> valid_objs' s \<and> pspace_aligned' s \<and> pspace_distinct' s\<rbrace>
     cancelAllSignals ntfn
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding cancelAllSignals_def
   apply (wp sts_valid_objs' set_ntfn_valid_objs' sts_st_tcb'
             hoare_vcg_const_Ball_lift tcbSchedEnqueue_almost_no_orphans
              | wpc
              | clarsimp simp: valid_tcb_state'_def)+
     apply (rename_tac list)
-    apply (rule_tac V="\<lambda>_. valid_queues' and valid_objs'"
+    apply (rule_tac V="\<lambda>_. valid_objs' and pspace_aligned' and pspace_distinct'"
                 and I="no_orphans and (\<lambda>s. \<forall>t\<in>set list. tcb_at' t s)"
                 in mapM_x_inv_wp2)
     apply simp
    apply (wp sts_valid_objs' set_ntfn_valid_objs' sts_st_tcb'
             hoare_vcg_const_Ball_lift tcbSchedEnqueue_almost_no_orphans|
           clarsimp simp: valid_tcb_state'_def)+
-  apply (rule_tac Q="\<lambda>rv. no_orphans and valid_objs' and valid_queues' and ko_at' rv ntfn"
+  apply (rule_tac Q="\<lambda>rv. no_orphans and valid_objs' and pspace_aligned' and pspace_distinct' and
+                          ko_at' rv ntfn"
                  in hoare_post_imp)
    apply (fastforce simp: valid_obj'_def valid_ntfn'_def obj_at'_def)
   apply (wp get_ntfn_sp' | clarsimp)+
@@ -1627,43 +1315,36 @@ lemma unbindMaybeNotification_no_orphans[wp]:
   unfolding unbindMaybeNotification_def
   by (wp getNotification_wp | simp | wpc)+
 
-lemma finaliseCapTrue_standin_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<rbrace>
-    finaliseCapTrue_standin cap final
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+lemma finaliseCapTrue_standin_no_orphans[wp]:
+  "\<lbrace>no_orphans and valid_objs' and pspace_aligned' and pspace_distinct'\<rbrace>
+   finaliseCapTrue_standin cap final
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding finaliseCapTrue_standin_def
-  apply (rule hoare_pre)
-   apply (wp | clarsimp simp: Let_def | wpc)+
-  done
+  by (wpsimp | clarsimp simp: Let_def | wpc)+
 
-lemma cteDeleteOne_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<rbrace>
+lemma cteDeleteOne_no_orphans[wp]:
+  "\<lbrace>no_orphans and valid_objs' and pspace_aligned' and pspace_distinct'\<rbrace>
    cteDeleteOne slot
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding cteDeleteOne_def
-  apply (wp assert_inv isFinalCapability_inv weak_if_wp | clarsimp simp: unless_def)+
-  done
+  by (wp assert_inv isFinalCapability_inv weak_if_wp | clarsimp simp: unless_def)+
 
 crunch valid_objs' [wp]: getThreadReplySlot "valid_objs'"
 
-lemma cancelSignal_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<rbrace>
-   cancelSignal t ntfn
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+lemma cancelSignal_no_orphans[wp]:
+  "cancelSignal t ntfn \<lbrace>no_orphans\<rbrace>"
   unfolding cancelSignal_def Let_def
-  apply (rule hoare_pre)
-   apply (wp hoare_drop_imps setThreadState_not_active_no_orphans | wpc
-          | clarsimp simp: is_active_thread_state_def isRestart_def isRunning_def)+
-  done
+  by (wpsimp wp: hoare_drop_imps setThreadState_not_active_no_orphans
+           simp: is_active_thread_state_def isRestart_def isRunning_def)
 
 lemma cancelIPC_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<rbrace>
+  "\<lbrace>no_orphans and valid_objs' and pspace_aligned' and pspace_distinct'\<rbrace>
    cancelIPC t
    \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
   unfolding cancelIPC_def Let_def
   apply (rule hoare_pre)
    apply (wp setThreadState_not_active_no_orphans hoare_drop_imps weak_if_wp
-             threadSet_valid_queues' threadSet_valid_objs' threadSet_no_orphans | wpc
+             threadSet_valid_objs' threadSet_no_orphans | wpc
           | clarsimp simp: is_active_thread_state_def isRestart_def isRunning_def
                            inQ_def valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)+
   done
@@ -1672,30 +1353,26 @@ lemma cancelIPC_no_orphans [wp]:
 lemma asUser_almost_no_orphans:
   "\<lbrace>almost_no_orphans t\<rbrace> asUser a f \<lbrace>\<lambda>_. almost_no_orphans t\<rbrace>"
   unfolding almost_no_orphans_disj all_queued_tcb_ptrs_def
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-  done
+  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift)
 
-lemma sendSignal_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s\<rbrace>
+lemma sendSignal_no_orphans[wp]:
+  "\<lbrace>\<lambda>s. no_orphans s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s
+        \<and> pspace_aligned' s \<and> pspace_distinct' s\<rbrace>
    sendSignal ntfnptr badge
-   \<lbrace> \<lambda>_ s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding sendSignal_def
-  apply (rule hoare_pre)
-   apply (wp sts_st_tcb' gts_wp' getNotification_wp asUser_almost_no_orphans
-                          cancelIPC_weak_sch_act_wf
-          | wpc | clarsimp simp: sch_act_wf_weak)+
+  apply (wp sts_st_tcb' gts_wp' getNotification_wp asUser_almost_no_orphans
+            cancelIPC_weak_sch_act_wf
+         | wpc | clarsimp simp: sch_act_wf_weak)+
   done
 
-lemma handleInterrupt_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> invs' s \<rbrace>
+lemma handleInterrupt_no_orphans[wp]:
+  "\<lbrace>no_orphans and invs' and pspace_aligned' and pspace_distinct'\<rbrace>
    handleInterrupt irq
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding handleInterrupt_def
-  apply (rule hoare_pre)
-   apply (wp hoare_drop_imps hoare_vcg_all_lift getIRQState_inv
-         | wpc | clarsimp simp: invs'_def valid_state'_def maskIrqSignal_def
-                                handleReservedIRQ_def)+
-  done
+  by (wp hoare_drop_imps hoare_vcg_all_lift getIRQState_inv
+      | wpc | clarsimp simp: invs'_def valid_state'_def maskIrqSignal_def handleReservedIRQ_def)+
 
 lemma updateRestartPC_no_orphans[wp]:
   "\<lbrace> \<lambda>s. no_orphans s \<and> invs' s \<rbrace>
@@ -1703,20 +1380,6 @@ lemma updateRestartPC_no_orphans[wp]:
    \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
   by (wpsimp simp: updateRestartPC_def asUser_no_orphans)
 
-lemma updateRestartPC_valid_queues'[wp]:
-  "\<lbrace> \<lambda>s. valid_queues' s \<rbrace>
-   updateRestartPC t
-   \<lbrace> \<lambda>rv s. valid_queues' s \<rbrace>"
-  unfolding updateRestartPC_def
-  apply (rule asUser_valid_queues')
-  done
-
-lemma updateRestartPC_no_orphans_invs'_valid_queues'[wp]:
-  "\<lbrace>\<lambda>s. no_orphans s \<and> invs' s \<and> valid_queues' s \<rbrace>
-   updateRestartPC t
-   \<lbrace>\<lambda>rv s. no_orphans s \<and> valid_queues' s \<rbrace>"
-  by (wpsimp simp: updateRestartPC_def asUser_no_orphans)
-
 lemma suspend_no_orphans [wp]:
   "\<lbrace> \<lambda>s. no_orphans s \<and> invs' s \<and> sch_act_simple s \<and> tcb_at' t s \<rbrace>
    suspend t
@@ -1742,13 +1405,10 @@ lemma deleteASIDPool_no_orphans [wp]:
      apply (wp mapM_wp_inv getObject_inv loadObject_default_inv | clarsimp)+
   done
 
-lemma storePTE_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<rbrace>
-   storePTE ptr val
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+lemma storePTE_no_orphans[wp]:
+  "storePTE ptr val \<lbrace>no_orphans\<rbrace>"
   unfolding no_orphans_disj all_queued_tcb_ptrs_def
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-  done
+  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift)
 
 crunch no_orphans [wp]: unmapPage "no_orphans"
   (wp: crunch_wps)
@@ -1757,13 +1417,10 @@ crunches unmapPageTable, prepareThreadDelete
   for no_orphans [wp]: "no_orphans"
   (wp: lookupPTSlotFromLevel_inv)
 
-lemma setASIDPool_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<rbrace>
-   setObject p (ap :: asidpool)
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+lemma setASIDPool_no_orphans[wp]:
+  "setObject p (ap :: asidpool) \<lbrace>no_orphans\<rbrace>"
   unfolding no_orphans_disj all_queued_tcb_ptrs_def
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-  done
+  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift)
 
 lemma deleteASID_no_orphans [wp]:
   "\<lbrace> \<lambda>s. no_orphans s \<rbrace>
@@ -1851,9 +1508,7 @@ lemma cteRevoke_no_orphans [wp]:
   done
 
 lemma cancelBadgedSends_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<rbrace>
-   cancelBadgedSends epptr badge
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+  "cancelBadgedSends epptr badge \<lbrace>no_orphans\<rbrace>"
   unfolding cancelBadgedSends_def
   apply (wpsimp wp: filterM_preserved tcbSchedEnqueue_almost_no_orphans gts_wp' sts_st_tcb'
          | wp (once) hoare_drop_imps)+
@@ -1867,25 +1522,16 @@ lemma doReplyTransfer_no_orphans[wp]:
    \<lbrace>\<lambda>rv. no_orphans\<rbrace>"
   unfolding doReplyTransfer_def
   apply (wp sts_st_tcb' setThreadState_not_active_no_orphans threadSet_no_orphans
-            threadSet_valid_queues' threadSet_weak_sch_act_wf
+            threadSet_weak_sch_act_wf
          | wpc | clarsimp simp: is_active_thread_state_def isRunning_def isRestart_def
          | wp (once) hoare_drop_imps
-         | strengthen sch_act_wf_weak invs_valid_queues')+
+         | strengthen sch_act_wf_weak)+
               apply (rule_tac Q="\<lambda>rv. invs' and no_orphans" in hoare_post_imp)
                apply (fastforce simp: inQ_def)
               apply (wp hoare_drop_imps | clarsimp)+
   apply (clarsimp simp:invs'_def valid_state'_def valid_pspace'_def)
   done
 
-lemma cancelSignal_valid_queues' [wp]:
-  "\<lbrace> \<lambda>s. valid_queues' s \<and> valid_objs' s \<rbrace>
-   cancelSignal t ntfn
-   \<lbrace> \<lambda>rv s. valid_queues' s \<rbrace>"
-  unfolding cancelSignal_def Let_def
-  apply (rule hoare_pre)
-   apply (wp hoare_drop_imps | wpc | clarsimp)+
-  done
-
 crunch no_orphans [wp]: setupReplyMaster "no_orphans"
   (wp: crunch_wps simp: crunch_simps)
 
@@ -1897,7 +1543,6 @@ lemma restart_no_orphans [wp]:
   apply (wp tcbSchedEnqueue_almost_no_orphans sts_st_tcb' cancelIPC_weak_sch_act_wf
          | clarsimp simp: o_def if_apply_def2
          | strengthen no_orphans_strg_almost
-         | strengthen invs_valid_queues'
          | wp (once) hoare_drop_imps)+
   apply auto
   done
@@ -1911,15 +1556,12 @@ lemma readreg_no_orphans:
   done
 
 lemma writereg_no_orphans:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> invs' s \<and> sch_act_simple s
-       \<and> tcb_at' dest s \<and> ex_nonz_cap_to' dest s\<rbrace>
-     invokeTCB (tcbinvocation.WriteRegisters dest resume values arch)
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+  "\<lbrace>\<lambda>s. no_orphans s \<and> invs' s \<and> sch_act_simple s \<and> tcb_at' dest s \<and> ex_nonz_cap_to' dest s\<rbrace>
+   invokeTCB (tcbinvocation.WriteRegisters dest resume values arch)
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding invokeTCB_def performTransfer_def postModifyRegisters_def
-  apply simp
-  apply (rule hoare_pre)
-  by (wp hoare_vcg_if_lift hoare_vcg_conj_lift restart_invs' hoare_weak_lift_imp
-       | strengthen invs_valid_queues'  | clarsimp  simp: invs'_def valid_state'_def dest!: global'_no_ex_cap )+
+  by (wpsimp wp: hoare_vcg_if_lift hoare_vcg_conj_lift restart_invs' hoare_weak_lift_imp
+      | clarsimp simp: invs'_def valid_state'_def dest!: global'_no_ex_cap )+
 
 lemma copyreg_no_orphans:
   "\<lbrace> \<lambda>s. no_orphans s \<and> invs' s \<and> sch_act_simple s \<and> tcb_at' src s
@@ -1930,8 +1572,8 @@ lemma copyreg_no_orphans:
   apply simp
   apply (wp hoare_vcg_if_lift hoare_weak_lift_imp)
       apply (wp hoare_weak_lift_imp hoare_vcg_conj_lift hoare_drop_imp mapM_x_wp' restart_invs'
-             restart_no_orphans asUser_no_orphans suspend_nonz_cap_to_tcb
-             | strengthen invs_valid_queues' | wpc | simp add: if_apply_def2)+
+                restart_no_orphans asUser_no_orphans suspend_nonz_cap_to_tcb
+             | wpc | simp add: if_apply_def2)+
   apply (fastforce simp: invs'_def valid_state'_def dest!: global'_no_ex_cap)
   done
 
@@ -1953,22 +1595,19 @@ lemma almost_no_orphans_no_orphans':
   "\<lbrakk> almost_no_orphans t s; ksCurThread s = t\<rbrakk> \<Longrightarrow> no_orphans s"
   by (auto simp: almost_no_orphans_def no_orphans_def all_active_tcb_ptrs_def)
 
-lemma setPriority_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> invs' s \<and> tcb_at' tptr s \<rbrace>
+lemma setPriority_no_orphans[wp]:
+  "\<lbrace>no_orphans and invs' and tcb_at' tptr\<rbrace>
    setPriority tptr prio
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding setPriority_def
   apply wpsimp
-    apply (rule_tac Q="\<lambda>rv s. almost_no_orphans tptr s \<and> valid_queues' s \<and> weak_sch_act_wf (ksSchedulerAction s) s" in hoare_post_imp)
+    apply (rule_tac Q="\<lambda>_ s. almost_no_orphans tptr s \<and> weak_sch_act_wf (ksSchedulerAction s) s" in hoare_post_imp)
      apply clarsimp
      apply (clarsimp simp: is_active_tcb_ptr_runnable' pred_tcb_at'_def obj_at'_def
                            almost_no_orphans_no_orphans elim!: almost_no_orphans_no_orphans')
-    apply (wp threadSet_almost_no_orphans threadSet_valid_queues' | clarsimp simp: inQ_def)+
+    apply (wp threadSet_almost_no_orphans | clarsimp simp: inQ_def)+
     apply (wpsimp wp: threadSet_weak_sch_act_wf)
    apply (wp tcbSchedDequeue_almost_no_orphans| clarsimp)+
-   apply (rule_tac Q="\<lambda>rv. obj_at' (Not \<circ> tcbQueued) tptr and invs' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)" in hoare_post_imp)
-    apply (clarsimp simp: obj_at'_def inQ_def)
-   apply (wp tcbSchedDequeue_not_queued | clarsimp)+
   done
 
 lemma setMCPriority_no_orphans[wp]:
@@ -2020,7 +1659,6 @@ lemma tc_no_orphans:
                checkCap_inv[where P=no_orphans] checkCap_inv[where P="tcb_at' a"]
                threadSet_cte_wp_at' hoare_vcg_all_lift_R hoare_vcg_all_lift threadSet_no_orphans
                hoare_vcg_const_imp_lift_R hoare_weak_lift_imp hoare_drop_imp threadSet_ipcbuffer_invs
-          | strengthen invs_valid_queues'
           | (simp add: locateSlotTCB_def locateSlotBasic_def objBits_def
                      objBitsKO_def tcbIPCBufferSlot_def tcb_cte_cases_def,
            wp hoare_return_sp)
@@ -2051,13 +1689,12 @@ lemma invokeTCB_no_orphans [wp]:
   done
 
 lemma invokeCNode_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> invs' s \<and> valid_cnode_inv' cinv s \<and> sch_act_simple s \<rbrace>
+  "\<lbrace>no_orphans and invs' and valid_cnode_inv' cinv and sch_act_simple\<rbrace>
    invokeCNode cinv
-   \<lbrace> \<lambda>rv. no_orphans \<rbrace>"
+   \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   unfolding invokeCNode_def
   apply (rule hoare_pre)
    apply (wp hoare_drop_imps unless_wp | wpc | clarsimp split del: if_split)+
-  apply (simp add: invs_valid_queues')
   done
 
 lemma invokeIRQControl_no_orphans [wp]:
@@ -2190,17 +1827,15 @@ lemma arch_performInvocation_no_orphans [wp]:
   done
 
 lemma setDomain_no_orphans [wp]:
-  "\<lbrace>no_orphans and valid_queues and valid_queues' and cur_tcb'\<rbrace>
-     setDomain tptr newdom
+  "\<lbrace>no_orphans and cur_tcb' and tcb_at' tptr\<rbrace>
+   setDomain tptr newdom
    \<lbrace>\<lambda>_. no_orphans\<rbrace>"
   apply (simp add: setDomain_def when_def)
   apply (wp tcbSchedEnqueue_almost_no_orphans hoare_vcg_imp_lift threadSet_almost_no_orphans
-            threadSet_valid_queues'_no_state threadSet_st_tcb_at2 hoare_vcg_disj_lift
+            threadSet_st_tcb_at2 hoare_vcg_disj_lift
             threadSet_no_orphans
-       | clarsimp simp: st_tcb_at_neg2 not_obj_at')+
-   apply (auto simp: tcb_at_typ_at' st_tcb_at_neg' is_active_tcb_ptr_runnable'
-                     cur_tcb'_def obj_at'_def
-               dest: pred_tcb_at')
+         | clarsimp simp: st_tcb_at_neg2 not_obj_at')+
+  apply (fastforce simp: tcb_at_typ_at'  is_active_tcb_ptr_runnable')
   done
 
 lemma performInvocation_no_orphans [wp]:
@@ -2227,8 +1862,6 @@ lemma K_bind_hoareE [wp]:
   "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> K_bind f x \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
   by simp
 
-crunch valid_queues' [wp]: replyFromKernel "valid_queues'"
-
 lemma handleInvocation_no_orphans [wp]:
   "\<lbrace> \<lambda>s. no_orphans s \<and> invs' s \<and>
          ct_active' s \<and> ksSchedulerAction s = ResumeCurrentThread \<rbrace>
@@ -2246,20 +1879,12 @@ lemma handleInvocation_no_orphans [wp]:
                   ct_in_state'_set setThreadState_st_tcb
                   hoare_vcg_all_lift
                 | simp add: split_def split del: if_split)+
-         apply (wps setThreadState_ct')
-         apply (wp sts_ksQ
-                   setThreadState_current_no_orphans sts_invs_minor'
-                   ct_in_state'_set setThreadState_st_tcb
-                 | simp add: split_def split del: if_split)+
   apply (clarsimp simp: if_apply_def2)
-  apply (frule(1) ct_not_ksQ)
   by (auto simp: ct_in_state'_def pred_tcb_at'_def obj_at'_def invs'_def
                     cur_tcb'_def valid_state'_def valid_idle'_def)
 
 lemma receiveSignal_no_orphans [wp]:
-  "\<lbrace> \<lambda>s. no_orphans s \<and> valid_queues' s \<rbrace>
-   receiveSignal thread cap isBlocking
-   \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
+  "receiveSignal thread cap isBlocking \<lbrace>no_orphans\<rbrace>"
   unfolding receiveSignal_def
   apply (wp hoare_drop_imps setThreadState_not_active_no_orphans | wpc
          | clarsimp simp: is_active_thread_state_def isRunning_def isRestart_def
@@ -2277,7 +1902,7 @@ lemma receiveIPC_no_orphans [wp]:
              hoare_vcg_all_lift sts_st_tcb'
           | wpc
           | clarsimp simp: is_active_thread_state_def isRunning_def isRestart_def
-                           doNBRecvFailedTransfer_def invs_valid_queues'
+                           doNBRecvFailedTransfer_def
           | strengthen sch_act_wf_weak)+
   done
 
@@ -2368,7 +1993,8 @@ theorem callKernel_no_orphans [wp]:
    callKernel e
    \<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
   unfolding callKernel_def
-  by (wpsimp wp: weak_if_wp schedule_invs' hoare_drop_imps)
+  by (wpsimp wp: weak_if_wp schedule_invs' hoare_drop_imps
+      | strengthen invs_pspace_aligned' invs_pspace_distinct')+
 
 end
 
diff --git a/proof/refine/X64/ADT_H.thy b/proof/refine/X64/ADT_H.thy
index d4c1ed75ff..b83baca500 100644
--- a/proof/refine/X64/ADT_H.thy
+++ b/proof/refine/X64/ADT_H.thy
@@ -243,61 +243,61 @@ lemma
    apply (clarsimp simp add: absHeapArch_def)
    apply (rename_tac arch_kernel_object)
    apply (case_tac arch_kernel_object)
-         apply (rule_tac x=y in exI)
-         apply (clarsimp split: asidpool.splits)
-    using fst_pte
-        apply (erule_tac x=y in allE)
-        apply (clarsimp split: if_split_asm)
-        apply (rule_tac x="(y && ~~ mask pt_bits)" in exI, simp)
-        apply (simp add: range_composition[symmetric])
-        apply (rule_tac x="ucast (y >> 3)" in range_eqI)
-        apply (simp add: pt_bits_def pageBits_def bit_simps)
-        apply (simp add: word_size ucast_ucast_mask and_mask_shiftl_comm)
-    using pspace_aligned'
-        apply (simp add: pspace_aligned'_def dom_def)
-        apply (erule_tac x=y in allE)
-        apply (simp add: objBitsKO_def archObjSize_def is_aligned_neg_mask_eq
-        and_not_mask[symmetric] AND_NOT_mask_plus_AND_mask_eq)
-    using fst_pde
-       apply (erule_tac x=y in allE)
-       apply (clarsimp split: if_split_asm)
-       apply (rule_tac x="(y && ~~ mask pd_bits)" in exI, simp)
-       apply (simp add: range_composition[symmetric])
-       apply (rule_tac x="ucast (y >> 3)" in range_eqI)
-       apply (simp add: pt_bits_def pageBits_def bit_simps)
-       apply (simp add: word_size ucast_ucast_mask and_mask_shiftl_comm)
-    using pspace_aligned'
-       apply (simp add: pspace_aligned'_def dom_def)
-       apply (erule_tac x=y in allE)
-       apply (simp add: objBitsKO_def archObjSize_def is_aligned_neg_mask_eq
-        and_not_mask[symmetric] AND_NOT_mask_plus_AND_mask_eq)
-    using fst_pdpte
+       apply (rule_tac x=y in exI)
+       apply (clarsimp split: asidpool.splits)
+      using fst_pte
       apply (erule_tac x=y in allE)
       apply (clarsimp split: if_split_asm)
-      apply (rule_tac x="(y && ~~ mask pdpt_bits)" in exI, simp)
+      apply (rule_tac x="(y && ~~ mask pt_bits)" in exI, simp)
       apply (simp add: range_composition[symmetric])
       apply (rule_tac x="ucast (y >> 3)" in range_eqI)
-      apply (simp add: pt_bits_def pageBits_def bit_simps)
+      apply (simp add: pt_bits_def bit_simps)
       apply (simp add: word_size ucast_ucast_mask and_mask_shiftl_comm)
-    using pspace_aligned'
+      using pspace_aligned'
       apply (simp add: pspace_aligned'_def dom_def)
       apply (erule_tac x=y in allE)
-      apply (simp add: objBitsKO_def archObjSize_def is_aligned_neg_mask_eq
-        and_not_mask[symmetric] AND_NOT_mask_plus_AND_mask_eq)
-    using fst_pml4e
+      apply (simp add: objBitsKO_def archObjSize_def
+                       and_not_mask[symmetric] AND_NOT_mask_plus_AND_mask_eq)
+     using fst_pde
      apply (erule_tac x=y in allE)
      apply (clarsimp split: if_split_asm)
-     apply (rule_tac x="(y && ~~ mask pml4_bits)" in exI, simp)
+     apply (rule_tac x="(y && ~~ mask pd_bits)" in exI, simp)
      apply (simp add: range_composition[symmetric])
      apply (rule_tac x="ucast (y >> 3)" in range_eqI)
-     apply (simp add: pt_bits_def pageBits_def bit_simps)
+     apply (simp add: pt_bits_def bit_simps)
      apply (simp add: word_size ucast_ucast_mask and_mask_shiftl_comm)
-    using pspace_aligned'
+     using pspace_aligned'
      apply (simp add: pspace_aligned'_def dom_def)
      apply (erule_tac x=y in allE)
-     apply (simp add: objBitsKO_def archObjSize_def is_aligned_neg_mask_eq
-        and_not_mask[symmetric] AND_NOT_mask_plus_AND_mask_eq)
-    apply (simp split: option.splits Structures_H.kernel_object.splits)
+     apply (simp add: objBitsKO_def archObjSize_def
+                      and_not_mask[symmetric] AND_NOT_mask_plus_AND_mask_eq)
+    using fst_pdpte
+    apply (erule_tac x=y in allE)
+    apply (clarsimp split: if_split_asm)
+    apply (rule_tac x="(y && ~~ mask pdpt_bits)" in exI, simp)
+    apply (simp add: range_composition[symmetric])
+    apply (rule_tac x="ucast (y >> 3)" in range_eqI)
+    apply (simp add: pt_bits_def bit_simps)
+    apply (simp add: word_size ucast_ucast_mask and_mask_shiftl_comm)
+    using pspace_aligned'
+    apply (simp add: pspace_aligned'_def dom_def)
+    apply (erule_tac x=y in allE)
+    apply (simp add: objBitsKO_def archObjSize_def
+                     and_not_mask[symmetric] AND_NOT_mask_plus_AND_mask_eq)
+   using fst_pml4e
+   apply (erule_tac x=y in allE)
+   apply (clarsimp split: if_split_asm)
+   apply (rule_tac x="y && ~~ mask pml4_bits" in exI, simp)
+   apply (simp add: range_composition[symmetric])
+   apply (rule_tac x="ucast (y >> 3)" in range_eqI)
+   apply (simp add: pt_bits_def bit_simps)
+   apply (simp add: word_size ucast_ucast_mask and_mask_shiftl_comm)
+   using pspace_aligned'
+   apply (simp add: pspace_aligned'_def dom_def)
+   apply (erule_tac x=y in allE)
+   apply (simp add: objBitsKO_def archObjSize_def
+                    and_not_mask[symmetric] AND_NOT_mask_plus_AND_mask_eq)
+  apply (simp split: option.splits Structures_H.kernel_object.splits)
   apply (intro allI)
   apply (intro impI)
   apply (elim exE)
@@ -305,56 +305,56 @@ lemma
   apply (simp add: absHeapArch_def)
   apply (rename_tac arch_kernel_object z a b)
   apply (case_tac arch_kernel_object)
-    apply (clarsimp split: asidpool.splits)
-    apply (simp add: other_obj_relation_def asid_pool_relation_def o_def inv_def)
-   apply simp
-   apply (clarsimp simp: pte_relation_def
-                  split: if_split_asm)
-   using ptes
-   apply (erule_tac x=x in allE)
-   apply simp
-   apply (erule_tac x=y in allE)
-   apply (clarsimp simp: bit_simps)
-   apply (simp add: absPageTable_def  split: option.splits X64_H.pte.splits)
-   apply (clarsimp simp add:  vmrights_map_def vm_rights_of_def
-              vm_kernel_only_def vm_read_only_def vm_read_write_def
-            split: vmrights.splits)
-   apply simp
-   apply (clarsimp simp: pde_relation_def
-                  split: if_split_asm)
-   using pdes
-   apply (erule_tac x=x in allE)
-   apply simp
-   apply (erule_tac x=y in allE)
-   apply (clarsimp simp: bit_simps)
-   apply (simp add: absPageDirectory_def  split: option.splits X64_H.pde.splits)
-   apply (clarsimp simp add:  vmrights_map_def vm_rights_of_def
-              vm_kernel_only_def vm_read_only_def vm_read_write_def
-            split: vmrights.splits)
-   apply simp
-   apply (clarsimp simp: pdpte_relation_def
-                  split: if_split_asm)
-   using pdptes
-   apply (erule_tac x=x in allE)
-   apply simp
-   apply (erule_tac x=y in allE)
-   apply (clarsimp simp: bit_simps)
-   apply (simp add: absPDPT_def  split: option.splits X64_H.pdpte.splits)
-   apply (clarsimp simp add:  vmrights_map_def vm_rights_of_def
-              vm_kernel_only_def vm_read_only_def vm_read_write_def
-            split: vmrights.splits)
-   apply simp
-   apply (clarsimp simp: pml4e_relation_def
-                  split: if_split_asm)
-   using pml4es
-   apply (erule_tac x=x in allE)
-   apply simp
-   apply (erule_tac x=y in allE)
-   apply (clarsimp simp: bit_simps)
-   apply (simp add: absPML4_def  split: option.splits X64_H.pml4e.splits)
-   apply (clarsimp simp add:  vmrights_map_def vm_rights_of_def
-              vm_kernel_only_def vm_read_only_def vm_read_write_def
-            split: vmrights.splits)
+      apply (clarsimp split: asidpool.splits)
+      apply (simp add: other_obj_relation_def asid_pool_relation_def o_def inv_def)
+     apply simp
+     apply (clarsimp simp: pte_relation_def
+                    split: if_split_asm)
+     using ptes
+     apply (erule_tac x=x in allE)
+     apply simp
+     apply (erule_tac x=y in allE)
+     apply (clarsimp simp: bit_simps)
+     apply (simp add: absPageTable_def  split: option.splits X64_H.pte.splits)
+     apply (clarsimp simp add:  vmrights_map_def vm_rights_of_def
+                vm_kernel_only_def vm_read_only_def vm_read_write_def
+              split: vmrights.splits)
+    apply simp
+    apply (clarsimp simp: pde_relation_def
+                   split: if_split_asm)
+    using pdes
+    apply (erule_tac x=x in allE)
+    apply simp
+    apply (erule_tac x=y in allE)
+    apply (clarsimp simp: bit_simps)
+    apply (simp add: absPageDirectory_def  split: option.splits X64_H.pde.splits)
+    apply (clarsimp simp add:  vmrights_map_def vm_rights_of_def
+               vm_kernel_only_def vm_read_only_def vm_read_write_def
+             split: vmrights.splits)
+  apply simp
+  apply (clarsimp simp: pdpte_relation_def
+                 split: if_split_asm)
+  using pdptes
+  apply (erule_tac x=x in allE)
+  apply simp
+  apply (erule_tac x=y in allE)
+  apply (clarsimp simp: bit_simps)
+  apply (simp add: absPDPT_def  split: option.splits X64_H.pdpte.splits)
+  apply (clarsimp simp add:  vmrights_map_def vm_rights_of_def
+             vm_kernel_only_def vm_read_only_def vm_read_write_def
+           split: vmrights.splits)
+  apply simp
+  apply (clarsimp simp: pml4e_relation_def
+                 split: if_split_asm)
+  using pml4es
+  apply (erule_tac x=x in allE)
+  apply simp
+  apply (erule_tac x=y in allE)
+  apply (clarsimp simp: bit_simps)
+  apply (simp add: absPML4_def  split: option.splits X64_H.pml4e.splits)
+  apply (clarsimp simp add:  vmrights_map_def vm_rights_of_def
+             vm_kernel_only_def vm_read_only_def vm_read_write_def
+           split: vmrights.splits)
   done
 
 definition
@@ -673,13 +673,12 @@ 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 add: 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)
@@ -691,97 +690,72 @@ proof -
          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 add: 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 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_all add: image_def)
-          apply (erule_tac x=0 in allE, simp)
          apply (erule_tac x=0 in allE, simp)
         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: bit_simps)
-      apply (rename_tac vmpage_size)
-      apply (case_tac vmpage_size, simp_all add: bit_simps)
+      apply (erule_tac x=0 in allE, simp)
+     apply clarsimp
+     apply (erule_tac x=0 in allE, simp add: bit_simps)
+     apply (rename_tac vmpage_size)
+     apply (case_tac vmpage_size, simp_all add: bit_simps)
 
     apply clarsimp
     apply (intro conjI impI allI)
            apply (erule pspace_dom_relatedE[OF _ pspace_relation])
            apply clarsimp
            apply (case_tac ko, simp_all add: other_obj_relation_def)
-             apply (clarsimp simp add: cte_relation_def split: if_split_asm)
+              apply (clarsimp simp add: cte_relation_def split: if_split_asm)
+             apply (clarsimp simp: tcb_relation_cut_def)
             apply (clarsimp simp add: ep_relation_def EndpointMap_def
-                     split: Structures_A.endpoint.splits)
+                            split: Structures_A.endpoint.splits)
            apply (clarsimp simp add: EndpointMap_def
-                    split: Structures_A.endpoint.splits)
+                           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 simp add: pdpte_relation_def)
-             apply (clarsimp simp add: pml4e_relation_def)
-            apply (clarsimp split: if_split_asm)+
+               apply (clarsimp simp add: pte_relation_def)
+              apply (clarsimp simp add: pde_relation_def)
+             apply (clarsimp simp add: pdpte_relation_def)
+            apply (clarsimp simp add: pml4e_relation_def)
+           apply (clarsimp split: if_split_asm)+
 
           apply (erule pspace_dom_relatedE[OF _ pspace_relation])
           apply (case_tac ko, simp_all add: other_obj_relation_def)
-            apply (clarsimp simp add: cte_relation_def split: if_split_asm)
+             apply (clarsimp simp add: cte_relation_def split: if_split_asm)
+            apply (clarsimp simp: tcb_relation_cut_def)
            apply (clarsimp simp add: ntfn_relation_def AEndpointMap_def
-                    split: Structures_A.ntfn.splits)
+                           split: Structures_A.ntfn.splits)
           apply (clarsimp simp add: AEndpointMap_def
-                   split: Structures_A.ntfn.splits)
+                          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 simp add: pdpte_relation_def)
-            apply (clarsimp simp add: pml4e_relation_def)
-           apply (clarsimp split: if_split_asm)+
-
-         apply (erule pspace_dom_relatedE[OF _ pspace_relation])
-         apply (case_tac ko, simp_all add: 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 simp add: pdpte_relation_def)
            apply (clarsimp simp add: pml4e_relation_def)
           apply (clarsimp split: if_split_asm)+
 
-        apply (erule pspace_dom_relatedE[OF _ pspace_relation])
-        apply (case_tac ko, simp_all add: 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 (erule pspace_dom_relatedE[OF _ pspace_relation])
+         apply (case_tac ko, simp_all add: other_obj_relation_def)
+           apply (clarsimp simp add: cte_relation_def split: if_split_asm)
+          apply (clarsimp simp: tcb_relation_cut_def)
+         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 simp add: pdpte_relation_def)
           apply (clarsimp simp add: pml4e_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 (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 add: bit_simps)
-           apply ((frule_tac i=n and k="0x1000" in word_mult_less_mono1, simp+)+)[4]
+         apply (clarsimp split: if_split_asm)+
+
         apply (erule pspace_dom_relatedE[OF _ pspace_relation])
         apply (case_tac ko, simp_all add: other_obj_relation_def)
-         apply (clarsimp simp add: cte_relation_def split: if_split_asm)
+          apply (clarsimp simp add: cte_relation_def split: if_split_asm)
+         apply (clarsimp simp: tcb_relation_cut_def)
         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)
@@ -793,241 +767,261 @@ proof -
         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])
+         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 (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 (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 bit_simps)
-        apply (case_tac vmpage_size; simp add: bit_simps)
+         apply (clarsimp simp add: pageBits_def mask_def )
+         apply (case_tac vmpage_size; simp add: bit_simps)
           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: 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 simp add: pdpte_relation_def)
-            apply (clarsimp simp add: pml4e_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
-        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 (clarsimp simp: tcb_relation_cut_def)
+       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 simp add: pdpte_relation_def)
+        apply (clarsimp simp add: pml4e_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 pspace_aligned)
        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 (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: mask_def bit_simps)
+        apply (case_tac vmpage_size; simp add: bit_simps)
+         apply ((frule_tac k="0x1000" in word_mult_less_mono1, simp+)+)[4]
       apply (erule pspace_dom_relatedE[OF _ pspace_relation])
-      apply (case_tac ko, simp_all add: other_obj_relation_def
-                                 split: if_split_asm)
+      apply (case_tac ko, simp_all add: other_obj_relation_def)
+        apply (clarsimp simp add: cte_relation_def split: if_split_asm)
+       apply (clarsimp simp: tcb_relation_cut_def)
        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 simp add: pdpte_relation_def)
-          apply (clarsimp simp add: pml4e_relation_def)
+           apply (clarsimp simp add: pte_relation_def)
+          apply (clarsimp simp add: pde_relation_def)
+         apply (clarsimp simp add: pdpte_relation_def)
+        apply (clarsimp simp add: pml4e_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::machine_word) * 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 objBits_defs)+
-      apply (subgoal_tac "kheap s (y + of_bl ya * 2^cte_level_bits) = None")
+      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
+       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 (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: other_obj_relation_def
+                                split: if_split_asm)
+       prefer 2
+       apply (clarsimp simp: tcb_relation_cut_def)
+      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 simp add: pdpte_relation_def)
+       apply (clarsimp simp add: pml4e_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::machine_word) * 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)
-       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 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 objBits_defs)+
+     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: other_obj_relation_def)
-     apply (clarsimp simp add: cte_relation_def split: if_split_asm)
+      apply (clarsimp simp add: cte_relation_def split: if_split_asm)
+     apply (clarsimp simp: tcb_relation_cut_def)
     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)
+                                                 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 simp add: pdpte_relation_def)
+         apply (clarsimp simp add: pml4e_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 bit_simps)
+           apply (rule conjI)
+            prefer 2
+            apply clarsimp
+            apply (rule sym)
+            apply (rule pspace_aligned_distinct_None' [OF pspace_aligned pspace_distinct],
+                   (simp add: bit_simps)+)
+            apply (cut_tac x=ya and n="2^12" in
+                   ucast_less_shiftl_helper'[where 'a=machine_word_len and a=3,simplified word_bits_conv], simp+)
+            apply (clarsimp simp add: word_gt_0)
+           apply clarsimp
+           apply (subgoal_tac "ucast ya << 3 = 0")
+            prefer 2
+            apply (rule ccontr)
+            apply (frule_tac x=y in unaligned_helper, assumption)
+             apply (rule ucast_less_shiftl_helper'[where a=3], 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: pte_relation_def word_size_bits_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:)[1]
+           apply (clarsimp split: X64_A.pte.splits)
+           apply (rule set_eqI, clarsimp)
+           apply (case_tac x, simp_all)[1]
+           apply (clarsimp split: X64_A.pte.splits)
+           apply (case_tac x1, simp_all)[1]
+          apply (clarsimp simp add: pde_relation_def)
+         apply (clarsimp simp add: pdpte_relation_def)
+        apply (clarsimp simp: pml4e_relation_def)
+       apply (clarsimp split: if_split_asm)+
 
-      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 simp add: pdpte_relation_def)
-           apply (clarsimp simp add: pml4e_relation_def)
+           apply (simp add: other_obj_relation_def asid_pool_relation_def inv_def o_def)
+          apply (clarsimp simp: pte_relation_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 bit_simps)
+         apply (rule conjI)
+          prefer 2
+          apply clarsimp
+          apply (rule sym)
+          apply (rule pspace_aligned_distinct_None'[OF pspace_aligned pspace_distinct],
+                 (simp add: bit_simps)+)
+          apply (cut_tac x=ya and n="2^12" in
+                 ucast_less_shiftl_helper'[where 'a=machine_word_len and a=3,simplified word_bits_conv], simp+)
+          apply (clarsimp simp add: word_gt_0)
+         apply clarsimp
+         apply (subgoal_tac "ucast ya << 3 = 0")
+          prefer 2
+          apply (rule ccontr)
+          apply (frule_tac x=y in unaligned_helper, assumption)
+           apply (rule ucast_less_shiftl_helper'[where a=3], 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 word_size_bits_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:)[1]
+          apply (clarsimp split: X64_A.pde.splits)
+          apply (rule set_eqI, clarsimp)
+          apply (case_tac x, simp_all)[1]
+         apply (clarsimp split: X64_A.pde.splits)
+         apply (rule set_eqI, clarsimp)
+         apply (case_tac x, simp_all)[1]
+         apply (case_tac x1, simp_all)[1]
+        apply (clarsimp simp add: pdpte_relation_def)
+       apply (clarsimp simp: pml4e_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
-                                 bit_simps)
-       apply (rule conjI)
-        prefer 2
-        apply clarsimp
-        apply (rule sym)
-        apply (rule pspace_aligned_distinct_None'
-                    [OF pspace_aligned pspace_distinct], (simp add: bit_simps)+)
-        apply (cut_tac x=ya and n="2^12" in
-               ucast_less_shiftl_helper'[where 'a=machine_word_len and a=3,simplified word_bits_conv], simp+)
-        apply (clarsimp simp add: word_gt_0)
-       apply clarsimp
-       apply (subgoal_tac "ucast ya << 3 = 0")
-        prefer 2
-        apply (rule ccontr)
-        apply (frule_tac x=y in unaligned_helper, assumption)
-         apply (rule ucast_less_shiftl_helper'[where a=3], 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: pte_relation_def word_size_bits_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:)[1]
-        apply (clarsimp split: X64_A.pte.splits)
-        apply (rule set_eqI, clarsimp)
-        apply (case_tac x, simp_all)[1]
-       apply (clarsimp split: X64_A.pte.splits)
-       apply (case_tac x1, simp_all)[1]
-      apply (clarsimp simp add: pde_relation_def)
-apply (clarsimp simp add: pdpte_relation_def)
-apply (clarsimp simp: pml4e_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: pte_relation_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
-                                 bit_simps)
-       apply (rule conjI)
-        prefer 2
-        apply clarsimp
-        apply (rule sym)
-        apply (rule pspace_aligned_distinct_None'
-                    [OF pspace_aligned pspace_distinct], (simp add: bit_simps)+)
-        apply (cut_tac x=ya and n="2^12" in
-               ucast_less_shiftl_helper'[where 'a=machine_word_len and a=3,simplified word_bits_conv], simp+)
-        apply (clarsimp simp add: word_gt_0)
-       apply clarsimp
-       apply (subgoal_tac "ucast ya << 3 = 0")
-        prefer 2
-        apply (rule ccontr)
-        apply (frule_tac x=y in unaligned_helper, assumption)
-         apply (rule ucast_less_shiftl_helper'[where a=3], 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 word_size_bits_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:)[1]
-        apply (clarsimp split: X64_A.pde.splits)
-        apply (rule set_eqI, clarsimp)
-        apply (case_tac x, simp_all)[1]
-       apply (clarsimp split: X64_A.pde.splits)
-apply (rule set_eqI, clarsimp)
-       apply (case_tac x, simp_all)[1]
-apply (case_tac x1, simp_all)[1]
-apply (clarsimp simp add: pdpte_relation_def)
-apply (clarsimp simp: pml4e_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: pte_relation_def)
-apply (clarsimp simp: pde_relation_def)
+          apply (simp add: other_obj_relation_def asid_pool_relation_def inv_def o_def)
+         apply (clarsimp simp: pte_relation_def)
+        apply (clarsimp simp: pde_relation_def)
        using pspace_aligned[simplified pspace_aligned_def Ball_def dom_def]
        apply (erule_tac x=y in allE)
-       apply (clarsimp simp add: pdpte_relation_def absPDPT_def
-                                 bit_simps)
+       apply (clarsimp simp add: pdpte_relation_def absPDPT_def bit_simps)
        apply (rule conjI)
         prefer 2
         apply clarsimp
         apply (rule sym)
-        apply (rule pspace_aligned_distinct_None'
-                    [OF pspace_aligned pspace_distinct], (simp add: bit_simps)+)
+        apply (rule pspace_aligned_distinct_None'[OF pspace_aligned pspace_distinct],
+               (simp add: bit_simps)+)
         apply (cut_tac x=ya and n="2^12" in
                ucast_less_shiftl_helper'[where 'a=machine_word_len and a=3,simplified word_bits_conv], simp+)
         apply (clarsimp simp add: word_gt_0)
@@ -1042,8 +1036,7 @@ apply (clarsimp simp: pde_relation_def)
        apply simp
        apply (erule_tac x=offs in allE)
        apply (clarsimp simp add: pdpte_relation_def word_size_bits_def)
-       using valid_objs[simplified valid_objs_def fun_app_def dom_def,
-                        simplified]
+       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_pdpte_def)
        apply (erule_tac x=offs in allE)
@@ -1053,55 +1046,52 @@ apply (clarsimp simp: pde_relation_def)
         apply (rule set_eqI, clarsimp)
         apply (case_tac x, simp_all)[1]
        apply (clarsimp split: X64_A.pdpte.splits)
-apply (rule set_eqI, clarsimp)
+       apply (rule set_eqI, clarsimp)
        apply (case_tac x, simp_all)[1]
-apply (case_tac x1, simp_all)[1]
-apply (clarsimp simp: pml4e_relation_def)
+       apply (case_tac x1, simp_all)[1]
+      apply (clarsimp simp: pml4e_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: pte_relation_def)
-apply (clarsimp simp: pde_relation_def)
-apply (clarsimp simp: pdpte_relation_def)
-       using pspace_aligned[simplified pspace_aligned_def Ball_def dom_def]
-       apply (erule_tac x=y in allE)
-       apply (clarsimp simp add: pml4e_relation_def absPML4_def
-                                 bit_simps)
-       apply (rule conjI)
-        prefer 2
-        apply clarsimp
-        apply (rule sym)
-        apply (rule pspace_aligned_distinct_None'
-                    [OF pspace_aligned pspace_distinct], (simp add: bit_simps)+)
-        apply (cut_tac x=ya and n="2^12" in
-               ucast_less_shiftl_helper'[where 'a=machine_word_len and a=3,simplified word_bits_conv], simp+)
-        apply (clarsimp simp add: word_gt_0)
-       apply clarsimp
-       apply (subgoal_tac "ucast ya << 3 = 0")
-        prefer 2
-        apply (rule ccontr)
-        apply (frule_tac x=y in unaligned_helper, assumption)
-         apply (rule ucast_less_shiftl_helper'[where a=3], 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: pml4e_relation_def word_size_bits_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_pml4e_def)
-       apply (erule_tac x=offs in allE)
-       apply (rename_tac pml4e')
-       apply (case_tac pml4e', simp_all add:)[1]
-apply (case_tac "pd offs", simp_all)[1]
-        apply (clarsimp split: X64_A.pml4e.splits)
-        apply (rule set_eqI, clarsimp)
-        apply (case_tac x, simp_all)[1]
-     apply (clarsimp split: if_split_asm)+
-done
+    apply (case_tac arch_kernel_obj)
+         apply (simp add: other_obj_relation_def asid_pool_relation_def inv_def o_def)
+        apply (clarsimp simp: pte_relation_def)
+       apply (clarsimp simp: pde_relation_def)
+      apply (clarsimp simp: pdpte_relation_def)
+     using pspace_aligned[simplified pspace_aligned_def Ball_def dom_def]
+     apply (erule_tac x=y in allE)
+     apply (clarsimp simp add: pml4e_relation_def absPML4_def bit_simps)
+     apply (rule conjI)
+      prefer 2
+      apply clarsimp
+      apply (rule sym)
+      apply (rule pspace_aligned_distinct_None'[OF pspace_aligned pspace_distinct],
+             (simp add: bit_simps)+)
+      apply (cut_tac x=ya and n="2^12" in
+             ucast_less_shiftl_helper'[where 'a=machine_word_len and a=3,simplified word_bits_conv], simp+)
+      apply (clarsimp simp add: word_gt_0)
+     apply clarsimp
+     apply (subgoal_tac "ucast ya << 3 = 0")
+      prefer 2
+      apply (rule ccontr)
+      apply (frule_tac x=y in unaligned_helper, assumption)
+       apply (rule ucast_less_shiftl_helper'[where a=3], 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: pml4e_relation_def word_size_bits_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_pml4e_def)
+     apply (erule_tac x=offs in allE)
+     apply (rename_tac pml4e')
+     apply (case_tac pml4e', simp_all add:)[1]
+     apply (case_tac "pd offs", simp_all)[1]
+     apply (clarsimp split: X64_A.pml4e.splits)
+     apply (rule set_eqI, clarsimp)
+     apply (case_tac x, simp_all)[1]
+    apply (clarsimp split: if_split_asm)+
+    done
 qed
 
 definition
@@ -1136,14 +1126,14 @@ shows
    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 (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 (rename_tac ko)
    apply clarsimp
-   apply (case_tac a, simp_all add: other_obj_relation_def)
+   apply (case_tac ko; simp add: other_obj_relation_def tcb_relation_cut_def)
   apply (insert pspace_relation)
   apply (clarsimp simp: obj_at'_def projectKOs)
   apply (erule(1) pspace_dom_relatedE)
@@ -1209,10 +1199,9 @@ lemma bin_to_bl_of_bl_eq:
 lemma TCB_implies_KOTCB:
   "\<lbrakk>pspace_relation (kheap s) (ksPSpace s'); kheap s a = Some (TCB tcb)\<rbrakk>
    \<Longrightarrow> \<exists>tcb'. ksPSpace s' a = Some (KOTCB tcb') \<and> tcb_relation tcb tcb'"
-  apply (clarsimp simp add: pspace_relation_def pspace_dom_def
-                            dom_def UNION_eq Collect_eq)
+  apply (clarsimp simp add: pspace_relation_def pspace_dom_def dom_def UNION_eq Collect_eq)
   apply (erule_tac x=a in allE)+
-  apply (clarsimp simp add: other_obj_relation_def
+  apply (clarsimp simp: other_obj_relation_def tcb_relation_cut_def
                   split: Structures_H.kernel_object.splits)
   apply (drule iffD1)
    apply (fastforce simp add: dom_def image_def)
@@ -1222,12 +1211,11 @@ 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_all)
-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)
+  apply (simp add: well_formed_cnode_n_def dom_def Collect_eq)
+  done
 
 lemma cteMap_correct:
   assumes rel:              "(s,s') \<in> state_relation"
@@ -2007,7 +1995,7 @@ definition
       domain_index_internal = ksDomScheduleIdx s,
       cur_domain_internal = ksCurDomain s,
       domain_time_internal = ksDomainTime s,
-      ready_queues_internal = curry (ksReadyQueues 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:
@@ -2015,12 +2003,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 absEkheap_correct
-                           absCDTList_correct[THEN fun_cong] state_relation_def invs_def valid_state_def
-                           ready_queues_relation_def invs'_def valid_state'_def
-                           valid_pspace_def valid_sched_def valid_pspace'_def curry_def fun_eq_iff)
-      apply (fastforce simp: absEkheap_correct)
+           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
 
 
diff --git a/proof/refine/X64/ArchAcc_R.thy b/proof/refine/X64/ArchAcc_R.thy
index df214412a0..8ac8caf411 100644
--- a/proof/refine/X64/ArchAcc_R.thy
+++ b/proof/refine/X64/ArchAcc_R.thy
@@ -70,16 +70,6 @@ lemma getObject_ASIDPool_corres:
   apply (clarsimp simp: other_obj_relation_def asid_pool_relation_def)
   done
 
-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 simp
-  done
-
 lemmas aligned_distinct_asid_pool_atI'
     = aligned_distinct_obj_atI'[where 'a=asidpool,
                                 simplified, OF _ _ _ refl]
@@ -595,8 +585,12 @@ lemma setObject_PD_corres:
    apply (drule(1) ekheap_kheap_dom)
    apply clarsimp
    apply (drule_tac x=p in bspec, erule domI)
-   apply (simp add: other_obj_relation_def
+   apply (simp add: other_obj_relation_def tcb_relation_cut_def
            split: Structures_A.kernel_object.splits)
+  apply (extract_conjunct \<open>match conclusion in "ready_queues_relation_2 _ _ _ _ _" \<Rightarrow> -\<close>)
+   apply (prop_tac "typ_at' (koTypeOf (injectKO pde')) p b")
+    apply (simp add: typ_at'_def ko_wp_at'_def)
+   apply (fastforce dest: tcbs_of'_non_tcb_update)
   apply (rule conjI)
    apply (clarsimp simp add: ghost_relation_def)
    apply (erule_tac x="p && ~~ mask pd_bits" in allE)+
@@ -680,12 +674,16 @@ lemma setObject_PT_corres:
    apply (drule(1) ekheap_kheap_dom)
    apply clarsimp
    apply (drule_tac x=p in bspec, erule domI)
-   apply (simp add: other_obj_relation_def
-           split: Structures_A.kernel_object.splits)
-  apply (rule conjI)
+   apply (simp add: other_obj_relation_def 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
+  apply (extract_conjunct \<open>match conclusion in "ready_queues_relation_2 _ _ _ _ _" \<Rightarrow> -\<close>)
+   apply (prop_tac "typ_at' (koTypeOf (injectKO pte')) p b")
+    apply (simp add: typ_at'_def ko_wp_at'_def)
+   subgoal by (fastforce dest: tcbs_of'_non_tcb_update)
   apply (simp add: map_to_ctes_upd_other)
   apply (simp add: fun_upd_def)
   apply (simp add: caps_of_state_after_update obj_at_def swp_cte_at_caps_of)
@@ -744,20 +742,21 @@ lemma setObject_PDPT_corres:
    apply (drule bspec, assumption)
    apply clarsimp
    apply (erule (1) obj_relation_cutsE)
+          apply simp
+         apply simp
+        apply clarsimp
        apply simp
+      apply (frule (1) pspace_alignedD)
+      apply (drule_tac p=x in pspace_alignedD, assumption)
       apply simp
-     apply clarsimp
-     apply (frule (1) pspace_alignedD)
-     apply (drule_tac p=x in pspace_alignedD, assumption)
-     apply simp
-     apply (drule mask_alignment_ugliness)
+      apply (drule mask_alignment_ugliness)
+         apply (simp add: pdpt_bits_def pageBits_def)
         apply (simp add: pdpt_bits_def pageBits_def)
-       apply (simp add: pdpt_bits_def pageBits_def)
-      apply clarsimp
-      apply (drule test_bit_size)
-      apply (clarsimp simp: word_size bit_simps)
-      apply arith
-     apply ((simp split: if_split_asm)+)[5]
+       apply clarsimp
+       apply (drule test_bit_size)
+       apply (clarsimp simp: word_size bit_simps)
+       apply arith
+      apply ((simp split: if_split_asm)+)[5]
    apply (simp add: other_obj_relation_def
                split: Structures_A.kernel_object.splits arch_kernel_obj.splits)
   apply (rule conjI)
@@ -765,8 +764,12 @@ lemma setObject_PDPT_corres:
    apply (drule(1) ekheap_kheap_dom)
    apply clarsimp
    apply (drule_tac x=p in bspec, erule domI)
-   apply (simp add: other_obj_relation_def
-           split: Structures_A.kernel_object.splits)
+   apply (simp add: other_obj_relation_def tcb_relation_cut_def
+               split: Structures_A.kernel_object.splits)
+  apply (extract_conjunct \<open>match conclusion in "ready_queues_relation_2 _ _ _ _ _" \<Rightarrow> -\<close>)
+   apply (prop_tac "typ_at' (koTypeOf (injectKO pdpte')) p b")
+    apply (simp add: typ_at'_def ko_wp_at'_def)
+   apply (fastforce dest: tcbs_of'_non_tcb_update)
   apply (rule conjI)
    apply (clarsimp simp add: ghost_relation_def)
    apply (erule_tac x="p && ~~ mask pdpt_bits" in allE)+
@@ -818,20 +821,21 @@ lemma setObject_PML4_corres:
     apply clarsimp
     apply (drule_tac x = x in spec)
     apply (clarsimp simp: pml4e_relation_def mask_pml4_bits_inner_beauty
-      dest!: more_pml4_inner_beauty)
+                    dest!: more_pml4_inner_beauty)
    apply (rule ballI)
    apply (drule (1) bspec)
    apply clarsimp
    apply (rule conjI)
     apply (clarsimp simp: pml4e_relation_def mask_pml4_bits_inner_beauty
-      dest!: more_pml4_inner_beauty)
+                    dest!: more_pml4_inner_beauty)
    apply clarsimp
    apply (drule bspec, assumption)
    apply clarsimp
    apply (erule (1) obj_relation_cutsE)
+          apply simp
          apply simp
         apply simp
-       apply clarsimp
+       apply simp
       apply simp
      apply (frule (1) pspace_alignedD)
      apply (drule_tac p=x in pspace_alignedD, assumption)
@@ -845,14 +849,18 @@ lemma setObject_PML4_corres:
       apply arith
      apply ((simp split: if_split_asm)+)[2]
    apply (simp add: other_obj_relation_def
-      split: Structures_A.kernel_object.splits arch_kernel_obj.splits)
+               split: Structures_A.kernel_object.splits arch_kernel_obj.splits)
   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: other_obj_relation_def
-      split: Structures_A.kernel_object.splits)
+   apply (simp add: other_obj_relation_def tcb_relation_cut_def
+               split: Structures_A.kernel_object.splits)
+  apply (extract_conjunct \<open>match conclusion in "ready_queues_relation_2 _ _ _ _ _" \<Rightarrow> -\<close>)
+   apply (prop_tac "typ_at' (koTypeOf (injectKO pml4e')) p b")
+    apply (simp add: typ_at'_def ko_wp_at'_def)
+   apply (fastforce dest: tcbs_of'_non_tcb_update)
   apply (rule conjI)
    apply (clarsimp simp add: ghost_relation_def)
    apply (erule_tac x="p && ~~ mask pml4_bits" in allE)+
diff --git a/proof/refine/X64/Arch_R.thy b/proof/refine/X64/Arch_R.thy
index 2693eef7a4..447128bf87 100644
--- a/proof/refine/X64/Arch_R.thy
+++ b/proof/refine/X64/Arch_R.thy
@@ -267,11 +267,10 @@ lemma performASIDControlInvocation_corres:
               deleteObjects_cte_wp_at'
               deleteObjects_null_filter[where p="makePoolParent i'"])
    apply (clarsimp simp:invs_mdb max_free_index_def invs_untyped_children)
-   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 (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)
@@ -344,7 +343,7 @@ lemma performASIDControlInvocation_corres:
      apply (simp add:pageBits_def)
     apply clarsimp
     apply (drule(1) cte_cap_in_untyped_range)
-         apply (fastforce simp:cte_wp_at_ctes_of)
+         apply (fastforce simp: cte_wp_at_ctes_of)
         apply assumption+
      apply fastforce
     apply simp
@@ -1374,8 +1373,7 @@ lemma performX64PortInvocation_corres:
     apply (strengthen invs_mdb'[mk_strg])
     apply (wpsimp wp: setIOPortMask_invs')
    apply (clarsimp simp: invs_valid_objs valid_arch_inv_def valid_iocontrol_inv_def cte_wp_at_caps_of_state)
-   apply (rule conjI, clarsimp)
-   apply (clarsimp simp: safe_parent_for_def safe_parent_for_arch_def)
+   apply (fastforce simp: safe_parent_for_def safe_parent_for_arch_def)
   apply (clarsimp simp: invs_pspace_distinct' invs_pspace_aligned' valid_arch_inv'_def ioport_control_inv_valid'_def
                         valid_cap'_def capAligned_def word_bits_def)
   apply (clarsimp simp: safe_parent_for'_def cte_wp_at_ctes_of)
@@ -2180,7 +2178,7 @@ lemma arch_performInvocation_invs':
    apply (drule_tac src=p in valid_ioports_issuedD'[OF invs_valid_ioports'])
     apply (fastforce simp: cteCaps_of_def)
    apply force
-  by (force simp: cteCaps_of_def ran_def valid_ioports'_simps dest!: invs_valid_ioports')
+  using ranD valid_ioports_issuedD' by fastforce
 
 end
 
diff --git a/proof/refine/X64/Bits_R.thy b/proof/refine/X64/Bits_R.thy
index 09b416edb4..b211aeaedd 100644
--- a/proof/refine/X64/Bits_R.thy
+++ b/proof/refine/X64/Bits_R.thy
@@ -77,6 +77,10 @@ lemma projectKO_tcb:
   "(projectKO_opt ko = Some t) = (ko = KOTCB t)"
   by (cases ko) (auto simp: projectKO_opts_defs)
 
+lemma tcb_of'_TCB[simp]:
+  "tcb_of' (KOTCB tcb) = Some tcb"
+  by (simp add: projectKO_tcb)
+
 lemma projectKO_cte:
   "(projectKO_opt ko = Some t) = (ko = KOCTE t)"
   by (cases ko) (auto simp: projectKO_opts_defs)
diff --git a/proof/refine/X64/CNodeInv_R.thy b/proof/refine/X64/CNodeInv_R.thy
index 7e73232588..753d210960 100644
--- a/proof/refine/X64/CNodeInv_R.thy
+++ b/proof/refine/X64/CNodeInv_R.thy
@@ -5116,7 +5116,6 @@ lemma cteSwap_urz[wp]:
 crunches cteSwap
   for valid_arch_state'[wp]: "valid_arch_state'"
   and irq_states'[wp]: "valid_irq_states'"
-  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"
@@ -5125,6 +5124,12 @@ crunches cteSwap
   and ct_not_inQ[wp]: "ct_not_inQ"
   and ksDomScheduleIdx [wp]: "\<lambda>s. P (ksDomScheduleIdx s)"
 
+crunches cteSwap
+  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: valid_bitmaps_lift)
+
 lemma cteSwap_invs'[wp]:
   "\<lbrace>invs' and valid_cap' c and valid_cap' c' and
     ex_cte_cap_to' c1 and ex_cte_cap_to' c2 and
@@ -5586,6 +5591,10 @@ lemma updateCap_untyped_ranges_zero_simple:
 crunch tcb_in_cur_domain'[wp]: updateCap "tcb_in_cur_domain' t"
   (wp: crunch_wps simp: crunch_simps rule: tcb_in_cur_domain'_lift)
 
+crunches updateCap
+  for valid_bitmaps[wp]: valid_bitmaps
+  (rule: valid_bitmaps_lift)
+
 lemma make_zombie_invs':
   "\<lbrace>\<lambda>s. invs' s \<and> s \<turnstile>' cap \<and>
     cte_wp_at' (\<lambda>cte. isFinal (cteCap cte) sl (cteCaps_of s)) sl s \<and>
@@ -5602,7 +5611,8 @@ lemma make_zombie_invs':
                             st_tcb_at' ((=) Inactive) p s
                              \<and> bound_tcb_at' ((=) None) p s
                              \<and> obj_at' (Not \<circ> tcbQueued) p s
-                             \<and> (\<forall>pr. p \<notin> set (ksReadyQueues s pr)))) sl s\<rbrace>
+                             \<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_state'_def valid_pspace'_def valid_mdb'_def
@@ -5639,7 +5649,9 @@ lemma make_zombie_invs':
    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_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
@@ -8652,7 +8664,7 @@ lemma cteMove_ioports' [wp]:
   apply (clarsimp simp add: modify_map_def split: if_split_asm dest!: weak_derived_cap_ioports')
   apply (rule conjI, clarsimp)
    apply (rule conjI, clarsimp)
-     apply (force simp: isCap_simps)
+    apply blast
    subgoal by ((auto | blast)+)
   apply clarsimp
   apply (rule conjI, clarsimp)
@@ -8717,6 +8729,15 @@ lemma cteMove_urz [wp]:
   apply auto
   done
 
+crunches updateMDB
+  for valid_bitmaps[wp]: valid_bitmaps
+  (rule: valid_bitmaps_lift)
+
+(* FIXME: arch_split *)
+lemma haskell_assert_inv:
+  "haskell_assert Q L \<lbrace>P\<rbrace>"
+  by wpsimp
+
 lemma cteMove_invs' [wp]:
   "\<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>
@@ -8794,6 +8815,10 @@ crunch ksDomSchedule[wp]: updateCap "\<lambda>s. P (ksDomSchedule s)"
 crunch ksDomScheduleIdx[wp]: updateCap "\<lambda>s. P (ksDomScheduleIdx s)"
 crunch ksDomainTime[wp]: updateCap "\<lambda>s. P (ksDomainTime s)"
 
+crunches updateCap
+  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 corres_null_cap_update:
   "cap_relation cap cap' \<Longrightarrow>
    corres dc (invs and cte_wp_at ((=) cap) slot)
diff --git a/proof/refine/X64/CSpace1_R.thy b/proof/refine/X64/CSpace1_R.thy
index 9d060788b7..0d4ab8deba 100644
--- a/proof/refine/X64/CSpace1_R.thy
+++ b/proof/refine/X64/CSpace1_R.thy
@@ -234,7 +234,7 @@ lemma pspace_relation_cte_wp_at:
    apply (clarsimp elim!: cte_wp_at_weakenE')
   apply clarsimp
   apply (drule(1) pspace_relation_absD)
-  apply (clarsimp simp: other_obj_relation_def)
+  apply (clarsimp simp: tcb_relation_cut_def)
   apply (simp split: kernel_object.split_asm)
   apply (drule(2) aligned_distinct_obj_atI'[where 'a=tcb])
    apply simp
@@ -1639,10 +1639,10 @@ lemma cte_map_pulls_tcb_to_abstract:
      \<Longrightarrow> \<exists>tcb'. kheap s x = Some (TCB tcb') \<and> tcb_relation tcb' tcb
                   \<and> (z = (x, tcb_cnode_index (unat ((y - x) >> cte_level_bits))))"
   apply (rule pspace_dom_relatedE, assumption+)
-  apply (erule(1) obj_relation_cutsE, simp_all split: if_split_asm)
-  apply (clarsimp simp: other_obj_relation_def
+  apply (erule(1) obj_relation_cutsE;
+         clarsimp simp: other_obj_relation_def
                  split: Structures_A.kernel_object.split_asm
-                        X64_A.arch_kernel_obj.split_asm)
+                        X64_A.arch_kernel_obj.split_asm if_split_asm)
   apply (drule tcb_cases_related2)
   apply clarsimp
   apply (frule(1) cte_wp_at_tcbI [OF _ _ TrueI, where t="(a, b)" for a b, simplified])
@@ -1658,8 +1658,7 @@ lemma pspace_relation_update_tcbs:
               del: dom_fun_upd)
   apply (erule conjE)
   apply (rule ballI, drule(1) bspec)
-  apply (rule conjI, simp add: other_obj_relation_def)
-  apply (clarsimp split: Structures_A.kernel_object.split_asm)
+  apply (clarsimp simp: tcb_relation_cut_def split: Structures_A.kernel_object.split_asm)
   apply (drule bspec, fastforce)
   apply clarsimp
   apply (erule(1) obj_relation_cutsE, simp_all split: if_split_asm)
@@ -1881,6 +1880,27 @@ lemma descendants_of_eq':
   apply simp
   done
 
+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
+
+lemma setObject_cte_tcbSchedNexts_of_use_valid_ksPSpace:
+  assumes step: "(x, s\<lparr>ksPSpace := ps\<rparr>) \<in> fst (setObject p (cte :: cte) s)"
+  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_inQ_of_use_valid_ksPSpace:
+  assumes step: "(x, s\<lparr>ksPSpace := ps\<rparr>) \<in> fst (setObject p (cte :: cte) s)"
+  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>
@@ -1894,7 +1914,12 @@ lemma updateCap_stuff:
          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'')" using assms
+         (pspace_distinct' s' \<longrightarrow> pspace_distinct' s'') \<and>
+         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)
@@ -1903,8 +1928,11 @@ lemma updateCap_stuff:
   apply (frule setCTE_pspace_only)
   apply (clarsimp simp: setCTE_def)
   apply (intro conjI impI)
-   apply (erule(1) use_valid [OF _ setObject_aligned])
-  apply (erule(1) use_valid [OF _ setObject_distinct])
+      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 *)
@@ -1921,16 +1949,15 @@ lemma pspace_relation_cte_wp_atI':
    apply (simp split: if_split_asm)
   apply (erule(1) pspace_dom_relatedE)
   apply (erule(1) obj_relation_cutsE, simp_all split: if_split_asm)
+   apply (subgoal_tac "n = x - y", clarsimp)
+    apply (drule tcb_cases_related2, clarsimp)
+    apply (intro exI, rule conjI)
+     apply (erule(1) cte_wp_at_tcbI[where t="(a, b)" for a b, simplified])
+     apply fastforce
+    apply simp
+   apply clarsimp
   apply (simp add: other_obj_relation_def
-            split: Structures_A.kernel_object.split_asm
-                   X64_A.arch_kernel_obj.split_asm)
-  apply (subgoal_tac "n = x - y", clarsimp)
-   apply (drule tcb_cases_related2, clarsimp)
-   apply (intro exI, rule conjI)
-    apply (erule(1) cte_wp_at_tcbI[where t="(a, b)" for a b, simplified])
-    apply fastforce
-   apply simp
-  apply clarsimp
+            split: Structures_A.kernel_object.split_asm X64_A.arch_kernel_obj.split_asm)
   done
 
 lemma pspace_relation_cte_wp_atI:
@@ -2453,7 +2480,7 @@ lemma updateCap_corres:
   apply (clarsimp simp: in_set_cap_cte_at_swp pspace_relations_def)
   apply (drule updateCap_stuff)
   apply simp
-  apply (rule conjI)
+  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 (rule conjI)
    prefer 2
@@ -2536,9 +2563,9 @@ lemma updateMDB_pspace_relation:
     apply (clarsimp simp: tcb_ctes_clear cte_level_bits_def objBits_defs)
    apply clarsimp
    apply (rule pspace_dom_relatedE, assumption+)
-   apply (rule obj_relation_cutsE, assumption+, simp_all split: if_split_asm)[1]
-   apply (clarsimp split: Structures_A.kernel_object.split_asm
-                          X64_A.arch_kernel_obj.split_asm
+   apply (rule obj_relation_cutsE, assumption+;
+          clarsimp split: Structures_A.kernel_object.split_asm
+                          X64_A.arch_kernel_obj.split_asm if_split_asm
                     simp: other_obj_relation_def)
    apply (frule(1) tcb_cte_cases_aligned_helpers(1))
    apply (frule(1) tcb_cte_cases_aligned_helpers(2))
@@ -2599,6 +2626,25 @@ lemma updateMDB_ctes_of:
 
 crunch aligned[wp]: updateMDB "pspace_aligned'"
 crunch pdistinct[wp]: updateMDB "pspace_distinct'"
+crunch tcbSchedPrevs_of[wp]: updateMDB "\<lambda>s. P (tcbSchedPrevs_of s)"
+crunch tcbSchedNexts_of[wp]: updateMDB "\<lambda>s. P (tcbSchedNexts_of s)"
+crunch inQ_opt_pred[wp]: updateMDB "\<lambda>s. P (inQ d p |< tcbs_of' s)"
+crunch inQ_opt_pred'[wp]: updateMDB "\<lambda>s. P (\<lambda>d p. inQ d p |< tcbs_of' s)"
+crunch ksReadyQueues[wp]: updateMDB "\<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
+
+crunches 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')"
@@ -2621,7 +2667,11 @@ lemma updateMDB_the_lot:
          ksDomScheduleIdx s'' = ksDomScheduleIdx s' \<and>
          ksDomSchedule s''    = ksDomSchedule s' \<and>
          ksCurDomain s''      = ksCurDomain s' \<and>
-         ksDomainTime s''     = ksDomainTime s'"
+         ksDomainTime s''     = ksDomainTime s' \<and>
+         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)
@@ -2630,9 +2680,8 @@ using assms
    apply (erule use_valid)
     apply wp
    apply simp
-  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 is_cap_revocable_eq:
@@ -3832,6 +3881,9 @@ lemma updateUntypedCap_descendants_of:
   apply (clarsimp simp:mdb_next_rel_def mdb_next_def split:if_splits)
   done
 
+crunches setCTE
+  for tcbQueued[wp]: "\<lambda>s. P (tcbQueued |< tcbs_of' s)"
+
 lemma setCTE_UntypedCap_corres:
   "\<lbrakk>cap_relation cap (cteCap cte); is_untyped_cap cap; idx' = idx\<rbrakk>
    \<Longrightarrow> corres dc (cte_wp_at ((=) cap) src and valid_objs and
@@ -3861,10 +3913,19 @@ lemma setCTE_UntypedCap_corres:
    apply assumption
   apply (clarsimp simp: pspace_relations_def)
   apply (subst conj_assoc[symmetric])
+  apply clarsimp
   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)
@@ -5216,11 +5277,15 @@ lemma updateMDB_the_lot':
          ksDomScheduleIdx s'' = ksDomScheduleIdx s' \<and>
          ksDomSchedule s''    = ksDomSchedule s' \<and>
          ksCurDomain s''      = ksCurDomain s' \<and>
-         ksDomainTime s''     = ksDomainTime s'"
+         ksDomainTime s''     = ksDomainTime s' \<and>
+         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
+   done
 
 lemma cte_map_inj_eq':
   "\<lbrakk>(cte_map p = cte_map p');
@@ -5321,7 +5386,6 @@ lemma cteInsert_corres:
             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 "ksReadyQueues t = p" for p t)+
             apply (thin_tac "ksSchedulerAction t = p" for p t)+
             apply (clarsimp simp: pspace_relations_def)
             apply (rule conjI)
diff --git a/proof/refine/X64/CSpace_R.thy b/proof/refine/X64/CSpace_R.thy
index 8917fedb54..4530c97081 100644
--- a/proof/refine/X64/CSpace_R.thy
+++ b/proof/refine/X64/CSpace_R.thy
@@ -1100,43 +1100,6 @@ lemma bitmapQ_no_L2_orphans_lift:
   apply (rule hoare_vcg_prop, assumption)
   done
 
-lemma valid_queues_lift_asm:
-  assumes tat1: "\<And>d p tcb. \<lbrace>obj_at' (inQ d p) tcb and Q \<rbrace> f \<lbrace>\<lambda>_. obj_at' (inQ d p) tcb\<rbrace>"
-  and     tat2: "\<And>tcb. \<lbrace>st_tcb_at' runnable' tcb and Q \<rbrace> f \<lbrace>\<lambda>_. st_tcb_at' runnable' tcb\<rbrace>"
-  and     prq: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueues s) \<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueues s)\<rbrace>"
-  and     prqL1: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueuesL1Bitmap s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueuesL1Bitmap s)\<rbrace>"
-  and     prqL2: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueuesL2Bitmap s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueuesL2Bitmap s)\<rbrace>"
-  shows   "\<lbrace>Invariants_H.valid_queues and Q\<rbrace> f \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  proof -
-    have tat:  "\<And>d p tcb. \<lbrace>obj_at' (inQ d p) tcb and st_tcb_at' runnable' tcb and Q\<rbrace> f
-                         \<lbrace>\<lambda>_. obj_at' (inQ d p) tcb and st_tcb_at' runnable' tcb\<rbrace>"
-      apply (rule hoare_chain [OF hoare_vcg_conj_lift [OF tat1 tat2]])
-       apply (fastforce)+
-       done
-    have tat_combined: "\<And>d p tcb. \<lbrace>obj_at' (inQ d p and runnable' \<circ> tcbState) tcb and Q\<rbrace> f
-                         \<lbrace>\<lambda>_. obj_at' (inQ d p and runnable' \<circ> tcbState) tcb\<rbrace>"
-      apply (rule hoare_chain [OF tat])
-       apply (fastforce simp add: obj_at'_and pred_tcb_at'_def o_def)+
-      done
-    show ?thesis unfolding valid_queues_def valid_queues_no_bitmap_def
-      by (wp tat_combined prq prqL1 prqL2 valid_bitmapQ_lift bitmapQ_no_L2_orphans_lift
-             bitmapQ_no_L1_orphans_lift hoare_vcg_all_lift hoare_vcg_conj_lift hoare_Ball_helper)
-         simp_all
-  qed
-
-lemmas valid_queues_lift = valid_queues_lift_asm[where Q="\<lambda>_. True", simplified]
-
-lemma valid_queues_lift':
-  assumes tat: "\<And>d p tcb. \<lbrace>\<lambda>s. \<not> obj_at' (inQ d p) tcb s\<rbrace> f \<lbrace>\<lambda>_ s. \<not> obj_at' (inQ d p) tcb s\<rbrace>"
-  and     prq: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueues s)\<rbrace>"
-  shows   "\<lbrace>valid_queues'\<rbrace> f \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  unfolding valid_queues'_def imp_conv_disj
-  by (wp hoare_vcg_all_lift hoare_vcg_disj_lift tat prq)
-
-lemma setCTE_norq [wp]:
-  "\<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace> setCTE ptr cte \<lbrace>\<lambda>r s. P (ksReadyQueues s) \<rbrace>"
-  by (clarsimp simp: valid_def dest!: setCTE_pspace_only)
-
 lemma setCTE_norqL1 [wp]:
   "\<lbrace>\<lambda>s. P (ksReadyQueuesL1Bitmap s)\<rbrace> setCTE ptr cte \<lbrace>\<lambda>r s. P (ksReadyQueuesL1Bitmap s) \<rbrace>"
   by (clarsimp simp: valid_def dest!: setCTE_pspace_only)
@@ -2883,12 +2846,6 @@ lemma setCTE_inQ[wp]:
    apply (simp_all add: inQ_def)
   done
 
-lemma setCTE_valid_queues'[wp]:
-  "\<lbrace>valid_queues'\<rbrace> setCTE p cte \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (simp only: valid_queues'_def imp_conv_disj)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-  done
-
 crunch inQ[wp]: cteInsert "\<lambda>s. P (obj_at' (inQ d p) t s)"
   (wp: crunch_wps)
 
@@ -3476,6 +3433,13 @@ crunch pspace_canonical'[wp]: cteInsert "pspace_canonical'"
 crunch pspace_in_kernel_mappings'[wp]: cteInsert "pspace_in_kernel_mappings'"
   (wp: crunch_wps)
 
+crunches cteInsert
+  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
   (\<lambda>s. src \<noteq> dest) and (\<lambda>s. cte_wp_at' (is_derived' (ctes_of s) src cap \<circ> cteCap) src s)
@@ -3485,9 +3449,9 @@ lemma cteInsert_invs:
   cteInsert cap src dest
   \<lbrace>\<lambda>rv. invs'\<rbrace>"
   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 CSpace_R.valid_queues_lift
-                    valid_irq_node_lift valid_queues_lift' irqs_masked_lift cteInsert_norq
-              simp: st_tcb_at'_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
 
@@ -3791,10 +3755,13 @@ lemma corres_caps_decomposition:
              "\<And>P. \<lbrace>\<lambda>s. P (new_ups' s)\<rbrace> g \<lbrace>\<lambda>rv s. P (gsUserPages s)\<rbrace>"
              "\<And>P. \<lbrace>\<lambda>s. P (new_cns s)\<rbrace> f \<lbrace>\<lambda>rv s. P (cns_of_heap (kheap s))\<rbrace>"
              "\<And>P. \<lbrace>\<lambda>s. P (new_cns' s)\<rbrace> g \<lbrace>\<lambda>rv s. P (gsCNodes s)\<rbrace>"
-             "\<And>P. \<lbrace>\<lambda>s. P (new_queues s)\<rbrace> f \<lbrace>\<lambda>rv s. P (ready_queues s)\<rbrace>"
+             "\<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_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>"
@@ -3810,7 +3777,9 @@ lemma corres_caps_decomposition:
              "\<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 (new_queues s) (new_rqs' s')"
+                       \<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>
@@ -3878,8 +3847,9 @@ proof -
     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 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 pspace_relations_def swp_cte_at))+
+    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
 
@@ -3991,7 +3961,7 @@ lemma create_reply_master_corres:
   apply clarsimp
   apply (rule corres_caps_decomposition)
                                  defer
-                                 apply (wp|simp)+
+                                 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)
@@ -4368,6 +4338,9 @@ crunches setupReplyMaster
   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]:
@@ -4410,7 +4383,8 @@ lemma setupReplyMaster_invs'[wp]:
   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 valid_queues_lift' hoare_vcg_disj_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
@@ -4687,8 +4661,8 @@ lemma arch_update_setCTE_invs:
   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_ioports'
-             setCTE_norq hoare_vcg_disj_lift untyped_ranges_zero_lift
+             setCTE_pred_tcb_at' irqs_masked_lift setCTE_ioports'
+             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)
@@ -6138,7 +6112,7 @@ lemma cteInsert_simple_invs:
   apply (rule hoare_pre)
    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' irqs_masked_lift
+             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
@@ -6277,6 +6251,21 @@ lemma arch_update_updateCap_invs:
   apply clarsimp
   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
@@ -6308,6 +6297,8 @@ lemma updateCap_same_master:
         apply 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
@@ -6538,8 +6529,9 @@ lemma updateFreeIndex_forward_invs':
        apply (simp add:updateCap_def)
        apply (wp setCTE_irq_handlers' getCTE_wp)
       apply (simp add:updateCap_def)
-      apply (wp irqs_masked_lift valid_queues_lift' cur_tcb_lift ct_idle_or_in_cur_domain'_lift
+      apply (wp irqs_masked_lift cur_tcb_lift ct_idle_or_in_cur_domain'_lift
                 hoare_vcg_disj_lift untyped_ranges_zero_lift getCTE_wp setCTE_ioports'
+                sym_heap_sched_pointers_lift valid_bitmaps_lift
                | wp (once) hoare_use_eq[where f="gsUntypedZeroRanges"]
                | simp add: getSlotCap_def)+
   apply (clarsimp simp: cte_wp_at_ctes_of fun_upd_def[symmetric])
diff --git a/proof/refine/X64/Detype_R.thy b/proof/refine/X64/Detype_R.thy
index dd12d81d99..fc2fc085ed 100644
--- a/proof/refine/X64/Detype_R.thy
+++ b/proof/refine/X64/Detype_R.thy
@@ -591,7 +591,6 @@ lemma sym_refs_ko_wp_atD:
 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 =
@@ -611,8 +610,9 @@ lemma valid_objs: "valid_objs' s'"
   and        pc: "pspace_canonical' s'"
   and       pkm: "pspace_in_kernel_mappings' s'"
   and        pd: "pspace_distinct' s'"
-  and        vq: "valid_queues s'"
-  and       vq': "valid_queues' s'"
+  and       vbm: "valid_bitmaps s'"
+  and sym_sched: "sym_heap_sched_pointers s'"
+  and       vsp: "valid_sched_pointers s'"
   and  sym_refs: "sym_refs (state_refs_of' s')"
   and    iflive: "if_live_then_nonz_cap' s'"
   and  ifunsafe: "if_unsafe_then_cap' s'"
@@ -838,7 +838,6 @@ lemma refs_notRange:
   apply (rule refs_of_live')
   apply clarsimp
   done
-
 end
 
 context begin interpretation Arch . (*FIXME: arch_split*)
@@ -904,6 +903,71 @@ crunches doMachineOp
   for deletionIsSafe_delete_locale[wp]: "deletionIsSafe_delete_locale base magnitude"
   (simp: deletionIsSafe_delete_locale_def)
 
+lemma detype_tcbSchedNexts_of:
+  "\<lbrakk>pspace_aligned' s'; pspace_distinct' 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) |> tcb_of' |> tcbSchedNext)
+       = tcbSchedNexts_of s'"
+  using pspace_alignedD' pspace_distinctD'
+  supply projectKOs[simp]
+  apply (clarsimp simp: opt_map_def)
+  apply (rule ext)
+  apply (rename_tac s)
+  apply (clarsimp simp: ko_wp_at'_def split: option.splits)
+  apply (drule_tac x=s in spec)
+  apply force
+  done
+
+lemma detype_tcbSchedPrevs_of:
+  "\<lbrakk>pspace_aligned' s'; pspace_distinct' 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) |> tcb_of' |> tcbSchedPrev)
+       = tcbSchedPrevs_of s'"
+  using pspace_alignedD' pspace_distinctD'
+  supply projectKOs[simp]
+  apply (clarsimp simp: opt_map_def)
+  apply (rule ext)
+  apply (rename_tac s)
+  apply (clarsimp simp: ko_wp_at'_def split: option.splits)
+  apply (drule_tac x=s in spec)
+  apply force
+  done
+
+lemma detype_inQ:
+  "\<lbrakk>pspace_aligned' s'; pspace_distinct' s'; \<forall>p. p \<in> S \<longrightarrow> \<not> ko_wp_at' live' p s'\<rbrakk>
+   \<Longrightarrow> \<forall>d p. (inQ d p |< ((\<lambda>x. if x \<in> S then None else ksPSpace s' x) |> tcb_of'))
+             = (inQ d p |< tcbs_of' s')"
+  using pspace_alignedD' pspace_distinctD'
+  supply projectKOs[simp]
+  apply (clarsimp simp: opt_map_def)
+  apply (rule ext)
+  apply (rename_tac s)
+  apply (clarsimp simp: inQ_def opt_pred_def ko_wp_at'_def split: option.splits)
+  apply (drule_tac x=s in spec)
+  apply force
+  done
+
+lemma detype_ready_queues_relation:
+  "\<lbrakk>pspace_aligned' s'; pspace_distinct' s';
+    \<forall>p. p \<in> {lower..upper} \<longrightarrow> \<not> ko_wp_at' live' p s';
+    ready_queues_relation s s'; upper = upper'\<rbrakk>
+   \<Longrightarrow> ready_queues_relation_2
+        (ready_queues (detype {lower..upper'} s))
+        (ksReadyQueues s')
+        ((\<lambda>x. if lower \<le> x \<and> x \<le> upper then None
+              else ksPSpace s' x) |>
+         tcb_of' |>
+         tcbSchedNext)
+        ((\<lambda>x. if lower \<le> x \<and> x \<le> upper then None
+              else ksPSpace s' x) |>
+         tcb_of' |>
+         tcbSchedPrev)
+        (\<lambda>d p. inQ d p |< ((\<lambda>x. if lower \<le> x \<and> x \<le> upper then None else ksPSpace s' x) |> tcb_of'))"
+  apply (clarsimp simp: detype_ext_def ready_queues_relation_def Let_def)
+  apply (frule (1) detype_tcbSchedNexts_of[where S="{lower..upper}"]; simp)
+  apply (frule (1) detype_tcbSchedPrevs_of[where S="{lower..upper}"]; simp)
+  apply (frule (1) detype_inQ[where S="{lower..upper}"]; simp)
+  apply (fastforce simp add: detype_def detype_ext_def)
+  done
+
 lemma deleteObjects_corres:
   "is_aligned base magnitude \<Longrightarrow> magnitude \<ge> 3 \<Longrightarrow>
    corres dc
@@ -924,32 +988,33 @@ lemma deleteObjects_corres:
   apply (rule corres_stateAssert_implied[where P'=\<top>, simplified])
    prefer 2
    apply clarsimp
-   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 p_assoc_help invs_valid_pspace)[1]
-   apply (simp add:valid_cap_simps)
+   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 (fastforce simp: sch_act_simple_def schact_is_rct_def state_relation_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: valid_cap_simps)
   apply (simp add: bind_assoc[symmetric] ksASIDMapSafe_def)
   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>
-           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
-         Q'="\<lambda>_ s. s \<turnstile>' capability.UntypedCap d base magnitude idx \<and>
-                        valid_pspace' s" in corres_underlying_split)
+                           (\<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>
+                           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
+                  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])
        apply (rule corres_split[OF _ cNodeNoPartialOverlap])
@@ -962,33 +1027,37 @@ lemma deleteObjects_corres:
     apply (simp add: valid_pspace'_def)
     apply (rule state_relation_null_filterE, assumption,
            simp_all add: pspace_aligned'_cut pspace_distinct'_cut)[1]
-           apply (simp add: detype_def, rule state.equality; simp add: detype_ext_def)
-          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 add: null_filter'_def
+                            map_to_ctes_delete[simplified field_simps])
          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 (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 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 (fastforce simp add: detype_def detype_ext_def intro!: ekheap_relation_detype)
+        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)
@@ -1001,13 +1070,31 @@ lemma deleteObjects_corres:
                     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':
+  "ko_wp_at' live' p s' \<or> p = idle_thread_ptr \<Longrightarrow> p \<notin> base_bits"
+  apply (case_tac "ko_wp_at' live' 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 invs_valid_idle'[OF invs])
+  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 mask_eq_exp_minus_1)
+  by fastforce
+
+lemma untyped_range_live_idle':
+  "p \<in> base_bits \<Longrightarrow> \<not> (ko_wp_at' live' p s' \<or> p = idle_thread_ptr)"
+  using live_idle_untyped_range' by blast
+
 lemma valid_obj':
-  "\<lbrakk> valid_obj' obj s'; ko_wp_at' ((=) obj) p s' \<rbrakk> \<Longrightarrow> valid_obj' obj state'"
+  "\<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 (rename_tac endpoint)
       apply (case_tac endpoint, simp_all add: valid_ep'_def)[1]
@@ -1034,10 +1121,23 @@ lemma valid_obj':
      apply (erule(2) cte_wp_at_tcbI')
       apply fastforce
      apply simp
-    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 (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])
@@ -1049,14 +1149,48 @@ lemma valid_obj':
       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 (rename_tac pde)
     apply (case_tac pde, simp_all add: valid_mapping'_def)
-   apply(rename_tac pdpte)
+   apply (rename_tac pdpte)
    apply (case_tac pdpte, simp_all add: valid_mapping'_def)
-  apply(rename_tac pml4e)
+  apply (rename_tac pml4e)
   apply (case_tac pml4e, simp_all add: valid_mapping'_def)
   done
 
+lemma tcbSchedNexts_of_pspace':
+  "\<lbrakk>pspace_aligned' s'; pspace_distinct' s'; pspace_distinct' state'\<rbrakk>
+   \<Longrightarrow> (pspace' |> tcb_of' |> tcbSchedNext) = tcbSchedNexts_of s'"
+  supply projectKOs[simp]
+  apply (rule ext)
+  apply (rename_tac p)
+  apply (case_tac "p \<in> base_bits")
+   apply (frule untyped_range_live_idle')
+   apply (clarsimp simp: opt_map_def)
+   apply (case_tac "ksPSpace s' p"; clarsimp)
+   apply (rename_tac obj)
+   apply (case_tac "tcb_of' obj"; clarsimp)
+   apply (clarsimp simp: ko_wp_at'_def obj_at'_def)
+   apply (fastforce simp: pspace_alignedD' pspace_distinctD')
+  apply (clarsimp simp: opt_map_def split: option.splits)
+  done
+
+lemma tcbSchedPrevs_of_pspace':
+  "\<lbrakk>pspace_aligned' s'; pspace_distinct' s'; pspace_distinct' state'\<rbrakk>
+   \<Longrightarrow> (pspace' |> tcb_of' |> tcbSchedPrev) = tcbSchedPrevs_of s'"
+  supply projectKOs[simp]
+  apply (rule ext)
+  apply (rename_tac p)
+  apply (case_tac "p \<in> base_bits")
+   apply (frule untyped_range_live_idle')
+   apply (clarsimp simp: opt_map_def)
+   apply (case_tac "ksPSpace s' p"; clarsimp)
+   apply (rename_tac obj)
+   apply (case_tac "tcb_of' obj"; clarsimp)
+   apply (clarsimp simp: ko_wp_at'_def obj_at'_def)
+   apply (fastforce simp: pspace_alignedD' pspace_distinctD')
+  apply (clarsimp simp: opt_map_def split: option.splits)
+  done
+
 lemma st_tcb:
   "\<And>P p. \<lbrakk> st_tcb_at' P p s'; \<not> P Inactive; \<not> P IdleThreadState \<rbrakk> \<Longrightarrow> st_tcb_at' P p state'"
   by (fastforce simp: pred_tcb_at'_def obj_at'_real_def projectKOs dest: live_notRange)
@@ -1269,17 +1403,18 @@ proof (simp add: invs'_def valid_state'_def valid_pspace'_def
   show "pspace_in_kernel_mappings' ?s" using pkm
     by (simp add: pspace_in_kernel_mappings'_def dom_def)
 
-  show "pspace_distinct' ?s" using pd
+  show pspace_distinct'_state': "pspace_distinct' ?s" using pd
     by (clarsimp simp add: pspace_distinct'_def ps_clear_def
                            dom_if_None Diff_Int_distrib)
 
-  show "valid_objs' ?s" using valid_objs
+  show "valid_objs' ?s" using valid_objs sym_sched
     apply (clarsimp simp: valid_objs'_def ran_def)
     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
+     apply (frule pspace_alignedD'[OF _ pa])
+     apply (frule pspace_distinctD'[OF _ pd])
+     apply (clarsimp simp: ko_wp_at'_def)
+    apply fastforce
     done
 
   from sym_refs show "sym_refs (state_refs_of' ?s)"
@@ -1291,19 +1426,6 @@ proof (simp add: invs'_def valid_state'_def valid_pspace'_def
     apply (simp add: refs_notRange[simplified] state_refs_ko_wp_at_eq)
     done
 
-  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)
-    done
-
-  from vq' show "valid_queues' ?s"
-    by (simp add: valid_queues'_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)
@@ -1579,6 +1701,20 @@ proof (simp add: invs'_def valid_state'_def valid_pspace'_def
     apply simp
     done
 
+  from vbm
+  show "valid_bitmaps state'"
+    by (simp add: valid_bitmaps_def bitmapQ_defs)
+
+  from sym_sched
+  show "sym_heap (pspace' |> tcb_of' |> tcbSchedNext) (pspace' |> tcb_of' |> tcbSchedPrev)"
+    using pa pd pspace_distinct'_state'
+    by (fastforce simp: tcbSchedNexts_of_pspace' tcbSchedPrevs_of_pspace')
+
+  from vsp show "valid_sched_pointers_2 (pspace' |> tcb_of' |> tcbSchedPrev)
+                                        (pspace' |> tcb_of' |> tcbSchedNext)
+                                        (tcbQueued |< (pspace' |> tcb_of'))"
+    by (clarsimp simp: valid_sched_pointers_def opt_pred_def opt_map_def)
+
 qed (clarsimp)
 
 lemma (in delete_locale) delete_ko_wp_at':
@@ -4925,7 +5061,6 @@ lemma createTCBs_tcb_at':
     apply simp
    apply simp
   apply (clarsimp simp: retype_obj_at_disj')
-  apply (clarsimp simp: projectKO_opt_tcb)
   apply (clarsimp simp: new_cap_addrs_def image_def)
   apply (drule_tac x = "unat x" in bspec)
    apply (simp add:objBits_simps' shiftl_t2n)
diff --git a/proof/refine/X64/EmptyFail_H.thy b/proof/refine/X64/EmptyFail_H.thy
index eddb896616..5bf5b76656 100644
--- a/proof/refine/X64/EmptyFail_H.thy
+++ b/proof/refine/X64/EmptyFail_H.thy
@@ -169,7 +169,7 @@ crunch (empty_fail) empty_fail[intro!, wp, simp]: setBoundNotification, setNotif
 
 crunch (empty_fail) empty_fail[intro!, wp, simp]:
   cancelIPC, setThreadState, tcbSchedDequeue, setupReplyMaster, isStopped, possibleSwitchTo, tcbSchedAppend
-(simp: Let_def)
+  (simp: Let_def wp: empty_fail_getObject)
 
 crunch (empty_fail) "_H_empty_fail"[intro!, wp, simp]: "ThreadDecls_H.suspend"
   (ignore_del: ThreadDecls_H.suspend)
diff --git a/proof/refine/X64/Finalise_R.thy b/proof/refine/X64/Finalise_R.thy
index bcf40bbbe1..de5d870e4d 100644
--- a/proof/refine/X64/Finalise_R.thy
+++ b/proof/refine/X64/Finalise_R.thy
@@ -80,20 +80,10 @@ crunch ksRQL1[wp]: emptySlot "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
 crunch ksRQL2[wp]: emptySlot "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
 crunch obj_at'[wp]: postCapDeletion "obj_at' P p"
 
-lemmas postCapDeletion_valid_queues[wp] =
-    valid_queues_lift [OF postCapDeletion_obj_at'
-                          postCapDeletion_pred_tcb_at'
-                          postCapDeletion_ksRQ]
-
 crunch inQ[wp]: clearUntypedFreeIndex "\<lambda>s. P (obj_at' (inQ d p) t s)"
 crunch tcbDomain[wp]: clearUntypedFreeIndex "obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t"
 crunch tcbPriority[wp]: clearUntypedFreeIndex "obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t"
 
-lemma emptySlot_queues [wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> emptySlot sl opt \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  unfolding emptySlot_def
-  by (wp | wpcw | wp valid_queues_lift | simp)+
-
 crunch nosch[wp]: emptySlot "\<lambda>s. P (ksSchedulerAction s)"
 crunch ksCurDomain[wp]: emptySlot "\<lambda>s. P (ksCurDomain s)"
 
@@ -1179,8 +1169,7 @@ definition
  "removeable' sl \<equiv> \<lambda>s cap.
     (\<exists>p. p \<noteq> sl \<and> cte_wp_at' (\<lambda>cte. capMasterCap (cteCap cte) = capMasterCap cap) p s)
     \<or> ((\<forall>p \<in> cte_refs' cap (irq_node' s). p \<noteq> sl \<longrightarrow> cte_wp_at' (\<lambda>cte. cteCap cte = NullCap) p s)
-         \<and> (\<forall>p \<in> zobj_refs' cap. ko_wp_at' (Not \<circ> live') p s)
-         \<and> (\<forall>t \<in> threadCapRefs cap. \<forall>p. t \<notin> set (ksReadyQueues s p)))"
+         \<and> (\<forall>p \<in> zobj_refs' cap. ko_wp_at' (Not \<circ> live') p s))"
 
 lemma not_Final_removeable:
   "\<not> isFinal cap sl (cteCaps_of s)
@@ -1484,11 +1473,6 @@ crunch irq_states' [wp]: emptySlot valid_irq_states'
 crunch no_0_obj' [wp]: emptySlot no_0_obj'
  (wp: crunch_wps)
 
-crunch valid_queues'[wp]: setInterruptState "valid_queues'"
-  (simp: valid_queues'_def)
-
-crunch valid_queues'[wp]: emptySlot "valid_queues'"
-
 end
 
 lemma deletedIRQHandler_irqs_masked'[wp]:
@@ -1594,6 +1578,13 @@ lemma emptySlot_valid_arch'[wp]:
   by (wpsimp simp: emptySlot_def cte_wp_at_ctes_of
                wp: getCTE_wp hoare_drop_imps hoare_vcg_ex_lift)
 
+crunches emptySlot
+  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> (info \<noteq> NullCap \<longrightarrow> post_cap_delete_pre' info sl (cteCaps_of s) )\<rbrace>
@@ -2420,6 +2411,14 @@ 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)
 
+crunches 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]:
   "\<lbrace>invs'\<rbrace> unbindNotification tcb \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (simp add: unbindNotification_def invs'_def valid_state'_def)
@@ -2428,8 +2427,8 @@ lemma unbindNotification_invs[wp]:
   apply clarsimp
   apply (rule hoare_seq_ext[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
+  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 (clarsimp elim!: obj_atE'
@@ -2471,7 +2470,7 @@ lemma unbindMaybeNotification_invs[wp]:
   apply (simp add: unbindMaybeNotification_def invs'_def valid_state'_def)
   apply (rule hoare_seq_ext[OF _ get_ntfn_sp'])
   apply (rule hoare_pre)
-   apply (wp sbn'_valid_pspace'_inv sbn_sch_act' sbn_valid_queues valid_irq_node_lift
+   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)+
@@ -2652,7 +2651,6 @@ lemma cteDeleteOne_isFinal:
 
 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 setQueue_cteCaps_of[wp] = ctes_of_cteCaps_of_lift [OF setQueue_ctes_of]
 lemmas threadSet_cteCaps_of = ctes_of_cteCaps_of_lift [OF threadSet_ctes_of]
 
 crunch isFinal: suspend, prepareThreadDelete "\<lambda>s. isFinal cap slot (cteCaps_of s)"
@@ -2736,16 +2734,6 @@ lemma unbindNotification_valid_objs'_helper':
   by (clarsimp simp: valid_bound_tcb'_def valid_ntfn'_def
                   split: option.splits ntfn.splits)
 
-lemma typ_at'_valid_tcb'_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_tcb' tcb s\<rbrace> f \<lbrace>\<lambda>rv s. valid_tcb' tcb s\<rbrace>"
-  including no_pre
-  apply (simp add: valid_tcb'_def)
-  apply (case_tac "tcbState tcb", simp_all add: valid_tcb_state'_def split_def valid_bound_ntfn'_def)
-         apply (wp hoare_vcg_const_Ball_lift typ_at_lifts[OF P]
-               | case_tac "tcbBoundNotification tcb", simp_all)+
-  done
-
 lemmas setNotification_valid_tcb' = typ_at'_valid_tcb'_lift [OF setNotification_typ_at']
 
 lemma unbindNotification_valid_objs'[wp]:
@@ -2880,9 +2868,7 @@ lemma unbindNotification_bound_tcb_at':
   done
 
 crunches unbindNotification, unbindMaybeNotification
-  for valid_queues[wp]: "Invariants_H.valid_queues"
-  and weak_sch_act_wf[wp]: "\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s"
-  (wp: sbn_valid_queues)
+  for weak_sch_act_wf[wp]: "\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s"
 
 lemma unbindNotification_tcb_at'[wp]:
   "\<lbrace>tcb_at' t'\<rbrace> unbindNotification t \<lbrace>\<lambda>rv. tcb_at' t'\<rbrace>"
@@ -2925,6 +2911,38 @@ crunch obj_at'[wp]: prepareThreadDelete
 
 end
 
+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>"
+  supply projectKOs[simp]
+  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 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
+  supply projectKOs[simp]
+  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
+               split: option.splits)
+
+crunches updateRestartPC, cancelIPC
+  for valid_sched_pointers[wp]: valid_sched_pointers
+  (simp: crunch_simps wp: crunch_wps)
+
+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)))
@@ -2944,21 +2962,22 @@ 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))))\<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 (wp prepares_delete_helper'' [OF cancelAllIPC_unlive]
              prepares_delete_helper'' [OF cancelAllSignals_unlive]
-             suspend_isFinal prepareThreadDelete_unqueued prepareThreadDelete_nonq
+             suspend_isFinal prepareThreadDelete_unqueued
              prepareThreadDelete_inactive prepareThreadDelete_isFinal
-             suspend_makes_inactive suspend_nonq
+             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]],
@@ -3025,7 +3044,9 @@ lemma cancelIPC_cte_wp_at':
   apply (clarsimp simp: cteCaps_of_def cte_wp_at_ctes_of x)
   done
 
-crunch cte_wp_at'[wp]: tcbSchedDequeue "cte_wp_at' P p"
+crunches tcbSchedDequeue
+  for cte_wp_at'[wp]: "cte_wp_at' P p"
+  (wp: crunch_wps)
 
 lemma suspend_cte_wp_at':
   assumes x: "\<And>cap final. P cap \<Longrightarrow> finaliseCap cap final True = fail"
@@ -3151,25 +3172,6 @@ crunch sch_act_not[wp]: cteDeleteOne "sch_act_not t"
   (simp: crunch_simps case_Null_If unless_def
    wp: crunch_wps getObject_inv loadObject_default_inv)
 
-lemma cancelAllIPC_mapM_x_valid_queues:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. \<forall>t\<in>set q. tcb_at' t s)\<rbrace>
-   mapM_x (\<lambda>t. do
-                 y \<leftarrow> setThreadState Structures_H.thread_state.Restart t;
-                 tcbSchedEnqueue t
-               od) q
-   \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (rule_tac R="\<lambda>_ s. (\<forall>t\<in>set q. tcb_at' t s) \<and> valid_objs' s"
-               in hoare_post_add)
-  apply (rule hoare_pre)
-  apply (rule mapM_x_wp')
-  apply (rule hoare_name_pre_state)
-  apply (wp hoare_vcg_const_Ball_lift
-            tcbSchedEnqueue_valid_queues tcbSchedEnqueue_not_st
-            sts_valid_queues sts_st_tcb_at'_cases setThreadState_not_st
-       | simp
-       | ((elim conjE)?, drule (1) bspec, clarsimp elim!: obj_at'_weakenE simp: valid_tcb_state'_def))+
-  done
-
 lemma cancelAllIPC_mapM_x_weak_sch_act:
   "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
    mapM_x (\<lambda>t. do
@@ -3183,13 +3185,15 @@ lemma cancelAllIPC_mapM_x_weak_sch_act:
   done
 
 lemma cancelAllIPC_mapM_x_valid_objs':
-  "\<lbrace>valid_objs'\<rbrace>
+  "\<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 (wpsimp wp: mapM_x_wp' sts_valid_objs')
+  apply (rule hoare_strengthen_post)
+   apply (rule mapM_x_wp')
+  apply (wpsimp wp: sts_valid_objs')
    apply (clarsimp simp: valid_tcb_state'_def)+
   done
 
@@ -3200,57 +3204,29 @@ lemma cancelAllIPC_mapM_x_tcbDomain_obj_at':
                  tcbSchedEnqueue t
                od) q
   \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
-apply (wp mapM_x_wp' tcbSchedEnqueue_not_st setThreadState_oa_queued | simp)+
-done
+  by (wpsimp wp: mapM_x_wp' setThreadState_oa_queued)
 
 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)
-apply (wp tcbSchedEnqueue_not_st
-     | wpc
-     | simp)+
-done
+  by (wpsimp simp: rescheduleRequired_def tcbSchedEnqueue_def tcbQueuePrepend_def)
 
 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
-
-lemma cancelAllIPC_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)\<rbrace>
-   cancelAllIPC ep_ptr
-   \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: cancelAllIPC_def ep'_Idle_case_helper)
-  apply (wp hoare_vcg_conj_lift hoare_vcg_const_Ball_lift
-            cancelAllIPC_mapM_x_valid_queues cancelAllIPC_mapM_x_valid_objs' cancelAllIPC_mapM_x_weak_sch_act
-            set_ep_valid_objs' getEndpoint_wp)
-  apply (clarsimp simp: valid_ep'_def)
-  apply (drule (1) ko_at_valid_objs')
-  apply (auto simp: valid_obj'_def valid_ep'_def valid_tcb'_def projectKOs
-             split: endpoint.splits
-              elim: valid_objs_valid_tcbE)
-  done
+  unfolding cancelAllIPC_def
+  by (wpsimp wp: hoare_vcg_conj_lift hoare_vcg_const_Ball_lift getEndpoint_wp
+                 rescheduleRequired_oa_queued' cancelAllIPC_mapM_x_tcbDomain_obj_at')
 
 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
+  unfolding cancelAllSignals_def
+  by (wpsimp wp: hoare_vcg_conj_lift hoare_vcg_const_Ball_lift getNotification_wp
+                 rescheduleRequired_oa_queued' cancelAllIPC_mapM_x_tcbDomain_obj_at')
 
 lemma unbindMaybeNotification_tcbDomain_obj_at':
   "\<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>
@@ -3260,38 +3236,6 @@ lemma unbindMaybeNotification_tcbDomain_obj_at':
   apply (wp setBoundNotification_oa_queued getNotification_wp gbn_wp' | wpc | simp)+
   done
 
-lemma cancelAllSignals_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)\<rbrace>
-   cancelAllSignals ntfn
-   \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: cancelAllSignals_def)
-  apply (rule hoare_seq_ext [OF _ get_ntfn_sp'])
-  apply (case_tac "ntfnObj ntfna", simp_all)
-    apply (wp, simp)+
-    apply (wp hoare_vcg_conj_lift hoare_vcg_const_Ball_lift
-              cancelAllIPC_mapM_x_valid_queues cancelAllIPC_mapM_x_valid_objs' cancelAllIPC_mapM_x_weak_sch_act
-              set_ntfn_valid_objs'
-          | simp)+
-  apply (clarsimp simp: valid_ep'_def)
-  apply (drule (1) ko_at_valid_objs')
-  apply (auto simp: valid_obj'_def valid_ntfn'_def valid_tcb'_def projectKOs
-             split: endpoint.splits
-              elim: valid_objs_valid_tcbE)
-  done
-
-lemma finaliseCapTrue_standin_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)\<rbrace>
-   finaliseCapTrue_standin cap final
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: finaliseCapTrue_standin_def Let_def)
-  apply (safe)
-       apply (wp | clarsimp | wpc)+
-  done
-
-
-crunch valid_queues[wp]: isFinalCapability "Invariants_H.valid_queues"
-  (simp: crunch_simps)
-
 crunch sch_act[wp]: isFinalCapability "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
   (simp: crunch_simps)
 
@@ -3299,96 +3243,6 @@ crunch weak_sch_act[wp]:
   isFinalCapability "\<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. \<lbrace>obj_at' (inQ d p) tcb\<rbrace> f \<lbrace>\<lambda>_. obj_at' (inQ d p) tcb\<rbrace>"
-  and     prq: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueues s)\<rbrace>"
-  shows   "\<lbrace>valid_inQ_queues\<rbrace> f \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  proof -
-    show ?thesis
-      apply (clarsimp simp: valid_def valid_inQ_queues_def)
-      apply safe
-       apply (rule use_valid [OF _ tat], assumption)
-       apply (drule spec, drule spec, erule conjE, erule bspec)
-       apply (rule ccontr)
-       apply (erule notE[rotated], erule(1) use_valid [OF _ prq])
-      apply (erule use_valid [OF _ prq])
-      apply simp
-      done
-  qed
-
-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)+
-
-crunch valid_inQ_queues[wp]: emptySlot valid_inQ_queues
-  (simp: crunch_simps)
-
-lemma cancelAllIPC_mapM_x_valid_inQ_queues:
-  "\<lbrace>valid_inQ_queues\<rbrace>
-   mapM_x (\<lambda>t. do
-                 y \<leftarrow> setThreadState Structures_H.thread_state.Restart t;
-                 tcbSchedEnqueue t
-               od) q
-   \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (rule mapM_x_wp_inv)
-  apply (wp sts_valid_queues [where st="Structures_H.thread_state.Restart", simplified]
-            setThreadState_st_tcb)
-   done
-
-lemma cancelAllIPC_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace>
-   cancelAllIPC ep_ptr
-   \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (simp add: cancelAllIPC_def ep'_Idle_case_helper)
-  apply (wp cancelAllIPC_mapM_x_valid_inQ_queues)
-  apply (wp hoare_conjI hoare_drop_imp | simp)+
-  done
-
-lemma cancelAllSignals_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace>
-   cancelAllSignals ntfn
-   \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (simp add: cancelAllSignals_def)
-  apply (rule hoare_seq_ext [OF _ get_ntfn_sp'])
-  apply (case_tac "ntfnObj ntfna", simp_all)
-    apply (wp, simp)+
-    apply (wp cancelAllIPC_mapM_x_valid_inQ_queues)+
-   apply (simp)
-  done
-
-crunches unbindNotification, unbindMaybeNotification
-  for valid_inQ_queues[wp]: "valid_inQ_queues"
-
-lemma finaliseCapTrue_standin_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace>
-   finaliseCapTrue_standin cap final
-   \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  apply (simp add: finaliseCapTrue_standin_def Let_def)
-  apply (safe)
-       apply (wp | clarsimp | wpc)+
-  done
-
-crunch valid_inQ_queues[wp]: isFinalCapability valid_inQ_queues
-  (simp: crunch_simps)
-
-lemma cteDeleteOne_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<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)
-  done
-
 crunch ksCurDomain[wp]: cteDeleteOne "\<lambda>s. P (ksCurDomain s)"
   (wp: crunch_wps simp: crunch_simps unless_def)
 
@@ -3452,9 +3306,6 @@ lemma deletingIRQHandler_invs' [wp]:
   apply simp
   done
 
-crunches 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>
@@ -3659,7 +3510,7 @@ lemma unbindNotification_corres:
    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
-                          valid_tcb_def valid_bound_ntfn_def
+                          valid_tcb_def valid_bound_ntfn_def invs_distinct invs_psp_aligned
                    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
@@ -3684,8 +3535,8 @@ lemma unbindMaybeNotification_corres:
        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
-                          valid_tcb_def valid_bound_ntfn_def valid_ntfn_def
+                    simp: valid_obj_def is_tcb tcb_ntfn_is_bound_def invs_psp_aligned
+                          valid_tcb_def valid_bound_ntfn_def valid_ntfn_def 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
@@ -3820,45 +3671,15 @@ lemma finaliseCap_corres:
 
 context begin interpretation Arch . (*FIXME: arch_split*)
 
-crunch queues[wp]: copyGlobalMappings "Invariants_H.valid_queues"
-  (wp: crunch_wps ignore: storePDE)
-
-crunch queues'[wp]: copyGlobalMappings "Invariants_H.valid_queues'"
-  (wp: crunch_wps ignore: storePDE)
-
-crunch ifunsafe'[wp]: copyGlobalMappings "if_unsafe_then_cap'"
-  (wp: crunch_wps ignore: storePDE)
-
-crunch pred_tcb_at'[wp]: copyGlobalMappings "pred_tcb_at' proj P t"
-  (wp: crunch_wps ignore: storePDE)
-
-crunch vms'[wp]: copyGlobalMappings "valid_machine_state'"
-  (wp: crunch_wps ignore: storePDE)
-
-crunch ct_not_inQ[wp]: copyGlobalMappings "ct_not_inQ"
+crunches copyGlobalMappings
+  for ifunsafe'[wp]: "if_unsafe_then_cap'"
+  and pred_tcb_at'[wp]: "pred_tcb_at' proj P t"
+  and vms'[wp]: "valid_machine_state'"
+  and ct_not_inQ[wp]: "ct_not_inQ"
+  and tcb_in_cur_domain'[wp]: "tcb_in_cur_domain' t"
+  and ct__in_cur_domain'[wp]: ct_idle_or_in_cur_domain'
   (wp: crunch_wps ignore: storePDE)
 
-crunch tcb_in_cur_domain'[wp]: copyGlobalMappings "tcb_in_cur_domain' t"
-  (wp: crunch_wps)
-
-crunch ct__in_cur_domain'[wp]: copyGlobalMappings ct_idle_or_in_cur_domain'
-  (wp: crunch_wps)
-
-crunch gsUntypedZeroRanges[wp]: copyGlobalMappings "\<lambda>s. P (gsUntypedZeroRanges s)"
-  (wp: crunch_wps)
-
-crunch gsMaxObjectSize[wp]: copyGlobalMappings "\<lambda>s. P (gsMaxObjectSize s)"
-  (wp: crunch_wps)
-
-crunch it'[wp]: copyGlobalMappings "\<lambda>s. P (ksIdleThread s)"
-  (wp: crunch_wps)
-
-crunch valid_irq_states'[wp]: copyGlobalMappings "valid_irq_states'"
-  (wp: crunch_wps)
-
-crunch ksDomScheduleIdx[wp]: copyGlobalMappings "\<lambda>s. P (ksDomScheduleIdx 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
@@ -3919,178 +3740,6 @@ lemmas cteCaps_of_ctes_of_lift = ctes_of_cteCaps_of_lift
 
 lemmas final_matters'_simps = final_matters'_def [split_simps capability.split arch_capability.split]
 
-definition set_thread_all :: "obj_ref \<Rightarrow> Structures_A.tcb \<Rightarrow> etcb
-                                \<Rightarrow> unit det_ext_monad" where
-  "set_thread_all ptr tcb etcb \<equiv>
-     do s \<leftarrow> get;
-       kh \<leftarrow> return $ (kheap s)(ptr \<mapsto> (TCB tcb));
-       ekh \<leftarrow> return $ (ekheap s)(ptr \<mapsto> etcb);
-       put (s\<lparr>kheap := kh, ekheap := ekh\<rparr>)
-     od"
-
-definition thread_gets_the_all :: "obj_ref \<Rightarrow> (Structures_A.tcb \<times> etcb) det_ext_monad" where
-  "thread_gets_the_all tptr \<equiv>
-          do tcb \<leftarrow> gets_the $ get_tcb tptr;
-             etcb \<leftarrow> gets_the $ get_etcb tptr;
-             return $ (tcb, etcb) od"
-
-definition thread_set_all :: "(Structures_A.tcb \<Rightarrow> Structures_A.tcb) \<Rightarrow> (etcb \<Rightarrow> etcb)
-                  \<Rightarrow> obj_ref \<Rightarrow> unit det_ext_monad" where
-  "thread_set_all f g tptr \<equiv>
-     do (tcb, etcb) \<leftarrow> thread_gets_the_all tptr;
-        set_thread_all tptr (f tcb) (g etcb)
-     od"
-
-lemma set_thread_all_corres:
-  fixes ob' :: "'a :: pspace_storable"
-  assumes x: "updateObject ob' = updateObject_default ob'"
-  assumes z: "\<And>s. obj_at' P ptr s
-               \<Longrightarrow> map_to_ctes ((ksPSpace s) (ptr \<mapsto> injectKO ob')) = map_to_ctes (ksPSpace s)"
-  assumes b: "\<And>ko. P ko \<Longrightarrow> objBits ko = objBits ob'"
-  assumes P: "\<And>(v::'a::pspace_storable). (1 :: machine_word) < 2 ^ (objBits v)"
-  assumes e: "etcb_relation etcb tcb'"
-  assumes is_t: "injectKO (ob' :: 'a :: pspace_storable) = KOTCB tcb'"
-  shows      "other_obj_relation (TCB tcb) (injectKO (ob' :: 'a :: pspace_storable)) \<Longrightarrow>
-  corres dc (obj_at (same_caps (TCB tcb)) ptr and is_etcb_at ptr)
-            (obj_at' (P :: 'a \<Rightarrow> bool) ptr)
-            (set_thread_all ptr tcb etcb) (setObject ptr ob')"
-  apply (rule corres_no_failI)
-   apply (rule no_fail_pre)
-    apply wp
-    apply (rule x)
-   apply (clarsimp simp: b elim!: obj_at'_weakenE)
-  apply (unfold set_thread_all_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
-                        updateObject_default_def in_magnitude_check [OF _ P])
-  apply (clarsimp simp add: state_relation_def z)
-  apply (simp add: trans_state_update'[symmetric] trans_state_update[symmetric]
-         del: trans_state_update)
-  apply (clarsimp simp add: swp_def fun_upd_def obj_at_def is_etcb_at_def)
-  apply (subst cte_wp_at_after_update,fastforce simp add: obj_at_def)
-  apply (subst caps_of_state_after_update,fastforce simp add: obj_at_def)
-  apply clarsimp
-  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
-                   split: Structures_A.kernel_object.splits if_split_asm)
-
-  apply (fold fun_upd_def)
-  apply (simp only: pspace_relation_def dom_fun_upd2 simp_thms)
-  apply (subst pspace_dom_update)
-    apply assumption
-   apply simp
-  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: is_other_obj_relation_type)
-   apply (drule(1) bspec)
-   apply clarsimp
-   apply (frule_tac ko'="TCB tcb'" and x'=ptr in obj_relation_cut_same_type,
-           (fastforce simp add: is_other_obj_relation_type)+)[1]
-  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 (clarsimp simp: projectKOs)
-  apply (insert e is_t)
-  by (clarsimp simp: other_obj_relation_def etcb_relation_def is_other_obj_relation_type split: Structures_A.kernel_object.splits Structures_H.kernel_object.splits X64_A.arch_kernel_obj.splits)
-
-lemma tcb_update_all_corres':
-  assumes tcbs: "tcb_relation tcb tcb' \<Longrightarrow> tcb_relation tcbu tcbu'"
-  assumes tables: "\<forall>(getF, v) \<in> ran tcb_cap_cases. getF tcbu = getF tcb"
-  assumes tables': "\<forall>(getF, v) \<in> ran tcb_cte_cases. getF tcbu' = getF tcb'"
-  assumes r: "r () ()"
-  assumes e: "etcb_relation etcb tcb' \<Longrightarrow> etcb_relation etcbu tcbu'"
-  shows "corres r (ko_at (TCB tcb) add and (\<lambda>s. ekheap s add = Some etcb))
-                  (ko_at' tcb' add)
-                  (set_thread_all add tcbu etcbu) (setObject add tcbu')"
-  apply (rule_tac F="tcb_relation tcb tcb' \<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 (force simp: projectKOs other_obj_relation_def ekheap_relation_def e)
-  apply (erule conjE)
-  apply (rule corres_guard_imp)
-    apply (rule corres_rel_imp)
-     apply (rule set_thread_all_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 simp: is_etcb_at_def 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
-  done
-
-lemma thread_gets_the_all_corres:
-  shows      "corres (\<lambda>(tcb, etcb) tcb'. tcb_relation tcb tcb' \<and> etcb_relation etcb tcb')
-                (tcb_at t and is_etcb_at t) (tcb_at' t)
-                (thread_gets_the_all t) (getObject t)"
-  apply (rule corres_no_failI)
-   apply wp
-  apply (clarsimp simp add: gets_def get_def return_def bind_def get_tcb_def thread_gets_the_all_def threadGet_def ethread_get_def gets_the_def assert_opt_def get_etcb_def is_etcb_at_def tcb_at_def liftM_def split: option.splits Structures_A.kernel_object.splits)
-  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 ko)
-   apply (simp_all add: fail_def return_def)
-  apply (clarsimp simp add: state_relation_def pspace_relation_def ekheap_relation_def)
-  apply (drule bspec)
-   apply clarsimp
-   apply blast
-  apply (drule bspec, erule domI)
-  apply (clarsimp simp add: other_obj_relation_def
-                            lookupAround2_known1)
-  done
-
-lemma thread_set_all_corresT:
-  assumes x: "\<And>tcb tcb'. tcb_relation tcb tcb' \<Longrightarrow>
-                         tcb_relation (f tcb) (f' tcb')"
-  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"
-  assumes e: "\<And>etcb tcb'. etcb_relation etcb tcb' \<Longrightarrow>
-                         etcb_relation (g etcb) (f' tcb')"
-  shows      "corres dc (tcb_at t and valid_etcbs)
-                        (tcb_at' t)
-                    (thread_set_all f g t) (threadSet f' t)"
-  apply (simp add: thread_set_all_def threadSet_def bind_assoc)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF thread_gets_the_all_corres])
-      apply (simp add: split_def)
-      apply (rule tcb_update_all_corres')
-          apply (erule x)
-         apply (rule y)
-        apply (clarsimp simp: bspec_split [OF spec [OF z]])
-       apply fastforce
-      apply (erule e)
-     apply (simp add: thread_gets_the_all_def, wp+)
-   apply clarsimp
-   apply (frule(1) tcb_at_is_etcb_at)
-   apply (clarsimp simp add: tcb_at_def get_etcb_def obj_at_def)
-   apply (drule get_tcb_SomeD)
-   apply fastforce
-  apply simp
-  done
-
-lemmas thread_set_all_corres =
-    thread_set_all_corresT [OF _ _ all_tcbI, OF _ ball_tcb_cap_casesI ball_tcb_cte_casesI]
-
 crunch idle_thread[wp]: deleteCallerCap "\<lambda>s. P (ksIdleThread s)"
   (wp: crunch_wps)
 crunch sch_act_simple: deleteCallerCap sch_act_simple
@@ -4101,96 +3750,11 @@ crunch typ_at'[wp]: deleteCallerCap "\<lambda>s. P (typ_at' T p s)"
   (wp: crunch_wps)
 lemmas deleteCallerCap_typ_ats[wp] = typ_at_lifts [OF deleteCallerCap_typ_at']
 
-crunch ksQ[wp]: emptySlot "\<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 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
-
-lemma cancelAllIPC_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>
-   cancelAllIPC epptr
-   \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  (is "\<lbrace>?PRE\<rbrace> _ \<lbrace>\<lambda>_. ?POST\<rbrace>")
-  apply (simp add: cancelAllIPC_def)
-  apply (wp, wpc, wp)
-        apply (wps rescheduleRequired_ct')
-        apply (wp rescheduleRequired_ksQ')
-       apply (clarsimp simp: forM_x_def)
-       apply (wp cancelAll_ct_not_ksQ_helper mapM_x_wp_inv)
-      apply (wp hoare_lift_Pf2 [OF setEndpoint_ksQ setEndpoint_ct'])+
-      apply (wps rescheduleRequired_ct')
-      apply (wp rescheduleRequired_ksQ')
-     apply (clarsimp simp: forM_x_def)
-     apply (wp cancelAll_ct_not_ksQ_helper mapM_x_wp_inv)
-    apply (wp hoare_lift_Pf2 [OF setEndpoint_ksQ setEndpoint_ct'])+
-   prefer 2
-   apply assumption
-  apply (rule_tac Q="\<lambda>ep. ?PRE and ko_at' ep epptr" in hoare_post_imp)
-   apply (clarsimp)
-   apply (rule conjI)
-    apply ((clarsimp simp: invs'_def valid_state'_def
-                           sch_act_sane_def
-            | drule(1) ct_not_in_epQueue)+)[2]
-  apply (wp get_ep_sp')
-  done
-
-lemma cancelAllSignals_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>
-   cancelAllSignals ntfnptr
-   \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  (is "\<lbrace>?PRE\<rbrace> _ \<lbrace>\<lambda>_. ?POST\<rbrace>")
-  apply (simp add: cancelAllSignals_def)
-  apply (wp, wpc, wp+)
-      apply (wps rescheduleRequired_ct')
-      apply (wp rescheduleRequired_ksQ')
-     apply clarsimp
-     apply (wp cancelAll_ct_not_ksQ_helper mapM_x_wp_inv)
-    apply (wp hoare_lift_Pf2 [OF setNotification_ksQ setNotification_ksCurThread])
-    apply (wps setNotification_ksCurThread, wp)
-   prefer 2
-   apply assumption
-  apply (rule_tac Q="\<lambda>ep. ?PRE and ko_at' ep ntfnptr" in hoare_post_imp)
-   apply ((clarsimp simp: invs'_def valid_state'_def sch_act_sane_def
-          | drule(1) ct_not_in_ntfnQueue)+)[1]
-  apply (wp get_ntfn_sp')
-  done
-
-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 hoare_seq_ext[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 setNotification_ksCurThread, wp)
-  apply clarsimp
-  done
-
 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)
@@ -4223,37 +3787,6 @@ lemma unbindMaybeNotification_sch_act_sane[wp]:
   apply (wp setNotification_sch_act_sane sbn_sch_act_sane | wpc | clarsimp)+
   done
 
-lemma finaliseCapTrue_standin_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>
-   finaliseCapTrue_standin cap final
-   \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: finaliseCapTrue_standin_def Let_def)
-  apply (safe)
-      apply (wp cancelAllIPC_ct_not_ksQ cancelAllSignals_ct_not_ksQ
-                hoare_drop_imps unbindMaybeNotification_ct_not_ksQ
-             | wpc
-             | clarsimp simp: isNotificationCap_def isReplyCap_def split:capability.splits)+
-  done
-
-lemma cteDeleteOne_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>
-   cteDeleteOne slot
-   \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: cteDeleteOne_def unless_def split_def)
-  apply (rule hoare_seq_ext [OF _ getCTE_sp])
-  apply (case_tac "\<forall>final. finaliseCap (cteCap cte) final True = fail")
-   apply (simp add: finaliseCapTrue_standin_simple_def)
-   apply wp
-   apply (clarsimp)
-  apply (wp emptySlot_cteCaps_of hoare_lift_Pf2 [OF emptySlot_ksRQ emptySlot_ct])
-    apply (simp add: cteCaps_of_def)
-    apply (wp (once) hoare_drop_imps)
-    apply (wp finaliseCapTrue_standin_ct_not_ksQ isFinalCapability_inv)+
-  apply (clarsimp)
-  done
-
 end
 
 end
diff --git a/proof/refine/X64/Init_R.thy b/proof/refine/X64/Init_R.thy
index e0077afd48..b129d1dc9a 100644
--- a/proof/refine/X64/Init_R.thy
+++ b/proof/refine/X64/Init_R.thy
@@ -98,7 +98,7 @@ definition zeroed_intermediate_state ::
     ksDomSchedule = [],
     ksCurDomain = 0,
     ksDomainTime = 0,
-    ksReadyQueues = K [],
+    ksReadyQueues = K (TcbQueue None None),
     ksReadyQueuesL1Bitmap = K 0,
     ksReadyQueuesL2Bitmap = K 0,
     ksCurThread = 0,
@@ -119,9 +119,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: ekheap_relation_def)
-         apply (clarsimp simp: ready_queues_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/X64/InterruptAcc_R.thy b/proof/refine/X64/InterruptAcc_R.thy
index 47d19ccf96..4665f6bfdf 100644
--- a/proof/refine/X64/InterruptAcc_R.thy
+++ b/proof/refine/X64/InterruptAcc_R.thy
@@ -49,7 +49,6 @@ lemma setIRQState_invs[wp]:
   apply (simp add: setIRQState_def setInterruptState_def getInterruptState_def)
   apply (wp dmo_maskInterrupt)
   apply (clarsimp simp: invs'_def valid_state'_def cur_tcb'_def
-                        Invariants_H.valid_queues_def valid_queues'_def
                         valid_idle'_def valid_irq_node'_def
                         valid_arch_state'_def valid_global_refs'_def
                         global_refs'_def valid_machine_state'_def
@@ -57,7 +56,7 @@ lemma setIRQState_invs[wp]:
                         valid_irq_handlers'_def irq_issued'_def
                         cteCaps_of_def valid_irq_masks'_def
                         valid_ioports'_simps
-                        bitmapQ_defs valid_queues_no_bitmap_def)
+                        bitmapQ_defs valid_bitmaps_def)
   apply (rule conjI, clarsimp)
   apply (clarsimp simp: irqs_masked'_def ct_not_inQ_def)
   apply (rule conjI)
@@ -147,8 +146,7 @@ lemma invs'_irq_state_independent [simp, intro!]:
           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_queues_no_bitmap_def
-          valid_queues'_def
+          irqs_masked'_def bitmapQ_defs valid_bitmaps_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
diff --git a/proof/refine/X64/Interrupt_R.thy b/proof/refine/X64/Interrupt_R.thy
index 843dd43c89..9c696b7625 100644
--- a/proof/refine/X64/Interrupt_R.thy
+++ b/proof/refine/X64/Interrupt_R.thy
@@ -439,9 +439,8 @@ lemma invoke_irq_handler_invs'[wp]:
     InterruptDecls_H.invokeIRQHandler i \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (cases i, simp_all add: Interrupt_H.invokeIRQHandler_def invokeIRQHandler_def)
     apply (wp dmo_maskInterrupt)
-    apply (clarsimp simp add: invs'_def valid_state'_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)
    apply (wp cteInsert_invs)+
    apply (strengthen ntfn_badge_derived_enough_strg isnt_irq_handler_strg safe_ioport_insert'_ntfn_strg)
    apply (wp cteDeleteOne_other_cap cteDeleteOne_other_cap[unfolded o_def])
@@ -586,14 +585,13 @@ lemma updateIRQState_invs'[wp]:
   apply (clarsimp simp: X64_H.updateIRQState_def)
   apply wp
   apply (fastforce simp: invs'_def valid_state'_def cur_tcb'_def
-                         Invariants_H.valid_queues_def valid_queues'_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 valid_x64_irq_state'_def
+                         bitmapQ_defs  valid_x64_irq_state'_def
                          valid_ioports'_def all_ioports_issued'_def issued_ioports'_def)
   done
 
@@ -664,13 +662,6 @@ lemma decDomainTime_corres:
   apply (clarsimp simp:state_relation_def)
   done
 
-lemma tcbSchedAppend_valid_objs':
-  "\<lbrace>valid_objs'\<rbrace>tcbSchedAppend t \<lbrace>\<lambda>r. valid_objs'\<rbrace>"
-  apply (simp add:tcbSchedAppend_def)
-  apply (wpsimp wp: unless_wp threadSet_valid_objs' threadGet_wp)
-  apply (clarsimp simp add:obj_at'_def typ_at'_def)
-  done
-
 lemma thread_state_case_if:
  "(case state of Structures_A.thread_state.Running \<Rightarrow> f | _ \<Rightarrow> g) =
   (if state = Structures_A.thread_state.Running then f else g)"
@@ -681,26 +672,20 @@ lemma threadState_case_if:
   (if state = Structures_H.thread_state.Running then f else g)"
   by (case_tac state,auto)
 
-lemma tcbSchedAppend_invs_but_ct_not_inQ':
-  "\<lbrace>invs' and st_tcb_at' runnable' t \<rbrace>
-   tcbSchedAppend t \<lbrace>\<lambda>_. all_invs_but_ct_not_inQ'\<rbrace>"
-  apply (simp add: invs'_def valid_state'_def)
-  apply (rule hoare_pre)
-   apply (wp 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
-        | fastforce elim!: st_tcb_ex_cap'' split: thread_state.split_asm)+
-  done
+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 timerTick_corres:
-  "corres dc (cur_tcb and valid_sched)
+  "corres dc (cur_tcb and valid_sched and pspace_aligned and pspace_distinct)
              invs'
              timer_tick timerTick"
   supply if_weak_cong[cong]
   apply (simp add: timerTick_def timer_tick_def)
-  apply (simp add:thread_state_case_if threadState_case_if)
-  apply (rule_tac Q="\<top> and (cur_tcb and valid_sched)" and Q'="\<top> and invs'" in corres_guard_imp)
+  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
@@ -722,67 +707,67 @@ lemma timerTick_corres:
                 apply (rule corres_split)
                    apply (rule ethread_set_corres; simp)
                    apply (simp add: etcb_relation_def)
-                  apply (rule corres_split[OF tcbSchedAppend_corres])
+                  apply (rule corres_split[OF tcbSchedAppend_corres], simp)
                     apply (rule rescheduleRequired_corres)
-                   apply (wp)[1]
-                  apply (rule hoare_strengthen_post)
-                   apply (rule tcbSchedAppend_invs_but_ct_not_inQ',
-                          clarsimp simp: sch_act_wf_weak)
-                 apply (wp threadSet_timeslice_invs threadSet_valid_queues
-                           threadSet_valid_queues' threadSet_pred_tcb_at_state)+
-             apply simp
-            apply simp
-            apply (rule corres_when,simp)
+                   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 (simp add:dec_domain_time_def)
-             apply wp+
-            apply (simp add:decDomainTime_def)
-            apply wp
-           apply (wp|wpc|unfold Let_def|simp)+
-              apply (wp hoare_weak_lift_imp threadSet_timeslice_invs threadSet_valid_queues  threadSet_valid_queues'
-                 threadSet_pred_tcb_at_state threadSet_weak_sch_act_wf tcbSchedAppend_valid_objs'
-                 rescheduleRequired_weak_sch_act_wf tcbSchedAppend_valid_queues| simp)+
-              apply (strengthen sch_act_wf_weak)
-              apply (clarsimp simp:conj_comms)
-              apply (wp tcbSchedAppend_valid_queues tcbSchedAppend_sch_act_wf)
-             apply simp
-             apply (wp threadSet_valid_queues threadSet_pred_tcb_at_state threadSet_sch_act
-              threadSet_tcbDomain_triv threadSet_valid_queues' threadSet_valid_objs'| simp)+
-           apply (wp threadGet_wp gts_wp gts_wp')+
-     apply (clarsimp simp: cur_tcb_def tcb_at_is_etcb_at valid_sched_def valid_sched_action_def)
-    prefer 2
-    apply clarsimp
-   apply (clarsimp simp add:cur_tcb_def valid_sched_def
-       valid_sched_action_def valid_etcbs_def is_tcb_def
-       is_etcb_at_def st_tcb_at_def obj_at_def
-       dest!:get_tcb_SomeD)
-   apply (clarsimp simp: invs'_def valid_state'_def
-   sch_act_wf_weak
-   cur_tcb'_def inQ_def
-   ct_in_state'_def obj_at'_def)
-   apply (clarsimp simp:st_tcb_at'_def
-      valid_idle'_def ct_idle_or_in_cur_domain'_def
-      obj_at'_def projectKO_eq)
-  apply simp
+             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
+                         split_del: if_split)+
+              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) (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 (einvs) ?P' ?f ?g")
-  apply (simp add: handle_interrupt_def handleInterrupt_def )
+  (is "corres dc ?P ?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. einvs"
+                               where R="\<lambda>rv. ?P"
                                  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 )+
@@ -818,7 +803,7 @@ lemma handleInterrupt_corres:
       apply (rule corres_machine_op)
       apply (rule corres_eq_trivial, (simp add: no_fail_ackInterrupt)+)
      apply wp+
-   apply clarsimp
+   apply fastforce
   apply clarsimp
   done
 
@@ -841,52 +826,38 @@ lemma updateTimeSlice_valid_pspace[wp]:
   apply (auto simp:tcb_cte_cases_def)
   done
 
-lemma updateTimeSlice_valid_queues[wp]:
-  "\<lbrace>\<lambda>s. Invariants_H.valid_queues s \<rbrace>
-   threadSet (tcbTimeSlice_update (\<lambda>_. ts')) thread
-   \<lbrace>\<lambda>r s. Invariants_H.valid_queues s\<rbrace>"
-  apply (wp threadSet_valid_queues,simp)
-  apply (clarsimp simp:obj_at'_def inQ_def)
-  done
-
-
 (* catch up tcbSchedAppend to tcbSchedEnqueue, which has these from crunches on possibleSwitchTo *)
-crunch ifunsafe[wp]: tcbSchedAppend if_unsafe_then_cap'
 crunch irq_handlers'[wp]: tcbSchedAppend valid_irq_handlers'
   (simp: unless_def tcb_cte_cases_def wp: crunch_wps)
-crunch irq_states'[wp]: tcbSchedAppend valid_irq_states'
 crunch irqs_masked'[wp]: tcbSchedAppend irqs_masked'
   (simp: unless_def wp: crunch_wps)
 crunch ct[wp]: tcbSchedAppend cur_tcb'
   (wp: cur_tcb_lift crunch_wps)
 
-crunch cur_tcb'[wp]: tcbSchedAppend cur_tcb'
-  (simp: unless_def wp: crunch_wps)
-
 lemma timerTick_invs'[wp]:
-  "\<lbrace>invs'\<rbrace> timerTick \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  "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
-                    tcbSchedAppend_invs_but_ct_not_inQ'
-                simp: tcb_cte_cases_def)
-     apply (rule_tac Q="\<lambda>rv. invs'" in hoare_post_imp)
-     apply (clarsimp simp add:invs'_def valid_state'_def)
+              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'
-                          del: tcbSchedAppend_sch_act_wf)+
-             apply (rule hoare_strengthen_post[OF tcbSchedAppend_invs_but_ct_not_inQ'])
-             apply (wpsimp simp: valid_pspace'_def sch_act_wf_weak)+
-           apply (wpsimp wp: threadSet_pred_tcb_no_state threadSet_tcbDomain_triv
-                             threadSet_valid_objs' threadSet_timeslice_invs)+
-       apply (wp threadGet_wp)
+            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 (clarsimp simp: invs'_def st_tcb_at'_def obj_at'_def valid_state'_def)
+  apply (auto simp: invs'_def st_tcb_at'_def obj_at'_def valid_state'_def cong: conj_cong)
   done
 
 lemma resetTimer_invs'[wp]:
diff --git a/proof/refine/X64/InvariantUpdates_H.thy b/proof/refine/X64/InvariantUpdates_H.thy
index 25a95f3d15..1406c2ebba 100644
--- a/proof/refine/X64/InvariantUpdates_H.thy
+++ b/proof/refine/X64/InvariantUpdates_H.thy
@@ -38,8 +38,9 @@ lemma invs'_machine:
 proof -
   show ?thesis
     apply (cases "ksSchedulerAction s")
-    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_queues_def valid_queues_no_bitmap_def bitmapQ_defs
+    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
@@ -56,12 +57,13 @@ lemma invs_no_cicd'_machine:
 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_queues_def valid_queues_no_bitmap_def bitmapQ_defs
-                    vms ct_not_inQ_def
-                    state_refs_of'_def ps_clear_def
-                    valid_irq_node'_def mask
-              cong: option.case_cong)
+    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)
     done
 qed
 
@@ -98,14 +100,9 @@ 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_queues_ksSchedulerAction_update[simp]:
-  "valid_queues (ksSchedulerAction_update f s) = valid_queues s"
- unfolding valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs
- by simp
-
-lemma valid_queues'_ksSchedulerAction_update[simp]:
-  "valid_queues' (ksSchedulerAction_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_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'"
@@ -140,45 +137,25 @@ lemma tcb_in_cur_domain_ct[simp]:
   "tcb_in_cur_domain' t  (ksCurThread_update f s) = tcb_in_cur_domain' t s"
   by (fastforce simp: tcb_in_cur_domain'_def)
 
-lemma valid_queues'_ksCurDomain[simp]:
-  "valid_queues' (ksCurDomain_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
-
-lemma valid_queues'_ksDomScheduleIdx[simp]:
-  "valid_queues' (ksDomScheduleIdx_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
+lemma valid_bitmaps_ksCurDomain[simp]:
+  "valid_bitmaps (ksCurDomain_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
 
-lemma valid_queues'_ksDomSchedule[simp]:
-  "valid_queues' (ksDomSchedule_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
+lemma valid_bitmaps_ksDomScheduleIdx[simp]:
+  "valid_bitmaps (ksDomScheduleIdx_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
 
-lemma valid_queues'_ksDomainTime[simp]:
-  "valid_queues' (ksDomainTime_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
+lemma valid_bitmaps_ksDomSchedule[simp]:
+   "valid_bitmaps (ksDomSchedule_update f s) = valid_bitmaps s"
+   by (simp add: valid_bitmaps_def bitmapQ_defs)
 
-lemma valid_queues'_ksWorkUnitsCompleted[simp]:
-  "valid_queues' (ksWorkUnitsCompleted_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
+lemma valid_bitmaps_ksDomainTime[simp]:
+  "valid_bitmaps (ksDomainTime_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
 
-lemma valid_queues_ksCurDomain[simp]:
-  "valid_queues (ksCurDomain_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
-
-lemma valid_queues_ksDomScheduleIdx[simp]:
-  "valid_queues (ksDomScheduleIdx_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
-
-lemma valid_queues_ksDomSchedule[simp]:
-  "valid_queues (ksDomSchedule_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
-
-lemma valid_queues_ksDomainTime[simp]:
-  "valid_queues (ksDomainTime_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
-
-lemma valid_queues_ksWorkUnitsCompleted[simp]:
-  "valid_queues (ksWorkUnitsCompleted_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
+lemma valid_bitmaps_ksWorkUnitsCompleted[simp]:
+  "valid_bitmaps (ksWorkUnitsCompleted_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
 
 lemma valid_irq_node'_ksCurDomain[simp]:
   "valid_irq_node' w (ksCurDomain_update f s) = valid_irq_node' w s"
@@ -255,6 +232,10 @@ lemma valid_mdb_interrupts'[simp]:
   "valid_mdb' (ksInterruptState_update f s) = valid_mdb' s"
   by (simp add: valid_mdb'_def)
 
+lemma valid_mdb'_ksReadyQueues_update[simp]:
+  "valid_mdb' (ksReadyQueues_update f s) = valid_mdb' s"
+  by (simp add: valid_mdb'_def)
+
 lemma vms_ksReadyQueues_update[simp]:
   "valid_machine_state' (ksReadyQueues_update f s) = valid_machine_state' s"
   by (simp add: valid_machine_state'_def)
@@ -279,10 +260,10 @@ lemma ct_in_state_ksSched[simp]:
 
 lemma invs'_wu [simp]:
   "invs' (ksWorkUnitsCompleted_update f s) = invs' s"
-  apply (simp add: invs'_def cur_tcb'_def valid_state'_def Invariants_H.valid_queues_def
-                   valid_queues'_def valid_irq_node'_def valid_machine_state'_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 valid_queues_no_bitmap_def)
+                   bitmapQ_defs)
   done
 
 lemma valid_arch_state'_interrupt[simp]:
@@ -342,9 +323,8 @@ lemma sch_act_simple_ksReadyQueuesL2Bitmap[simp]:
 
 lemma ksDomainTime_invs[simp]:
   "invs' (ksDomainTime_update f s) = invs' s"
-  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)
+  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"
@@ -372,9 +352,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 valid_state'_def valid_queues_def valid_queues'_def
-                      valid_irq_node'_def cur_tcb'_def ct_idle_or_in_cur_domain'_def
-                      tcb_in_cur_domain'_def valid_queues_no_bitmap_def
-                      bitmapQ_no_L2_orphans_def bitmapQ_no_L1_orphans_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
\ No newline at end of file
diff --git a/proof/refine/X64/Invariants_H.thy b/proof/refine/X64/Invariants_H.thy
index 98aa8e5f17..892e995337 100644
--- a/proof/refine/X64/Invariants_H.thy
+++ b/proof/refine/X64/Invariants_H.thy
@@ -10,6 +10,7 @@ imports
   "AInvs.Deterministic_AI"
   "AInvs.AInvs"
   "Lib.AddUpdSimps"
+  "Lib.Heap_List"
 begin
 
 context Arch begin
@@ -88,6 +89,21 @@ abbreviation
 abbreviation
   "ko_at' v \<equiv> obj_at' (\<lambda>k. k = v)"
 
+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 tcbSchedPrevs_of :: "kernel_state \<Rightarrow> obj_ref \<Rightarrow> obj_ref option" where
+  "tcbSchedPrevs_of s \<equiv> tcbs_of' s |> tcbSchedPrev"
+
+abbreviation tcbSchedNexts_of :: "kernel_state \<Rightarrow> obj_ref \<Rightarrow> obj_ref option" where
+  "tcbSchedNexts_of s \<equiv> tcbs_of' s |> tcbSchedNext"
+
+abbreviation sym_heap_sched_pointers :: "global.kernel_state \<Rightarrow> bool" where
+  "sym_heap_sched_pointers s \<equiv> sym_heap (tcbSchedNexts_of s) (tcbSchedPrevs_of s)"
+
 abbreviation
   "pde_at' \<equiv> typ_at' (ArchT PDET)"
 abbreviation
@@ -236,16 +252,17 @@ where
                                then refs_of' ko
                                else {}))"
 
-
 primrec
   live' :: "Structures_H.kernel_object \<Rightarrow> bool"
 where
   "live' (KOTCB tcb) =
-     (bound (tcbBoundNotification 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)     = (bound (ntfnBoundTCB ntfn) \<or> (\<exists>ts. ntfnObj ntfn = WaitingNtfn ts))"
+| "live' (KONotification ntfn) = (bound (ntfnBoundTCB ntfn) \<or> (\<exists>ts. ntfnObj ntfn = WaitingNtfn ts))"
 | "live' (KOUserData)          = False"
 | "live' (KOUserDataDevice)    = False"
 | "live' (KOKernelData)        = False"
@@ -505,6 +522,11 @@ 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' :: "Structures_H.tcb \<Rightarrow> kernel_state \<Rightarrow> bool"
 where
@@ -514,7 +536,9 @@ where
                   \<and> valid_bound_ntfn' (tcbBoundNotification t) s
                   \<and> tcbDomain t \<le> maxDomain
                   \<and> tcbPriority t \<le> maxPriority
-                  \<and> tcbMCP 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"
@@ -524,7 +548,6 @@ where
   | Structures_H.SendEP ts \<Rightarrow> (ts \<noteq> [] \<and> (\<forall>t \<in> set ts. tcb_at' t s) \<and> distinct ts)
   | Structures_H.RecvEP ts \<Rightarrow> (ts \<noteq> [] \<and> (\<forall>t \<in> set ts. tcb_at' t s) \<and> distinct ts)"
 
-
 definition
   valid_bound_tcb' :: "machine_word option \<Rightarrow> kernel_state \<Rightarrow> bool"
 where
@@ -921,10 +944,15 @@ where
 | "runnable' (Structures_H.BlockedOnSend a b c d e) = False"
 | "runnable' (Structures_H.BlockedOnNotification x) = False"
 
-definition
-  inQ :: "domain \<Rightarrow> priority \<Rightarrow> tcb \<Rightarrow> bool"
-where
- "inQ d p tcb \<equiv> tcbQueued tcb \<and> tcbPriority tcb = p \<and> tcbDomain tcb = d"
+definition inQ :: "domain \<Rightarrow> priority \<Rightarrow> tcb \<Rightarrow> bool" where
+  "inQ d p tcb \<equiv> tcbQueued tcb \<and> tcbPriority tcb = p \<and> tcbDomain tcb = d"
+
+lemma inQ_implies_tcbQueueds_of:
+  "(inQ domain priority |< tcbs_of' s') tcbPtr \<Longrightarrow> (tcbQueued |< tcbs_of' s') tcbPtr"
+  by (clarsimp simp: opt_map_def opt_pred_def inQ_def split: option.splits)
+
+defs ready_qs_runnable_def:
+  "ready_qs_runnable s \<equiv> \<forall>t. obj_at' tcbQueued t s \<longrightarrow> st_tcb_at' runnable' t s"
 
 definition
   (* for given domain and priority, the scheduler bitmap indicates a thread is in the queue *)
@@ -934,15 +962,6 @@ where
   "bitmapQ d p s \<equiv> ksReadyQueuesL1Bitmap s d !! prioToL1Index p
                      \<and> ksReadyQueuesL2Bitmap s (d, invertL1Index (prioToL1Index p))
                          !! unat (p && mask wordRadix)"
-
-definition
-  valid_queues_no_bitmap :: "kernel_state \<Rightarrow> bool"
-where
- "valid_queues_no_bitmap \<equiv> \<lambda>s.
-   (\<forall>d p. (\<forall>t \<in> set (ksReadyQueues s (d, p)). obj_at' (inQ d p and runnable' \<circ> tcbState) t s)
-    \<and>  distinct (ksReadyQueues s (d, p))
-    \<and> (d > maxDomain \<or> p > maxPriority \<longrightarrow> ksReadyQueues s (d,p) = []))"
-
 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
@@ -966,31 +985,62 @@ where
     \<forall>d i. ksReadyQueuesL1Bitmap s d !! i \<longrightarrow> ksReadyQueuesL2Bitmap s (d, invertL1Index i) \<noteq> 0 \<and>
                                              i < l2BitmapSize"
 
-definition
-  valid_bitmapQ :: "kernel_state \<Rightarrow> bool"
-where
-  "valid_bitmapQ \<equiv> \<lambda>s. (\<forall>d p. bitmapQ d p s \<longleftrightarrow> ksReadyQueues s (d,p) \<noteq> [])"
+definition valid_bitmapQ :: "kernel_state \<Rightarrow> bool" where
+  "valid_bitmapQ \<equiv> \<lambda>s. \<forall>d p. bitmapQ d p s \<longleftrightarrow> \<not> tcbQueueEmpty (ksReadyQueues s (d,p))"
 
-definition
-  valid_queues :: "kernel_state \<Rightarrow> bool"
-where
- "valid_queues \<equiv> \<lambda>s. valid_queues_no_bitmap s \<and> valid_bitmapQ s \<and>
-                     bitmapQ_no_L2_orphans s \<and> bitmapQ_no_L1_orphans s"
+definition valid_bitmaps :: "kernel_state \<Rightarrow> bool" where
+  "valid_bitmaps \<equiv> \<lambda>s. valid_bitmapQ s \<and> bitmapQ_no_L2_orphans s \<and> bitmapQ_no_L1_orphans s"
 
-definition
-  (* when a thread gets added to / removed from a queue, but before bitmap updated *)
-  valid_bitmapQ_except :: "domain \<Rightarrow> priority \<Rightarrow> kernel_state \<Rightarrow> bool"
-where
+lemma valid_bitmaps_valid_bitmapQ[elim!]:
+  "valid_bitmaps s \<Longrightarrow> valid_bitmapQ s"
+  by (simp add: valid_bitmaps_def)
+
+lemma valid_bitmaps_bitmapQ_no_L2_orphans[elim!]:
+  "valid_bitmaps s \<Longrightarrow> bitmapQ_no_L2_orphans s"
+  by (simp add: valid_bitmaps_def)
+
+lemma valid_bitmaps_bitmapQ_no_L1_orphans[elim!]:
+  "valid_bitmaps s \<Longrightarrow> bitmapQ_no_L1_orphans s"
+  by (simp add: valid_bitmaps_def)
+
+lemma valid_bitmaps_lift:
+  assumes prq: "\<And>P. f \<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace>"
+  assumes prqL1: "\<And>P. f \<lbrace>\<lambda>s. P (ksReadyQueuesL1Bitmap s)\<rbrace>"
+  assumes prqL2: "\<And>P. f \<lbrace>\<lambda>s. P (ksReadyQueuesL2Bitmap s)\<rbrace>"
+  shows "f \<lbrace>valid_bitmaps\<rbrace>"
+  unfolding valid_bitmaps_def valid_bitmapQ_def bitmapQ_def
+            bitmapQ_no_L1_orphans_def bitmapQ_no_L2_orphans_def
+  apply (rule hoare_pre)
+   apply (wps assms | wpsimp)+
+  done
+
+(* when a thread gets added to / removed from a queue, but before bitmap updated *)
+definition valid_bitmapQ_except :: "domain \<Rightarrow> priority \<Rightarrow> kernel_state \<Rightarrow> bool" where
   "valid_bitmapQ_except d' p' \<equiv> \<lambda>s.
-    (\<forall>d p. (d \<noteq> d' \<or> p \<noteq> p') \<longrightarrow> (bitmapQ d p s \<longleftrightarrow> ksReadyQueues s (d,p) \<noteq> []))"
+    \<forall>d p. (d \<noteq> d' \<or> p \<noteq> p') \<longrightarrow> (bitmapQ d p s \<longleftrightarrow> \<not> tcbQueueEmpty (ksReadyQueues s (d,p)))"
 
 lemmas bitmapQ_defs = valid_bitmapQ_def valid_bitmapQ_except_def bitmapQ_def
                        bitmapQ_no_L2_orphans_def bitmapQ_no_L1_orphans_def
 
-definition
-  valid_queues' :: "kernel_state \<Rightarrow> bool"
-where
- "valid_queues' \<equiv> \<lambda>s. \<forall>d p t. obj_at' (inQ d p) t s \<longrightarrow> t \<in> set (ksReadyQueues s (d, p))"
+\<comment> \<open>
+  The tcbSchedPrev and tcbSchedNext fields of a TCB are used only to indicate membership in
+  one of the ready queues. \<close>
+definition valid_sched_pointers_2 ::
+  "(obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> (obj_ref \<Rightarrow> bool) \<Rightarrow> bool "
+  where
+  "valid_sched_pointers_2 prevs nexts ready \<equiv>
+     \<forall>ptr. prevs ptr \<noteq> None \<or> nexts ptr \<noteq> None \<longrightarrow> ready ptr"
+
+abbreviation valid_sched_pointers :: "kernel_state \<Rightarrow> bool" where
+  "valid_sched_pointers s \<equiv>
+     valid_sched_pointers_2 (tcbSchedPrevs_of s) (tcbSchedNexts_of s) (tcbQueued |< tcbs_of' s)"
+
+lemmas valid_sched_pointers_def = valid_sched_pointers_2_def
+
+lemma valid_sched_pointersD:
+  "\<lbrakk>valid_sched_pointers s; \<not> (tcbQueued |< tcbs_of' s) t\<rbrakk>
+   \<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 tcb_in_cur_domain' :: "machine_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"
@@ -1231,7 +1281,7 @@ definition
   valid_state' :: "kernel_state \<Rightarrow> bool"
 where
   "valid_state' \<equiv> \<lambda>s. valid_pspace' s \<and> sch_act_wf (ksSchedulerAction s) s
-                      \<and> valid_queues s \<and> sym_refs (state_refs_of' 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
@@ -1241,7 +1291,9 @@ where
                       \<and> valid_machine_state' s
                       \<and> irqs_masked' s
                       \<and> valid_ioports' s
-                      \<and> valid_queues' 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> pspace_domain_valid s
@@ -1294,6 +1346,11 @@ definition
 abbreviation
   "active' st \<equiv> st = Structures_H.Running \<or> st = Structures_H.Restart"
 
+lemma runnable_eq_active': "runnable' = active'"
+  apply (rule ext)
+  apply (case_tac st, simp_all)
+  done
+
 abbreviation
   "simple' st \<equiv> st = Structures_H.Inactive \<or>
                 st = Structures_H.Running \<or>
@@ -1309,11 +1366,14 @@ abbreviation
 abbreviation(input)
  "all_invs_but_sym_refs_ct_not_inQ'
     \<equiv> \<lambda>s. valid_pspace' s \<and> sch_act_wf (ksSchedulerAction s) s
-           \<and> valid_queues s \<and> if_live_then_nonz_cap' s \<and> if_unsafe_then_cap' 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> cur_tcb' s \<and> valid_queues' s \<and> ct_idle_or_in_cur_domain' s
+           \<and> valid_irq_states' s \<and> irqs_masked' s
+           \<and> sym_heap_sched_pointers s \<and> valid_sched_pointers s \<and> valid_bitmaps s
+           \<and> valid_machine_state' s
+           \<and> cur_tcb' s \<and> ct_idle_or_in_cur_domain' s
+           \<and> cur_tcb' s \<and> ct_idle_or_in_cur_domain' s
            \<and> pspace_domain_valid s \<and> valid_ioports' s
            \<and> ksCurDomain s \<le> maxDomain
            \<and> valid_dom_schedule' s \<and> untyped_ranges_zero' s"
@@ -1321,12 +1381,14 @@ abbreviation(input)
 abbreviation(input)
  "all_invs_but_ct_not_inQ'
     \<equiv> \<lambda>s. valid_pspace' s \<and> sch_act_wf (ksSchedulerAction s) s
-           \<and> valid_queues s \<and> sym_refs (state_refs_of' 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> cur_tcb' s \<and> valid_queues' s \<and> ct_idle_or_in_cur_domain' s
+           \<and> valid_irq_states' s \<and> irqs_masked' s
+           \<and> sym_heap_sched_pointers s \<and> valid_sched_pointers s \<and> valid_bitmaps s
+           \<and> valid_machine_state' s
+           \<and> cur_tcb' s \<and> ct_idle_or_in_cur_domain' s
            \<and> pspace_domain_valid s \<and> valid_ioports' s
            \<and> ksCurDomain s \<le> maxDomain
            \<and> valid_dom_schedule' s \<and> untyped_ranges_zero' s"
@@ -1342,12 +1404,14 @@ lemma all_invs_but_not_ct_inQ_check':
 definition
   "all_invs_but_ct_idle_or_in_cur_domain'
     \<equiv> \<lambda>s. valid_pspace' s \<and> sch_act_wf (ksSchedulerAction s) s
-           \<and> valid_queues s \<and> sym_refs (state_refs_of' 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> cur_tcb' s \<and> valid_queues' s \<and> ct_not_inQ s
+           \<and> valid_irq_states' s \<and> irqs_masked' s
+           \<and> sym_heap_sched_pointers s \<and> valid_sched_pointers s \<and> valid_bitmaps s
+           \<and> valid_machine_state' s
+           \<and> cur_tcb' s \<and> ct_not_inQ s
            \<and> pspace_domain_valid s \<and> valid_ioports' s
            \<and> ksCurDomain s \<le> maxDomain
            \<and> valid_dom_schedule' s \<and> untyped_ranges_zero' s"
@@ -1424,6 +1488,10 @@ lemma valid_bound_tcb'_Some[simp]:
   "valid_bound_tcb' (Some x) = tcb_at' x"
   by (auto simp: valid_bound_tcb'_def)
 
+lemma objBitsKO_Data:
+  "objBitsKO (if dev then KOUserDataDevice else KOUserData) = pageBits"
+  by (simp add: objBits_def objBitsKO_def word_size_def)
+
 lemmas objBits_defs = tcbBlockSizeBits_def epSizeBits_def ntfnSizeBits_def cteSizeBits_def
 lemmas untypedBits_defs = minUntypedSizeBits_def maxUntypedSizeBits_def
 lemmas objBits_simps = objBits_def objBitsKO_def word_size_def
@@ -2510,7 +2578,7 @@ lemma typ_at_lift_valid_cap':
     apply (case_tac arch_capability,
            simp_all add: P[where P=id, simplified] vspace_table_at'_defs
                          hoare_vcg_prop All_less_Ball
-                    split del: if_splits)
+                    split del: if_split)
        apply (wp hoare_vcg_const_Ball_lift P typ_at_lift_valid_untyped'
                  hoare_vcg_all_lift typ_at_lift_cte')+
   done
@@ -3141,9 +3209,9 @@ lemma sch_act_wf_arch [simp]:
   "sch_act_wf sa (ksArchState_update f s) = sch_act_wf sa s"
   by (cases sa) (simp_all add: ct_in_state'_def  tcb_in_cur_domain'_def)
 
-lemma valid_queues_arch [simp]:
-  "valid_queues (ksArchState_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
+lemma valid_bitmaps_arch[simp]:
+  "valid_bitmaps (ksArchState_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
 
 lemma if_unsafe_then_cap_arch' [simp]:
   "if_unsafe_then_cap' (ksArchState_update f s) = if_unsafe_then_cap' s"
@@ -3161,22 +3229,14 @@ lemma sch_act_wf_machine_state [simp]:
   "sch_act_wf sa (ksMachineState_update f s) = sch_act_wf sa s"
   by (cases sa) (simp_all add: ct_in_state'_def  tcb_in_cur_domain'_def)
 
-lemma valid_queues_machine_state [simp]:
-  "valid_queues (ksMachineState_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
-
-lemma valid_queues_arch' [simp]:
-  "valid_queues' (ksArchState_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
-
-lemma valid_queues_machine_state' [simp]:
-  "valid_queues' (ksMachineState_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
-
 lemma valid_irq_node'_machine_state [simp]:
   "valid_irq_node' x (ksMachineState_update f s) = valid_irq_node' x s"
   by (simp add: valid_irq_node'_def)
 
+lemma valid_bitmaps_machine_state[simp]:
+  "valid_bitmaps (ksMachineState_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
+
 (* these should be reasonable safe for automation because of the 0 pattern *)
 lemma no_0_ko_wp' [elim!]:
   "\<lbrakk> ko_wp_at' Q 0 s; no_0_obj' s \<rbrakk> \<Longrightarrow> P"
@@ -3256,19 +3316,6 @@ lemma typ_at_aligned':
   "\<lbrakk> typ_at' tp p s \<rbrakk> \<Longrightarrow> is_aligned p (objBitsT tp)"
   by (clarsimp simp add: typ_at'_def ko_wp_at'_def objBitsT_koTypeOf)
 
-lemma valid_queues_obj_at'D:
-   "\<lbrakk> t \<in> set (ksReadyQueues s (d, p)); valid_queues s \<rbrakk>
-        \<Longrightarrow> obj_at' (inQ d p) t s"
-  apply (unfold valid_queues_def valid_queues_no_bitmap_def)
-  apply (elim conjE)
-  apply (drule_tac x=d in spec)
-  apply (drule_tac x=p in spec)
-  apply (clarsimp)
-  apply (drule(1) bspec)
-  apply (erule obj_at'_weakenE)
-  apply (clarsimp)
-  done
-
 lemma obj_at'_and:
   "obj_at' (P and P') t s = (obj_at' P t s \<and> obj_at' P' t s)"
   by (rule iffI, (clarsimp simp: obj_at'_def)+)
@@ -3310,21 +3357,6 @@ lemma obj_at'_ko_at'_prop:
   "ko_at' ko t s \<Longrightarrow> obj_at' P t s = P ko"
   by (drule obj_at_ko_at', clarsimp simp: obj_at'_def)
 
-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> st_tcb_at' runnable' t s) \<and>
-                  distinct (ksReadyQueues s (d, p)) \<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_queues_running:
-  assumes Q: "t \<in> set(ksReadyQueues s (d, p))" "valid_queues s"
-  shows "st_tcb_at' runnable' t s"
-  using assms by (clarsimp simp add: valid_queues_def valid_queues_no_bitmap_def')
-
 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)
@@ -3409,8 +3441,16 @@ 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_queues [elim!]:
-  "invs' s \<Longrightarrow> valid_queues s"
+lemma invs_valid_bitmaps[elim!]:
+  "invs' s \<Longrightarrow> valid_bitmaps s"
+  by (simp add: invs'_def valid_state'_def)
+
+lemma invs_sym_heap_sched_pointers[elim!]:
+  "invs' s \<Longrightarrow> sym_heap_sched_pointers s"
+  by (simp add: invs'_def valid_state'_def)
+
+lemma invs_valid_sched_pointers[elim!]:
+  "invs' s \<Longrightarrow> valid_sched_pointers s"
   by (simp add: invs'_def valid_state'_def)
 
 lemma invs_valid_idle'[elim!]:
@@ -3427,7 +3467,7 @@ lemma invs'_invs_no_cicd:
 
 lemma invs'_bitmapQ_no_L1_orphans:
   "invs' s \<Longrightarrow> bitmapQ_no_L1_orphans s"
-  by (drule invs_queues, simp add: valid_queues_def)
+  by (simp add: invs'_def valid_state'_def valid_bitmaps_def)
 
 lemma invs_ksCurDomain_maxDomain' [elim!]:
   "invs' s \<Longrightarrow> ksCurDomain s \<le> maxDomain"
@@ -3452,34 +3492,24 @@ lemma invs_no_0_obj'[elim!]:
 
 lemma invs'_gsCNodes_update[simp]:
   "invs' (gsCNodes_update f s') = invs' s'"
-  apply (clarsimp simp: invs'_def valid_state'_def valid_queues_def valid_queues_no_bitmap_def
-             bitmapQ_defs
-             valid_queues'_def valid_irq_node'_def valid_irq_handlers'_def valid_ioports'_def
-             irq_issued'_def irqs_masked'_def valid_machine_state'_def
-             cur_tcb'_def)
-  apply (cases "ksSchedulerAction s'")
-  apply (simp_all add: ct_in_state'_def tcb_in_cur_domain'_def  ct_idle_or_in_cur_domain'_def ct_not_inQ_def)
+  apply (clarsimp simp: invs'_def valid_state'_def valid_bitmaps_def bitmapQ_defs valid_ioports'_def
+                        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_state'_def valid_queues_def valid_queues_no_bitmap_def
-             bitmapQ_defs
-             valid_queues'_def valid_irq_node'_def valid_irq_handlers'_def valid_ioports'_def
-             irq_issued'_def irqs_masked'_def valid_machine_state'_def
-             cur_tcb'_def)
-  apply (cases "ksSchedulerAction s'")
-  apply (simp_all add: ct_in_state'_def ct_idle_or_in_cur_domain'_def   tcb_in_cur_domain'_def ct_not_inQ_def)
+  apply (clarsimp simp: invs'_def valid_state'_def valid_bitmaps_def bitmapQ_defs valid_ioports'_def
+                        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_queues_tcb_in_cur_domain':
-  "\<lbrakk> ksReadyQueues s (d, p) = x # xs; invs' s; d = ksCurDomain s\<rbrakk>
-     \<Longrightarrow> tcb_in_cur_domain' x s"
-apply (subgoal_tac "x \<in> set (ksReadyQueues s (d, p))")
- apply (drule (1) valid_queues_obj_at'D[OF _ invs_queues])
- apply (auto simp: inQ_def tcb_in_cur_domain'_def elim: obj_at'_weakenE)
-done
-
 lemma pred_tcb'_neq_contra:
   "\<lbrakk> pred_tcb_at' proj P p s; pred_tcb_at' proj Q p s; \<And>st. P st \<noteq> Q st \<rbrakk> \<Longrightarrow> False"
   by (clarsimp simp: pred_tcb_at'_def obj_at'_def)
@@ -3493,7 +3523,7 @@ lemma invs'_ksDomScheduleIdx:
 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> ksReadyQueues s (d,p) \<noteq> []) ;
+  "\<lbrakk> valid_bitmapQ_except d p s; bitmapQ d p s \<longleftrightarrow> \<not> tcbQueueEmpty (ksReadyQueues s (d,p));
      bitmapQ_no_L2_orphans s \<rbrakk>
    \<Longrightarrow> valid_bitmapQ s"
   unfolding valid_bitmapQ_def valid_bitmapQ_except_def
diff --git a/proof/refine/X64/IpcCancel_R.thy b/proof/refine/X64/IpcCancel_R.thy
index 8894a18267..1bc48323ba 100644
--- a/proof/refine/X64/IpcCancel_R.thy
+++ b/proof/refine/X64/IpcCancel_R.thy
@@ -48,25 +48,6 @@ lemma set_ep_pred_tcb_at' [wp]:
   apply (simp add: updateObject_default_def in_monad projectKOs)
   done
 
-(* valid_queues is too strong *)
-definition valid_inQ_queues :: "KernelStateData_H.kernel_state \<Rightarrow> bool" where
-  "valid_inQ_queues \<equiv>
-     \<lambda>s. \<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s) \<and> distinct (ksReadyQueues s (d, p))"
-
-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_inQ_queues_ksReadyQueuesL1Bitmap_upd[simp]:
-  "valid_inQ_queues (ksReadyQueuesL1Bitmap_update f s) = valid_inQ_queues s"
-  unfolding valid_inQ_queues_def
-  by simp
-
-lemma valid_inQ_queues_ksReadyQueuesL2Bitmap_upd[simp]:
-  "valid_inQ_queues (ksReadyQueuesL2Bitmap_update f s) = valid_inQ_queues s"
-  unfolding valid_inQ_queues_def
-  by simp
-
 defs capHasProperty_def:
   "capHasProperty ptr P \<equiv> cte_wp_at' (\<lambda>c. P (cteCap c)) ptr"
 end
@@ -83,11 +64,6 @@ locale delete_one_conc_pre =
     "\<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_queues:
-    "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)\<rbrace>
-     cteDeleteOne sl \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  assumes delete_one_inQ_queues:
-    "\<lbrace>valid_inQ_queues\<rbrace> cteDeleteOne sl \<lbrace>\<lambda>rv. valid_inQ_queues\<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:
@@ -343,6 +319,7 @@ lemma cancelSignal_corres:
     apply fastforce
    apply (clarsimp simp: valid_obj_def valid_tcb_def valid_tcb_state_def)
    apply (drule sym, simp add: obj_at_def)
+   apply fastforce
   apply (clarsimp simp: conj_comms pred_tcb_at' cong: conj_cong)
   apply (rule conjI)
    apply (simp add: pred_tcb_at'_def)
@@ -547,12 +524,12 @@ lemma (in delete_one) cancelIPC_ReplyCap_corres:
               and Q'="\<lambda>_. invs' and st_tcb_at' awaiting_reply' t"
                in corres_underlying_split)
      apply (rule corres_guard_imp)
-       apply (rule threadset_corresT)
+       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: tcb_cte_cases_def cteSizeBits_def)
        apply (simp add: exst_same_def)
-      apply (clarsimp simp: st_tcb_at_tcb_at)
+      apply (fastforce simp: st_tcb_at_tcb_at)
      apply clarsimp
     defer
     apply (wp thread_set_invs_trivial thread_set_no_change_tcb_state
@@ -609,7 +586,7 @@ lemma (in delete_one) cancelIPC_ReplyCap_corres:
 qed
 
 lemma (in delete_one) cancel_ipc_corres:
-  "corres dc (einvs and tcb_at t) (invs' and tcb_at' t)
+  "corres dc (einvs and tcb_at t) invs'
       (cancel_ipc t) (cancelIPC t)"
   apply (simp add: cancel_ipc_def cancelIPC_def Let_def)
   apply (rule corres_guard_imp)
@@ -639,7 +616,7 @@ lemma (in delete_one) cancel_ipc_corres:
     apply (rule hoare_strengthen_post)
      apply (rule gts_sp'[where P="\<top>"])
     apply (clarsimp elim!: pred_tcb'_weakenE)
-   apply simp
+   apply fastforce
   apply simp
   done
 
@@ -663,24 +640,20 @@ lemma setEndpoint_utr[wp]:
 declare cart_singleton_empty [simp]
 declare cart_singleton_empty2[simp]
 
-crunch ksQ[wp]: setNotification "\<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*)
 
+crunches setNotification
+  for sym_heap_sched_pointers[wp]: sym_heap_sched_pointers
+  and valid_bitmaps[wp]: valid_bitmaps
+  (wp: valid_bitmaps_lift)
+
 lemma cancelSignal_invs':
   "\<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> Invariants_H.valid_queues s; st_tcb_at' (Not \<circ> runnable') t s \<rbrakk>
-                                         \<Longrightarrow> \<forall>x. t \<notin> set (ksReadyQueues s x)"
-      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>"
@@ -691,9 +664,9 @@ lemma cancelSignal_invs':
     show ?thesis
       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 setNotification_ksQ] sts_valid_queues
+                hoare_vcg_all_lift
                 setThreadState_ct_not_inQ NTFNSN
-                hoare_vcg_all_lift setNotification_ksQ
+                hoare_vcg_all_lift
               | simp add: valid_tcb_state'_def list_case_If split del: if_split)+
        prefer 2
        apply assumption
@@ -701,8 +674,6 @@ lemma cancelSignal_invs':
        apply (rule get_ntfn_sp')
       apply (rename_tac rv s)
       apply (clarsimp simp: pred_tcb_at')
-      apply (frule NIQ)
-       apply (clarsimp simp: pred_tcb_at'_def obj_at'_def)
       apply (rule conjI)
        apply (clarsimp simp: valid_ntfn'_def)
        apply (case_tac "ntfnObj rv", simp_all add: isWaitingNtfn_def)
@@ -742,9 +713,10 @@ lemma cancelSignal_invs':
                                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 r")
+       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)
@@ -802,23 +774,25 @@ lemma setEndpoint_ct_not_inQ[wp]:
   done
 
 lemma setEndpoint_ksDomScheduleIdx[wp]:
-  "\<lbrace>\<lambda>s. P (ksDomScheduleIdx s)\<rbrace> setEndpoint ptr ep \<lbrace>\<lambda>_ s. P (ksDomScheduleIdx s)\<rbrace>"
+  "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
 
+crunches 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 NIQ: "\<And>s. \<lbrakk> Invariants_H.valid_queues s; st_tcb_at' (Not \<circ> runnable') t s \<rbrakk>
-                                       \<Longrightarrow> \<forall>x. t \<notin> set (ksReadyQueues s x)"
-    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 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>"
@@ -843,8 +817,8 @@ proof -
     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]
-              sts_valid_queues setThreadState_ct_not_inQ EPSCHN
-              hoare_vcg_all_lift setNotification_ksQ
+              setThreadState_ct_not_inQ EPSCHN
+              hoare_vcg_all_lift
               | simp add: valid_tcb_state'_def split del: if_split
               | wpc)+
      prefer 2
@@ -852,14 +826,14 @@ proof -
     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 (frule NIQ)
-     apply (erule pred_tcb'_weakenE, fastforce)
     apply (clarsimp, rule conjI)
      apply (auto simp: pred_tcb_at'_def obj_at'_def)[1]
     apply (rule conjI)
@@ -1040,37 +1014,12 @@ crunch ksCurDomain[wp]: cancelSignal "\<lambda>s. P (ksCurDomain s)"
 
 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 tcbSchedEnqueue_not_st:
-  "(\<And>tcb st qd. P (tcb\<lparr>tcbState := st, tcbQueued := qd\<rparr>) \<longleftrightarrow> P tcb)
-     \<Longrightarrow> \<lbrace>obj_at' P t'\<rbrace> tcbSchedEnqueue t \<lbrace>\<lambda>_. obj_at' P t'\<rbrace>"
-apply (simp add: tcbSchedEnqueue_def unless_def)
-apply (wp threadGet_wp | simp)+
-apply (clarsimp simp: obj_at'_def)
-apply (case_tac obja)
-apply fastforce
-done
-
-(* FIXME move *)
-lemma setThreadState_not_st:
-  "(\<And>tcb st qd. P (tcb\<lparr>tcbState := st, tcbQueued := qd\<rparr>) \<longleftrightarrow> P tcb)
-     \<Longrightarrow> \<lbrace>obj_at' P t'\<rbrace> setThreadState st t \<lbrace>\<lambda>_. obj_at' P t'\<rbrace>"
-apply (simp add: setThreadState_def rescheduleRequired_def)
-apply (wp hoare_vcg_conj_lift tcbSchedEnqueue_not_st
-     | wpc
-     | rule hoare_drop_imps
-     | simp)+
-apply (clarsimp simp: obj_at'_def)
-apply (case_tac obj)
-apply fastforce
-done
+  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:
@@ -1083,15 +1032,6 @@ lemma setBoundNotification_not_ntfn:
      | simp)+
   done
 
-(* FIXME move *)
-lemma setThreadState_tcb_in_cur_domain'[wp]:
-  "\<lbrace>tcb_in_cur_domain' t'\<rbrace> setThreadState 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 setThreadState_not_st | simp)+
-done
-
 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)
@@ -1100,22 +1040,24 @@ lemma setBoundNotification_tcb_in_cur_domain'[wp]:
   apply (wp 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> \<lbrace>obj_at' P t'\<rbrace> cancelSignal t word \<lbrace>\<lambda>_. obj_at' P t'\<rbrace>"
-apply (simp add: cancelSignal_def setNotification_def)
-apply (wp setThreadState_not_st getNotification_wp | wpc | simp)+
-done
+lemma setThreadState_tcbDomain_obj_at'[wp]:
+  "setThreadState ts t \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  unfolding setThreadState_def
+  by wpsimp
+
+crunches 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 (simp add: cancelIPC_def Let_def)
-apply (wp hoare_vcg_conj_lift
-          setThreadState_not_st delete_one_tcbDomain_obj_at' cancelSignal_tcb_obj_at'
-     | wpc
-     | rule hoare_drop_imps
-     | simp add: getThreadReplySlot_def o_def if_fun_split)+
-done
+  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':
   "\<lbrace>tcb_in_cur_domain' t'\<rbrace> cancelIPC t \<lbrace>\<lambda>_. tcb_in_cur_domain' t'\<rbrace>"
@@ -1218,191 +1160,61 @@ lemma setNotification_weak_sch_act_wf[wp]:
 lemmas ipccancel_weak_sch_act_wfs
     = weak_sch_act_wf_lift[OF _ setCTE_pred_tcb_at']
 
-lemma tcbSchedDequeue_corres':
-  "corres dc (is_etcb_at t) (tcb_at' t and valid_inQ_queues) (tcb_sched_action (tcb_sched_dequeue) t) (tcbSchedDequeue t)"
-  apply (simp only: tcbSchedDequeue_def tcb_sched_action_def)
-  apply (rule corres_symb_exec_r[OF _ _ threadGet_inv, where Q'="\<lambda>rv. tcb_at' t and valid_inQ_queues and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"])
-    defer
-    apply (wp threadGet_obj_at', simp, simp)
-   apply (wp, simp)
-  apply (case_tac queued)
-   defer
-   apply (simp add: unless_def when_def)
-   apply (rule corres_no_failI)
-    apply (wp)
-   apply (clarsimp simp: in_monad ethread_get_def get_etcb_def set_tcb_queue_def is_etcb_at_def state_relation_def gets_the_def gets_def get_def return_def bind_def assert_opt_def get_tcb_queue_def modify_def put_def)
-   apply (subgoal_tac "t \<notin> set (ready_queues a (tcb_domain y) (tcb_priority y))")
-    prefer 2
-    apply (force simp: tcb_sched_dequeue_def valid_inQ_queues_def
-           ready_queues_relation_def obj_at'_def inQ_def projectKO_eq project_inject)
-   apply (simp add: ready_queues_relation_def)
-  apply (simp add: unless_def when_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[where r'="(=)"])
-       apply (rule ethreadget_corres, simp add: etcb_relation_def)
-      apply (simp split del: if_split)
-      apply (rule corres_split_eqr)
-         apply (rule ethreadget_corres, simp add: etcb_relation_def)
-        apply (rule corres_split_eqr[OF getQueue_corres])
-          apply (simp split del: if_split)
-          apply (subst bind_return_unit, rule corres_split[where r'=dc])
-             apply (simp add: tcb_sched_dequeue_def)
-             apply (rule setQueue_corres)
-            apply (rule corres_split_noop_rhs)
-              apply (clarsimp, rule removeFromBitmap_corres_noop)
-             apply (simp add: dc_def[symmetric])
-             apply (rule threadSet_corres_noop, simp_all add: tcb_relation_def exst_same_def)[1]
-            apply (wp | simp)+
-  done
-
-lemma setQueue_valid_inQ_queues:
-  "\<lbrace>valid_inQ_queues
-      and (\<lambda>s. \<forall>t \<in> set ts. obj_at' (inQ d p) t s)
-      and K (distinct ts)\<rbrace>
-  setQueue d p ts
-  \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  apply (simp add: setQueue_def valid_inQ_queues_def)
-  apply wp
-  apply clarsimp
-  done
-
-lemma threadSet_valid_inQ_queues:
-  "\<lbrace>valid_inQ_queues and (\<lambda>s. \<forall>d p. (\<exists>tcb. (inQ d p tcb) \<and> \<not>(inQ d p (f tcb)))
-                        \<longrightarrow> obj_at' (\<lambda>tcb. (inQ d p tcb) \<and> \<not>(inQ d p (f tcb))) t s
-                        \<longrightarrow> t \<notin> set (ksReadyQueues s (d, p)))\<rbrace>
-     threadSet f t
-   \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (simp add: threadSet_def)
-  apply wp
-   apply (simp add: valid_inQ_queues_def pred_tcb_at'_def)
-   apply (wp setObject_queues_unchanged_tcb
-             hoare_Ball_helper
-             hoare_vcg_all_lift
-             setObject_tcb_strongest)[1]
-  apply (wp getObject_tcb_wp)
-  apply (clarsimp simp: valid_inQ_queues_def pred_tcb_at'_def)
-  apply (clarsimp simp: obj_at'_def projectKOs)
-  apply (fastforce)
-  done
-
-(* reorder the threadSet before the setQueue, useful for lemmas that don't refer to bitmap *)
-lemma setQueue_after_addToBitmap:
-  "(setQueue d p q >>= (\<lambda>rv. (when P (addToBitmap d p)) >>= (\<lambda>rv. threadSet f t))) =
-   (when P (addToBitmap d p) >>= (\<lambda>rv. (threadSet f t) >>= (\<lambda>rv. setQueue d p q)))"
-  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 (simp add: threadSet_def getObject_def setObject_def
-                   loadObject_default_def bitmap_fun_defs
-                   split_def projectKO_def2 alignCheck_assert
-                   magnitudeCheck_assert updateObject_default_def)
-  apply (intro oblivious_bind, simp_all)
-  apply (clarsimp simp: bind_assoc)
-  done
-
-lemma tcbSchedEnqueue_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> tcbSchedEnqueue t \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def setQueue_after_addToBitmap)
-  apply (rule hoare_pre)
-   apply (rule_tac B="\<lambda>rv. valid_inQ_queues and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"
-                in hoare_seq_ext)
-    apply (rename_tac queued)
-    apply (case_tac queued, simp_all add: unless_def)[1]
-     apply (wp setQueue_valid_inQ_queues threadSet_valid_inQ_queues threadGet_wp
-               hoare_vcg_const_Ball_lift
-          | simp add: inQ_def bitmap_fun_defs
-          | fastforce simp: valid_inQ_queues_def inQ_def obj_at'_def)+
-  done
-
- (* prevents wp from splitting on the when; stronger technique than hoare_when_weak_wp
-    FIXME: possible to replace with hoare_when_weak_wp?
- *)
-definition
-  "removeFromBitmap_conceal d p q t \<equiv> when (null [x\<leftarrow>q . x \<noteq> t]) (removeFromBitmap d p)"
-
-lemma removeFromBitmap_conceal_valid_inQ_queues[wp]:
-  "\<lbrace> valid_inQ_queues \<rbrace> removeFromBitmap_conceal d p q t \<lbrace> \<lambda>_. valid_inQ_queues \<rbrace>"
-  unfolding valid_inQ_queues_def removeFromBitmap_conceal_def
-  by (wp|clarsimp simp: bitmap_fun_defs)+
-
-lemma rescheduleRequired_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> rescheduleRequired \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply wpsimp
-  done
-
-lemma sts_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> setThreadState st t \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (simp add: setThreadState_def)
-  apply (wp threadSet_valid_inQ_queues [THEN hoare_strengthen_post])
-   apply (clarsimp simp: sch_act_simple_def Invariants_H.valid_queues_def inQ_def)+
-  done
-
 lemma updateObject_ep_inv:
   "\<lbrace>P\<rbrace> updateObject (obj::endpoint) ko p q n \<lbrace>\<lambda>rv. P\<rbrace>"
   by simp (rule updateObject_default_inv)
 
-lemma sbn_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> setBoundNotification ntfn t \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (simp add: setBoundNotification_def)
-  apply (wp threadSet_valid_inQ_queues [THEN hoare_strengthen_post])
-   apply (clarsimp simp: sch_act_simple_def Invariants_H.valid_queues_def inQ_def)+
+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>"
+  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 setEndpoint_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> setEndpoint ptr ep \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (unfold setEndpoint_def)
-  apply (rule setObject_ep_pre)
-  apply (simp add: valid_inQ_queues_def)
-  apply (wp hoare_Ball_helper hoare_vcg_all_lift setObject_queues_unchanged[OF updateObject_ep_inv])
-  apply simp
-  done
+crunches asUser
+  for valid_sched_pointers[wp]: valid_sched_pointers
+  (wp: crunch_wps)
 
-lemma set_ntfn_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> setNotification ptr ntfn \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  apply (unfold setNotification_def)
-  apply (rule setObject_ntfn_pre)
-  apply (simp add: valid_inQ_queues_def)
-  apply (wp hoare_Ball_helper hoare_vcg_all_lift)
-    apply (clarsimp simp: updateObject_default_def in_monad)
-    apply (wp updateObject_default_inv | simp)+
-    done
+crunches set_thread_state
+  for in_correct_ready_q[wp]: in_correct_ready_q
+  (wp: crunch_wps ignore_del: set_thread_state_ext)
 
-crunch valid_inQ_queues[wp]: cancelSignal valid_inQ_queues
-  (simp: updateObject_tcb_inv crunch_simps wp: crunch_wps)
+crunches set_thread_state_ext
+  for ready_qs_distinct[wp]: ready_qs_distinct
+  (wp: crunch_wps ignore_del: set_thread_state_ext)
 
-lemma (in delete_one_conc_pre) cancelIPC_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> cancelIPC t \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  apply (simp add: cancelIPC_def Let_def getThreadReplySlot_def)
-  apply (wp hoare_drop_imps delete_one_inQ_queues threadSet_valid_inQ_queues | wpc | simp add:if_apply_def2 Fun.comp_def)+
-   apply (clarsimp simp: valid_inQ_queues_def inQ_def)+
-   done
+lemma set_thread_state_ready_qs_distinct[wp]:
+  "set_thread_state ref ts \<lbrace>ready_qs_distinct\<rbrace>"
+  unfolding set_thread_state_def
+  apply (wpsimp wp: set_object_wp)
+  by (clarsimp simp: ready_qs_distinct_def)
 
-lemma valid_queues_inQ_queues:
-  "Invariants_H.valid_queues s \<Longrightarrow> valid_inQ_queues s"
-  by (force simp: Invariants_H.valid_queues_def valid_inQ_queues_def obj_at'_def
-                  valid_queues_no_bitmap_def)
+lemma as_user_ready_qs_distinct[wp]:
+  "as_user tptr f \<lbrace>ready_qs_distinct\<rbrace>"
+  unfolding as_user_def
+  apply (wpsimp wp: set_object_wp)
+  by (clarsimp simp: ready_qs_distinct_def)
 
-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>"
-  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 do_extended_op_pspace_aligned[wp]:
+  "do_extended_op f \<lbrace>pspace_aligned\<rbrace>"
+  by (wpsimp simp: do_extended_op_def)
 
-lemma asUser_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> asUser t f \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  unfolding valid_inQ_queues_def Ball_def
-  apply (wpsimp wp: hoare_vcg_all_lift)
-    defer
-    apply (wp asUser_ksQ)
-   apply assumption
-  apply (simp add: inQ_def[abs_def] obj_at'_conj)
-  apply (rule hoare_convert_imp)
-   apply (wp asUser_ksQ)
-  apply wp
-  done
+lemma do_extended_op_pspace_distinct[wp]:
+  "do_extended_op f \<lbrace>pspace_distinct\<rbrace>"
+  by (wpsimp simp: do_extended_op_def)
+
+context begin interpretation Arch . (* FIXME: arch_split *)
+
+crunches arch_post_cap_deletion
+  for pspace_aligned[wp]: pspace_aligned
+  and pspace_distinct[wp]: pspace_distinct
+  (wp: crunch_wps simp: crunch_simps)
+
+end
+
+crunches cancel_ipc
+  for pspace_aligned[wp]: pspace_aligned
+  and pspace_distinct[wp]: pspace_distinct
+  (wp: crunch_wps simp: crunch_simps)
 
 lemma (in delete_one) suspend_corres:
   "corres dc (einvs and tcb_at t) (invs' and tcb_at' t)
@@ -1425,19 +1237,19 @@ lemma (in delete_one) suspend_corres:
            apply (rule corres_return_trivial)
           apply (rule corres_split_nor[OF setThreadState_corres])
              apply simp
-            apply (rule tcbSchedDequeue_corres')
+            apply (rule tcbSchedDequeue_corres, simp)
            apply wpsimp
-          apply wp
-         apply wpsimp
-          apply (wpsimp simp: update_restart_pc_def updateRestartPC_def)+
-       apply (rule hoare_post_imp[where Q = "\<lambda>rv s. tcb_at t s \<and> is_etcb_at t s"])
-        apply simp
-       apply (wp | simp)+
-      apply (rule hoare_post_imp[where Q = "\<lambda>rv s. tcb_at' t s \<and> valid_inQ_queues s"])
-       apply (wpsimp simp: valid_queues_inQ_queues)
-      apply wp+
-   apply (force simp: valid_sched_def tcb_at_is_etcb_at)
-  apply (clarsimp simp add: invs'_def valid_state'_def valid_queues_inQ_queues)
+          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
+  apply simp
   done
 
 lemma no_fail_switchFpuOwner[wp]:
@@ -1489,22 +1301,6 @@ lemma (in delete_one_conc_pre) cancelIPC_it[wp]:
   apply (wp hoare_drop_imps delete_one_it | wpc | simp add:if_apply_def2 Fun.comp_def)+
   done
 
-crunch ksQ: threadGet "\<lambda>s. P (ksReadyQueues s p)"
-
-lemma tcbSchedDequeue_notksQ:
-  "\<lbrace>\<lambda>s. t' \<notin> set(ksReadyQueues s p)\<rbrace>
-    tcbSchedDequeue t
-   \<lbrace>\<lambda>_ s. t' \<notin> set(ksReadyQueues s p)\<rbrace>"
-  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+
-     apply clarsimp
-     apply (rule_tac Q="\<lambda>_ s. t' \<notin> set(ksReadyQueues s p)" in hoare_post_imp)
-      apply (wp | clarsimp)+
-  done
-
 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
@@ -1554,198 +1350,9 @@ lemma setBoundNotification_oa_queued:
       by (simp add: not_obj_at' comp_def, wp hoare_convert_imp pos)
   qed
 
-lemma tcbSchedDequeue_ksQ_distinct[wp]:
-  "\<lbrace>\<lambda>s. distinct (ksReadyQueues s p)\<rbrace>
-    tcbSchedDequeue t
-   \<lbrace>\<lambda>_ s. distinct (ksReadyQueues s p)\<rbrace>"
-  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+
-     apply (rule_tac Q="\<lambda>_ s. distinct (ksReadyQueues s p)" in hoare_post_imp)
-      apply (clarsimp | wp)+
-  done
-
-lemma sts_valid_queues_partial:
-  "\<lbrace>Invariants_H.valid_queues and sch_act_simple\<rbrace>
-    setThreadState st t
-   \<lbrace>\<lambda>_ s. \<forall>t' d p.
-            (t' \<in> set(ksReadyQueues s (d, p)) \<longrightarrow>
-             (obj_at' (\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d \<and> tcbPriority tcb = p) t' s
-              \<and> (t' \<noteq> t \<longrightarrow> st_tcb_at' runnable' t' s)))
-            \<and> distinct (ksReadyQueues s (d, p))\<rbrace>"
-  (is "\<lbrace>_\<rbrace> _ \<lbrace>\<lambda>_ s. \<forall>t' d p. ?OA t' d p s \<and> ?DISTINCT d p s \<rbrace>")
-  apply (rule_tac Q="\<lambda>_ s. (\<forall>t' d p. ?OA t' d p s) \<and> (\<forall>d p. ?DISTINCT d p s)"
-           in hoare_post_imp)
-   apply (clarsimp)
-  apply (rule hoare_conjI)
-   apply (rule_tac Q="\<lambda>s. \<forall>t' d p.
-             ((t'\<in>set(ksReadyQueues s (d, p))
-               \<or> \<not> (sch_act_simple s))
-                  \<longrightarrow> (obj_at'(\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d \<and> tcbPriority tcb = p) t' s
-                       \<and> st_tcb_at' runnable' t' s))" in hoare_pre_imp)
-    apply (fastforce simp: Invariants_H.valid_queues_def valid_queues_no_bitmap_def
-                           pred_tcb_at'_def obj_at'_def inQ_def)
-   apply (rule hoare_vcg_all_lift)+
-    apply (rule hoare_convert_imp)
-     including classic_wp_pre
-     apply (wp sts_ksQ setThreadState_oa_queued hoare_impI sts_pred_tcb_neq'
-            | clarsimp)+
-  apply (rule_tac Q="\<lambda>s. \<forall>d p. ?DISTINCT d p s \<and> sch_act_simple s" in hoare_pre_imp)
-   apply (clarsimp simp: Invariants_H.valid_queues_def valid_queues_no_bitmap_def)
-  apply (wp hoare_vcg_all_lift sts_ksQ)
-  apply (clarsimp)
-  done
-
-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 Q="(\<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)
-  done
-
-lemma sts_invs_minor'_no_valid_queues:
-  "\<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. runnable' st \<and> obj_at' tcbQueued t s \<longrightarrow> st_tcb_at' runnable' t s)
-      and sch_act_simple
-      and invs'\<rbrace>
-    setThreadState st t
-   \<lbrace>\<lambda>_ s. (\<forall>t' d p.
-            (t' \<in> set(ksReadyQueues s (d, p)) \<longrightarrow>
-             (obj_at' (\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d \<and> tcbPriority tcb = p) t' s
-              \<and> (t' \<noteq> t \<longrightarrow> st_tcb_at' runnable' t' s)))
-            \<and> distinct (ksReadyQueues s (d, p)) \<and> (maxDomain < d \<or> maxPriority < p \<longrightarrow> ksReadyQueues s (d, p) = [])) \<and>
-         valid_bitmapQ s \<and>
-         bitmapQ_no_L2_orphans s \<and>
-         bitmapQ_no_L1_orphans s \<and>
-         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_ioports' s \<and>
-         valid_machine_state' s \<and>
-         irqs_masked' s \<and>
-         valid_queues' s \<and>
-         ct_not_inQ s \<and>
-         ct_idle_or_in_cur_domain' s \<and>
-         pspace_domain_valid s \<and>
-         ksCurDomain s \<le> maxDomain \<and>
-         valid_dom_schedule' s \<and>
-         untyped_ranges_zero' s \<and>
-         cur_tcb' s \<and>
-         tcb_at' t s\<rbrace>"
-  apply (simp add: invs'_def valid_state'_def valid_queues_def)
-  apply (wp sts_valid_queues_partial sts_ksQ
-            setThreadState_oa_queued sts_st_tcb_at'_cases
-            irqs_masked_lift
-            valid_irq_node_lift
-            setThreadState_ct_not_inQ
-            sts_valid_bitmapQ_sch_act_simple
-            sts_valid_bitmapQ_no_L2_orphans_sch_act_simple
-            sts_valid_bitmapQ_no_L1_orphans_sch_act_simple
-            hoare_vcg_conj_lift hoare_vcg_imp_lift hoare_vcg_all_lift)+
-  apply (clarsimp simp: disj_imp)
-  apply (intro conjI)
-        apply (clarsimp simp: valid_queues_def)
-        apply (rule conjI, clarsimp)
-         apply (drule valid_queues_no_bitmap_objD, assumption)
-         apply (clarsimp simp: inQ_def comp_def)
-         apply (rule conjI)
-          apply (erule obj_at'_weaken)
-          apply (simp add: inQ_def)
-         apply (clarsimp simp: st_tcb_at'_def)
-         apply (erule obj_at'_weaken)
-         apply (simp add: inQ_def)
-        apply (simp add: valid_queues_no_bitmap_def)
-       apply clarsimp
-     apply (clarsimp simp: st_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 (fastforce simp: valid_tcb_state'_def
-                  split: Structures_H.thread_state.splits)
-    apply (clarsimp dest!: st_tcb_at_state_refs_ofD'
-                    elim!: rsubst[where P=sym_refs]
-                   intro!: ext)
-   apply (fastforce simp: valid_queues_def inQ_def pred_tcb_at' pred_tcb_at'_def
-                   elim!: st_tcb_ex_cap'' obj_at'_weakenE)+
-  done
-
-crunch ct_idle_or_in_cur_domain'[wp]: tcbSchedDequeue ct_idle_or_in_cur_domain'
-
-lemma tcbSchedDequeue_invs'_no_valid_queues:
-   "\<lbrace>\<lambda>s. (\<forall>t' d p.
-            (t' \<in> set(ksReadyQueues s (d, p)) \<longrightarrow>
-             (obj_at' (\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d \<and> tcbPriority tcb = p) t' s
-              \<and> (t' \<noteq> t \<longrightarrow> st_tcb_at' runnable' t' s)))
-            \<and> distinct (ksReadyQueues s (d, p)) \<and> (maxDomain < d \<or> maxPriority < p \<longrightarrow> ksReadyQueues s (d, p) = [])) \<and>
-         valid_bitmapQ s \<and>
-         bitmapQ_no_L2_orphans s \<and>
-         bitmapQ_no_L1_orphans s \<and>
-         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_ioports' s \<and>
-         valid_machine_state' s \<and>
-         irqs_masked' s \<and>
-         valid_queues' s \<and>
-         ct_not_inQ s \<and>
-         ct_idle_or_in_cur_domain' s \<and>
-         pspace_domain_valid s \<and>
-         ksCurDomain s \<le> maxDomain \<and>
-         valid_dom_schedule' s \<and>
-         untyped_ranges_zero' s \<and>
-         cur_tcb' s \<and>
-         tcb_at' t s\<rbrace>
-    tcbSchedDequeue t
-   \<lbrace>\<lambda>_. invs' \<rbrace>"
-  apply (simp add: invs'_def valid_state'_def)
-  apply (wp tcbSchedDequeue_valid_queues_weak valid_irq_handlers_lift
-            valid_irq_node_lift valid_irq_handlers_lift'
-            tcbSchedDequeue_irq_states irqs_masked_lift cur_tcb_lift
-            untyped_ranges_zero_lift
-         | clarsimp simp add: cteCaps_of_def valid_queues_def o_def)+
-  apply (rule conjI)
-   apply (fastforce simp: obj_at'_def inQ_def st_tcb_at'_def valid_queues_no_bitmap_except_def)
-  apply (rule conjI, clarsimp simp: correct_queue_def)
-  apply (fastforce simp: valid_pspace'_def intro: obj_at'_conjI
-                   elim: valid_objs'_maxDomain valid_objs'_maxPriority)
-  done
-
-lemmas sts_tcbSchedDequeue_invs' =
-  sts_invs_minor'_no_valid_queues
-  tcbSchedDequeue_invs'_no_valid_queues
+crunches 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>"
@@ -1757,11 +1364,14 @@ lemma (in delete_one_conc) suspend_invs'[wp]:
   "\<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 (wp sts_tcbSchedDequeue_invs')
-      apply (simp add: updateRestartPC_def | strengthen no_refs_simple_strg')+
-      prefer 2
-      apply (wpsimp wp: hoare_drop_imps hoare_vcg_imp_lift'
-                 | strengthen no_refs_simple_strg')+
+  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]:
@@ -1805,109 +1415,6 @@ lemma (in delete_one_conc_pre) suspend_st_tcb_at':
 lemmas (in delete_one_conc_pre) suspend_makes_simple' =
        suspend_st_tcb_at' [where P=simple', simplified]
 
-lemma valid_queues_not_runnable'_not_ksQ:
-  assumes "Invariants_H.valid_queues s" and "st_tcb_at' (Not \<circ> runnable') t s"
-  shows   "\<forall>d p. t \<notin> set (ksReadyQueues s (d, p))"
-  using assms
-  apply -
-  apply (clarsimp simp: Invariants_H.valid_queues_def valid_queues_no_bitmap_def pred_tcb_at'_def)
-  apply (erule_tac x=d in allE)
-  apply (erule_tac x=p in allE)
-  apply (clarsimp)
-  apply (drule(1) bspec)
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-declare valid_queues_not_runnable'_not_ksQ[OF ByAssum, simp]
-
-lemma cancelSignal_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues and st_tcb_at' (Not \<circ> runnable') t\<rbrace>
-   cancelSignal t ae \<lbrace>\<lambda>_. Invariants_H.valid_queues \<rbrace>"
-  apply (simp add: cancelSignal_def)
-  apply (wp sts_valid_queues)
-      apply (rule_tac Q="\<lambda>_ s. \<forall>p. t \<notin> set (ksReadyQueues s p)" in hoare_post_imp, simp)
-      apply (wp hoare_vcg_all_lift)
-     apply (wpc)
-      apply (wp)+
-   apply (rule_tac Q="\<lambda>_ s. Invariants_H.valid_queues s \<and> (\<forall>p. t \<notin> set (ksReadyQueues s p))" in hoare_post_imp)
-    apply (clarsimp)
-   apply (wp)
-  apply (clarsimp)
-  done
-
-lemma (in delete_one_conc_pre) cancelIPC_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)\<rbrace>
-   cancelIPC t \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: cancelIPC_def Let_def getThreadReplySlot_def
-             cong: Structures_H.thread_state.case_cong list.case_cong)
-  apply (rule hoare_seq_ext [OF _ gts_sp'])
-  apply (rule hoare_pre)
-   apply (wpc
-           | wp hoare_vcg_conj_lift delete_one_queues threadSet_valid_queues
-                threadSet_valid_objs' sts_valid_queues setEndpoint_ksQ
-                hoare_vcg_all_lift threadSet_sch_act threadSet_weak_sch_act_wf
-           | simp add: o_def if_apply_def2 inQ_def
-           | rule hoare_drop_imps
-           | clarsimp simp: valid_tcb'_def tcb_cte_cases_def
-                     elim!: pred_tcb'_weakenE)+
-  apply (fastforce dest: valid_queues_not_runnable'_not_ksQ elim: pred_tcb'_weakenE)
-  done
-
-(* FIXME: move to Schedule_R *)
-lemma tcbSchedDequeue_nonq[wp]:
-  "\<lbrace>Invariants_H.valid_queues and tcb_at' t and K (t = t')\<rbrace>
-    tcbSchedDequeue t \<lbrace>\<lambda>_ s. \<forall>d p. t' \<notin> set (ksReadyQueues s (d, p))\<rbrace>"
-  apply (rule hoare_gen_asm)
-  apply (simp add: tcbSchedDequeue_def)
-  apply (wp threadGet_wp|simp)+
-  apply (fastforce simp: Invariants_H.valid_queues_def valid_queues_no_bitmap_def obj_at'_def projectKOs inQ_def)
-  done
-
-lemma sts_ksQ_oaQ:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace>
-   setThreadState st t
-   \<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>"
-  (is "\<lbrace>_\<rbrace> _ \<lbrace>\<lambda>_. ?POST\<rbrace>")
-  proof -
-    have RR: "\<lbrace>sch_act_simple and ?POST\<rbrace> rescheduleRequired \<lbrace>\<lambda>_. ?POST\<rbrace>"
-      apply (simp add: rescheduleRequired_def)
-      apply (wp)
-        apply (clarsimp)
-       apply (rule_tac
-                Q="(\<lambda>s. action = ResumeCurrentThread \<or> action = ChooseNewThread) and ?POST"
-                                                               in hoare_pre_imp, assumption)
-       apply (case_tac action)
-         apply (clarsimp)+
-      apply (wp)
-      apply (clarsimp simp: sch_act_simple_def)
-      done
-    show ?thesis
-      apply (simp add: setThreadState_def)
-      apply (wp RR)
-      apply (rule_tac Q="\<lambda>_. ?POST" in hoare_post_imp)
-       apply (clarsimp simp add: sch_act_simple_def)
-      apply (wp hoare_convert_imp)
-      apply (clarsimp simp: Invariants_H.valid_queues_def valid_queues_no_bitmap_def)
-      apply (drule_tac x=d in spec)
-      apply (drule_tac x=p in spec)
-      apply (fastforce dest: bspec elim!: obj_at'_weakenE simp: inQ_def)
-      done
-  qed
-
-lemma (in delete_one_conc_pre) suspend_nonq:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and tcb_at' t
-                 and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
-                 and (\<lambda>s. t \<noteq> ksIdleThread s) and K (t = t')\<rbrace>
-     suspend t
-   \<lbrace>\<lambda>rv s. \<forall>d p. t' \<notin> set (ksReadyQueues s (d, p))\<rbrace>"
-  apply (rule hoare_gen_asm)
-  apply (simp add: suspend_def)
-  unfolding updateRestartPC_def
-  apply (wp hoare_allI tcbSchedDequeue_t_notksQ sts_ksQ_oaQ)
-    apply wpsimp+
-  done
-
 lemma suspend_makes_inactive:
   "\<lbrace>K (t = t')\<rbrace> suspend t \<lbrace>\<lambda>rv. st_tcb_at' ((=) Inactive) t'\<rbrace>"
   apply (cases "t = t'", simp_all)
@@ -1918,31 +1425,21 @@ lemma suspend_makes_inactive:
 declare threadSet_sch_act_sane [wp]
 declare sts_sch_act_sane [wp]
 
-lemma tcbSchedEnqueue_ksQset_weak:
-  "\<lbrace>\<lambda>s. t' \<in> set (ksReadyQueues s p)\<rbrace>
-   tcbSchedEnqueue t
-   \<lbrace>\<lambda>_ s. t' \<in> set (ksReadyQueues s p)\<rbrace>" (is "\<lbrace>?PRE\<rbrace> _ \<lbrace>_\<rbrace>")
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply (wp hoare_vcg_conj_lift hoare_vcg_imp_lift hoare_vcg_if_lift)
-  apply (rule_tac Q="\<lambda>_. ?PRE" in hoare_post_imp, ((wp | clarsimp)+))+
-  done
-
 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 tcbSchedEnqueue_ct', wp, simp)
+  by (rule hoare_weaken_pre, wps, wp, simp)
 
 lemma sts_sch_act_not_ct[wp]:
   "\<lbrace>\<lambda>s. sch_act_not (ksCurThread s) s\<rbrace>
    setThreadState st t \<lbrace>\<lambda>_ s. sch_act_not (ksCurThread s) s\<rbrace>"
-  by (rule hoare_weaken_pre, wps tcbSchedEnqueue_ct', wp, simp)
+  by (rule hoare_weaken_pre, wps, wp, simp)
 
 text \<open>Cancelling all IPC in an endpoint or notification object\<close>
 
 lemma ep_cancel_corres_helper:
-  "corres dc ((\<lambda>s. \<forall>t \<in> set list. tcb_at t s) and valid_etcbs)
-             ((\<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')
+  "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
@@ -1951,28 +1448,36 @@ lemma ep_cancel_corres_helper:
                         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 Q'="\<lambda>s. \<forall>t \<in> set list. tcb_at' t s" in corres_cross_add_guard)
+   apply (fastforce elim: tcb_at_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 (rule corres_guard_imp [OF setThreadState_corres])
-            apply simp
-           apply (simp add: valid_tcb_state_def)
-          apply simp
-         apply (wp sts_valid_queues)+
-       apply (force simp: tcb_at_is_etcb_at)
-      apply (fastforce elim: obj_at'_weakenE)
-     apply ((wp hoare_vcg_const_Ball_lift | simp)+)[1]
-    apply (rule hoare_pre)
-     apply (wp hoare_vcg_const_Ball_lift
-               weak_sch_act_wf_lift_linear sts_st_tcb' setThreadState_not_st
-               sts_valid_queues tcbSchedEnqueue_not_st
-          | simp)+
-    apply (auto elim: obj_at'_weakenE simp: valid_tcb_state'_def)
+         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
 
+crunches 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 ep_cancel_corres:
   "corres dc (invs and valid_sched and ep_at ep) (invs' and ep_at' ep)
              (cancel_all_ipc ep) (cancelAllIPC ep)"
@@ -1980,10 +1485,10 @@ proof -
   have P:
     "\<And>list.
      corres dc (\<lambda>s. (\<forall>t \<in> set list. tcb_at t s) \<and> valid_pspace s \<and> ep_at ep s
-                        \<and> valid_etcbs s \<and> weak_valid_sched_action s)
+                        \<and> valid_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> Invariants_H.valid_queues s \<and> valid_queues' s \<and> valid_objs' 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;
@@ -2005,22 +1510,24 @@ proof -
         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 R="\<lambda>_ s. \<forall>x\<in>set list. tcb_at' x s \<and> valid_objs' s"
+      apply (rule_tac R="\<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 (rule hoare_name_pre_state)
-      apply ((wp hoare_vcg_const_Ball_lift mapM_x_wp'
-                sts_valid_queues setThreadState_not_st sts_st_tcb' tcbSchedEnqueue_not_st
-           | clarsimp
-           | fastforce elim: obj_at'_weakenE simp: valid_tcb_state'_def)+)[2]
-    apply (rule hoare_name_pre_state)
+      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 elim!: valid_objs_valid_tcbE))+
+           | (clarsimp simp: valid_ep'_def)
+           | (drule (1) bspec, clarsimp simp: valid_pspace'_def valid_tcb'_def valid_ep'_def
+           | strengthen valid_objs'_valid_tcbs'))+
+    apply fastforce
     done
 
   show ?thesis
     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
@@ -2048,6 +1555,8 @@ lemma cancelAllSignals_corres:
   "corres dc (invs and valid_sched and ntfn_at ntfn) (invs' and ntfn_at' ntfn)
              (cancel_all_signals ntfn) (cancelAllSignals ntfn)"
   apply (simp add: cancel_all_signals_def cancelAllSignals_def)
+  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+
@@ -2058,22 +1567,27 @@ lemma cancelAllSignals_corres:
       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 setThreadState_not_st
+                 weak_sch_act_wf_lift_linear
                  set_thread_state_runnable_weak_valid_sched_action
             | simp)+
       apply (rename_tac list)
-      apply (rule_tac R="\<lambda>_ s. (\<forall>x\<in>set list. tcb_at' x s) \<and> valid_objs' s"
+      apply (rule_tac R="\<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_queues setThreadState_not_st
-                  simp: valid_tcb_state'_def)
-     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')+
+      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 invs_psp_aligned
+                         invs_distinct valid_queues_ready_qs_distinct
+          | erule obj_at_valid_objsE | drule ko_at_valid_objs')+
   done
 
 lemma ep'_Idle_case_helper:
@@ -2126,9 +1640,8 @@ lemma cancel_all_invs'_helper:
    apply clarsimp
   apply (rule hoare_pre)
    apply (wp valid_irq_node_lift valid_irq_handlers_lift'' irqs_masked_lift valid_ioports_lift''
-             hoare_vcg_const_Ball_lift untyped_ranges_zero_lift
-             sts_valid_queues sts_st_tcb' setThreadState_not_st
-        | simp add: cteCaps_of_def o_def)+
+             hoare_vcg_const_Ball_lift untyped_ranges_zero_lift sts_st_tcb'
+          | simp add: cteCaps_of_def o_def)+
   apply (unfold fun_upd_apply Invariants_H.tcb_st_refs_of'_simps)
   apply clarsimp
   apply (intro conjI)
@@ -2136,7 +1649,7 @@ lemma cancel_all_invs'_helper:
                  elim!: rsubst[where P=sym_refs]
                  dest!: set_mono_suffix
                 intro!: ext
-       | (drule (1) bspec, clarsimp simp: valid_pspace'_def valid_tcb'_def elim!: valid_objs_valid_tcbE))+
+       | (drule (1) bspec, clarsimp simp: valid_pspace'_def valid_tcb'_def))+
   done
 
 lemma ep_q_refs_max:
@@ -2152,22 +1665,10 @@ lemma ep_q_refs_max:
              | case_tac ntfnptr)+
   done
 
-crunch ct' [wp]: setEndpoint "\<lambda>s. P (ksCurThread s)"
-  (wp: setObject_ep_ct)
-
-crunch ct' [wp]: setNotification "\<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 add: invs'_update_cnt | wpc)+
-  apply (clarsimp simp: invs'_def valid_state'_def)
   done
 
 lemma invs_rct_ct_activatable':
@@ -2294,6 +1795,7 @@ lemma rescheduleRequired_all_invs_but_ct_not_inQ:
 lemma cancelAllIPC_invs'[wp]:
   "\<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 hoare_seq_ext[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'
@@ -2322,6 +1824,7 @@ lemma cancelAllIPC_invs'[wp]:
 lemma cancelAllSignals_invs'[wp]:
   "\<lbrace>invs'\<rbrace> cancelAllSignals ntfn \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (simp add: cancelAllSignals_def)
+  apply (rule hoare_seq_ext[OF _ stateAssert_sp])
   apply (rule hoare_seq_ext [OF _ get_ntfn_sp'])
   apply (case_tac "ntfnObj ntfna", simp_all)
     apply (wp, simp)
@@ -2356,12 +1859,14 @@ crunch valid_objs'[wp]: tcbSchedEnqueue 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>"
+  "\<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 hoare_seq_ext[OF _ stateAssert_sp])
   apply (rule hoare_seq_ext [OF _ get_ep_sp'])
   apply (rule hoare_pre)
    apply (wp set_ep_valid_objs' setSchedulerAction_valid_objs')
-    apply (rule_tac Q="\<lambda>rv s. valid_objs' s \<and> (\<forall>x\<in>set (epQueue ep). tcb_at' x s)"
+    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)
@@ -2378,8 +1883,9 @@ lemma cancelAllIPC_valid_objs'[wp]:
   done
 
 lemma cancelAllSignals_valid_objs'[wp]:
-  "\<lbrace>valid_objs'\<rbrace> cancelAllSignals ntfn \<lbrace>\<lambda>rv. valid_objs'\<rbrace>"
+  "\<lbrace>valid_objs' and pspace_aligned' and pspace_distinct'\<rbrace> cancelAllSignals ntfn \<lbrace>\<lambda>rv. valid_objs'\<rbrace>"
   apply (simp add: cancelAllSignals_def)
+  apply (rule hoare_seq_ext[OF _ stateAssert_sp])
   apply (rule hoare_seq_ext [OF _ get_ntfn_sp'])
   apply (case_tac "ntfnObj ntfna", simp_all)
     apply (wp, simp)
@@ -2432,19 +1938,17 @@ 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>"
-  apply (simp add: setThreadState_def setQueue_def
-                   rescheduleRequired_def tcbSchedEnqueue_def
-                   unless_def bitmap_fun_defs
-             cong: scheduler_action.case_cong  cong del: if_cong
-            | wp | wpcw)+
-  done
+  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 unless_def)
+  apply (simp add: tcbSchedEnqueue_def tcbQueuePrepend_def unless_def)
   apply (wp | simp add: setQueue_def bitmap_fun_defs)+
   done
 
@@ -2478,19 +1982,41 @@ lemma setObject_ko_wp_at':
                      objBits_def[symmetric] ps_clear_upd
                      in_magnitude_check v projectKOs)
 
-lemma rescheduleRequired_unlive:
-  "\<lbrace>\<lambda>s. ko_wp_at' (Not \<circ> live') p s \<and> ksSchedulerAction s \<noteq> SwitchToThread p\<rbrace>
-      rescheduleRequired
+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>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | simp | wpc)+
-   apply (simp add: tcbSchedEnqueue_def unless_def
-                    threadSet_def setQueue_def threadGet_def)
-   apply (wp setObject_ko_wp_at getObject_tcb_wp
-            | simp add: objBits_simps' bitmap_fun_defs split del: if_split)+
-  apply (clarsimp simp: o_def)
-  apply (drule obj_at_ko_at')
-  apply clarsimp
+  by (clarsimp simp: threadSet_def valid_def getObject_def projectKOs
+                     setObject_def in_monad loadObject_default_def
+                     ko_wp_at'_def  split_def in_magnitude_check
+                     objBits_simps' updateObject_default_def
+                     ps_clear_upd)
+
+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 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
+
+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>"
+  supply comp_apply[simp del]
+  unfolding rescheduleRequired_def
+  apply (wpsimp wp: tcbSchedEnqueue_unlive_other)
   done
 
 lemmas setEndpoint_ko_wp_at'
@@ -2500,6 +2026,7 @@ 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>"
   apply (simp add: cancelAllIPC_def ep'_Idle_case_helper)
+  apply (rule hoare_seq_ext[OF _ stateAssert_sp])
   apply (rule hoare_seq_ext [OF _ get_ep_sp'])
   apply (rule hoare_pre)
    apply (wp cancelAll_unlive_helper setEndpoint_ko_wp_at'
@@ -2519,6 +2046,7 @@ lemma cancelAllSignals_unlive:
       \<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 (rule hoare_seq_ext[OF _ stateAssert_sp])
   apply (rule hoare_seq_ext [OF _ get_ntfn_sp'])
   apply (case_tac "ntfnObj ntfn", simp_all add: setNotification_def)
     apply wp
@@ -2584,25 +2112,22 @@ lemma cancelBadgedSends_filterM_helper':
   apply (rule hoare_pre)
    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' sts_valid_queues setThreadState_not_st valid_ioports_lift''
-             tcbSchedEnqueue_not_st
+             sts_st_tcb' valid_ioports_lift''
              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
+  apply (clarsimp simp: valid_pspace'_def cong: conj_cong)
   apply (intro conjI)
-      apply (clarsimp simp: valid_pspace'_def valid_tcb'_def elim!: valid_objs_valid_tcbE dest!: st_tcb_ex_cap'')
-     apply (fastforce dest!: 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)
-    apply (fastforce elim!: obj_atE'
-                      simp: state_refs_of'_def projectKOs tcb_bound_refs'_def
+    by (fastforce elim!: obj_atE'
+                  simp: state_refs_of'_def projectKOs tcb_bound_refs'_def
                             subsetD symreftype_inverse'
-                     split: if_split_asm)+
-  done
+                  split: if_split_asm)+
 
 lemmas cancelBadgedSends_filterM_helper
     = spec [where x=Nil, OF cancelBadgedSends_filterM_helper', simplified]
@@ -2612,7 +2137,8 @@ lemma cancelBadgedSends_invs[wp]:
   shows
   "\<lbrace>invs'\<rbrace> cancelBadgedSends epptr badge \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (simp add: cancelBadgedSends_def)
-  apply (rule hoare_seq_ext [OF _ get_ep_sp'])
+  apply (rule hoare_seq_ext[OF _ stateAssert_sp])
+  apply (rule hoare_seq_ext [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",
@@ -2645,10 +2171,21 @@ lemma cancelBadgedSends_invs[wp]:
 crunch state_refs_of[wp]: tcb_sched_action "\<lambda>s. P (state_refs_of s)"
   (ignore_del: tcb_sched_action)
 
+lemma setEndpoint_valid_tcbs'[wp]:
+  "setEndpoint ePtr val \<lbrace>valid_tcbs'\<rbrace>"
+  unfolding setEndpoint_def
+  supply projectKOs[simp]
+  apply (wpsimp wp: setObject_valid_tcbs'[where P=\<top>])
+   apply (clarsimp simp: updateObject_default_def monad_simps)
+  apply fastforce
+  done
+
 lemma cancelBadgedSends_corres:
   "corres dc (invs and valid_sched and ep_at epptr) (invs' and ep_at' epptr)
          (cancel_badged_sends epptr bdg) (cancelBadgedSends epptr bdg)"
   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 Q'=invs'])
@@ -2660,9 +2197,13 @@ lemma cancelBadgedSends_corres:
        apply (simp add: ep_relation_def)
       apply (rule corres_split_eqr[OF _ _ _ hoare_post_add[where R="\<lambda>_. valid_objs'"]])
          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 Q'="\<lambda>xs s. (\<forall>x \<in> set xs. tcb_at' x s) \<and> weak_sch_act_wf (ksSchedulerAction s) s \<and> Invariants_H.valid_queues s \<and> valid_queues' s \<and> valid_objs' s"
-                     in corres_mapM_list_all2[where r'="(=)"],
+                     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)
@@ -2672,59 +2213,61 @@ lemma cancelBadgedSends_corres:
                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])
+                 apply (rule corres_split[OF tcbSchedEnqueue_corres], simp)
                    apply (rule corres_trivial)
                    apply simp
                   apply wp+
-               apply simp
-               apply (wp sts_valid_queues gts_st_tcb_at)+
+                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: is_tcb_def)
-           apply simp
+           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_queues
+            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 (wp gts_st_tcb_at hoare_vcg_imp_lift mapM_wp'
-                 sts_st_tcb' sts_valid_queues
-                 set_thread_state_runnable_weak_valid_sched_action
-                 | clarsimp simp: valid_tcb_state'_def)+
-    apply (wp hoare_vcg_const_Ball_lift weak_sch_act_wf_lift_linear set_ep_valid_objs'
-               | simp)+
+       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 (clarsimp simp: st_tcb_at_refs_of_rev)
+   apply (rule conjI, fastforce)
+   apply clarsimp
    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 (drule ko_at_valid_objs', clarsimp)
    apply (simp add: projectKOs)
-  apply (clarsimp simp: valid_obj'_def valid_ep'_def invs_weak_sch_act_wf
-                        invs'_def valid_state'_def)
+  apply (fastforce simp: valid_obj'_def valid_ep'_def invs_weak_sch_act_wf
+                         invs'_def valid_state'_def)
   done
 
+crunches 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 (simp add: threadGet_def| wp getObject_tcb_wp)+
-    apply (rule hoare_strengthen_post, rule hoare_post_taut)
-    apply (fastforce simp: obj_at'_def projectKOs)
-   apply (rule hoare_post_taut)
-    apply wp+
-  done
-
-crunch unqueued: prepareThreadDelete "obj_at' (\<lambda>a. \<not> tcbQueued a) t"
-crunch inactive: prepareThreadDelete "st_tcb_at' ((=) Inactive) t'"
-crunch nonq: prepareThreadDelete " \<lambda>s. \<forall>d p. t' \<notin> set (ksReadyQueues s (d, p))"
+  unfolding suspend_def
+  by (wpsimp simp: comp_def wp: tcbSchedDequeue_not_tcbQueued)
+
+crunches prepareThreadDelete
+  for unqueued: "obj_at' (\<lambda>a. \<not> tcbQueued a) t"
+  and inactive: "st_tcb_at' ((=) Inactive) t'"
 
 end
 end
diff --git a/proof/refine/X64/Ipc_R.thy b/proof/refine/X64/Ipc_R.thy
index ff1801b7bf..e7a0cd3f5b 100644
--- a/proof/refine/X64/Ipc_R.thy
+++ b/proof/refine/X64/Ipc_R.thy
@@ -13,9 +13,10 @@ context begin interpretation Arch . (*FIXME: arch_split*)
 lemmas lookup_slot_wrapper_defs'[simp] =
    lookupSourceSlot_def lookupTargetSlot_def lookupPivotSlot_def
 
-lemma getMessageInfo_corres: "corres ((=) \<circ> message_info_map)
-                      (tcb_at t) (tcb_at' t)
-                      (get_message_info t) (getMessageInfo t)"
+lemma getMessageInfo_corres:
+  "corres ((=) \<circ> message_info_map)
+          (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+          (get_message_info t) (getMessageInfo t)"
   apply (rule corres_guard_imp)
     apply (unfold get_message_info_def getMessageInfo_def fun_app_def)
     apply (simp add: X64_H.msgInfoRegister_def
@@ -763,14 +764,6 @@ lemma tcts_sch_act[wp]:
    \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
   by (wp sch_act_wf_lift tcb_in_cur_domain'_lift transferCapsToSlots_pres1)
 
-lemma tcts_vq[wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> transferCapsToSlots ep buffer n caps slots mi \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  by (wp valid_queues_lift transferCapsToSlots_pres1)
-
-lemma tcts_vq'[wp]:
-  "\<lbrace>valid_queues'\<rbrace> transferCapsToSlots ep buffer n caps slots mi \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  by (wp valid_queues_lift' transferCapsToSlots_pres1)
-
 crunch state_refs_of' [wp]: setExtraBadge "\<lambda>s. P (state_refs_of' s)"
 
 lemma tcts_state_refs_of'[wp]:
@@ -1010,6 +1003,11 @@ crunch ksDomScheduleIdx[wp]: setExtraBadge "\<lambda>s. P (ksDomScheduleIdx s)"
 crunch ksDomSchedule[wp]: transferCapsToSlots "\<lambda>s. P (ksDomSchedule s)"
 crunch ksDomScheduleIdx[wp]: transferCapsToSlots "\<lambda>s. P (ksDomScheduleIdx s)"
 
+crunches transferCapsToSlots
+  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)
 
 lemma transferCapsToSlots_invs[wp]:
   "\<lbrace>\<lambda>s. invs' s \<and> distinct slots
@@ -1263,9 +1261,6 @@ crunch aligned'[wp]: setMessageInfo pspace_aligned'
 crunch distinct'[wp]: setMessageInfo pspace_distinct'
   (wp: crunch_wps simp: crunch_simps)
 
-crunch valid_objs'[wp]: storeWordUser valid_objs'
-crunch valid_pspace'[wp]: storeWordUser valid_pspace'
-
 lemma set_mrs_valid_objs' [wp]:
   "\<lbrace>valid_objs'\<rbrace> setMRs t a msgs \<lbrace>\<lambda>rv. valid_objs'\<rbrace>"
   apply (simp add: setMRs_def zipWithM_x_mapM split_def)
@@ -1275,18 +1270,12 @@ lemma set_mrs_valid_objs' [wp]:
 crunch valid_objs'[wp]: copyMRs valid_objs'
   (wp: crunch_wps simp: crunch_simps)
 
-crunch valid_queues'[wp]: asUser "Invariants_H.valid_queues'"
-  (simp: crunch_simps wp: hoare_drop_imps)
-
-
 lemma setMRs_invs_bits[wp]:
   "\<lbrace>valid_pspace'\<rbrace> setMRs t buf mrs \<lbrace>\<lambda>rv. valid_pspace'\<rbrace>"
   "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>
      setMRs t buf mrs \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
   "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
      setMRs t buf mrs \<lbrace>\<lambda>rv s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> setMRs t buf mrs \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  "\<lbrace>valid_queues'\<rbrace> setMRs t buf mrs \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
   "\<lbrace>\<lambda>s. P (state_refs_of' s)\<rbrace>
      setMRs t buf mrs
    \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
@@ -1303,8 +1292,6 @@ lemma copyMRs_invs_bits[wp]:
   "\<lbrace>valid_pspace'\<rbrace> copyMRs s sb r rb n \<lbrace>\<lambda>rv. valid_pspace'\<rbrace>"
   "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace> copyMRs s sb r rb n
       \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> copyMRs s sb r rb n \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  "\<lbrace>valid_queues'\<rbrace> copyMRs s sb r rb n \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
   "\<lbrace>\<lambda>s. P (state_refs_of' s)\<rbrace>
       copyMRs s sb r rb n
    \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
@@ -1562,17 +1549,17 @@ lemma msgFromLookupFailure_map[simp]:
   by (cases lf, simp_all add: lookup_failure_map_def msgFromLookupFailure_def)
 
 lemma asUser_getRestartPC_corres:
-  "corres (=) (tcb_at t) (tcb_at' t)
-                 (as_user t getRestartPC) (asUser t getRestartPC)"
+  "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+          (as_user t getRestartPC) (asUser t getRestartPC)"
   apply (rule asUser_corres')
   apply (rule corres_Id, simp, simp)
   apply (rule no_fail_getRestartPC)
   done
 
 lemma asUser_mapM_getRegister_corres:
-  "corres (=) (tcb_at t) (tcb_at' t)
-     (as_user t (mapM getRegister regs))
-     (asUser t (mapM getRegister regs))"
+  "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+          (as_user t (mapM getRegister regs))
+          (asUser t (mapM getRegister regs))"
   apply (rule asUser_corres')
   apply (rule corres_Id [OF refl refl])
   apply (rule no_fail_mapM)
@@ -1580,9 +1567,9 @@ lemma asUser_mapM_getRegister_corres:
   done
 
 lemma makeArchFaultMessage_corres:
-  "corres (=) (tcb_at t) (tcb_at' t)
-  (make_arch_fault_msg f t)
-  (makeArchFaultMessage (arch_fault_map f) t)"
+  "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+          (make_arch_fault_msg f t)
+          (makeArchFaultMessage (arch_fault_map f) t)"
   apply (cases f, clarsimp simp: makeArchFaultMessage_def split: arch_fault.split)
   apply (rule corres_guard_imp)
     apply (rule corres_split_eqr[OF asUser_getRestartPC_corres])
@@ -1591,9 +1578,9 @@ lemma makeArchFaultMessage_corres:
   done
 
 lemma makeFaultMessage_corres:
-  "corres (=) (tcb_at t) (tcb_at' t)
-     (make_fault_msg ft t)
-     (makeFaultMessage (fault_map ft) t)"
+  "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+          (make_fault_msg ft t)
+          (makeFaultMessage (fault_map ft) t)"
   apply (cases ft, simp_all add: makeFaultMessage_def split del: if_split)
      apply (rule corres_guard_imp)
        apply (rule corres_split_eqr[OF asUser_getRestartPC_corres])
@@ -1629,18 +1616,18 @@ lemmas threadget_fault_corres =
 lemma doFaultTransfer_corres:
   "corres dc
     (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)
-    (tcb_at' sender and tcb_at' receiver and
-     case_option \<top> valid_ipc_buffer_ptr' recv_buf)
+     and tcb_at receiver and case_option \<top> in_user_frame recv_buf
+     and pspace_aligned and pspace_distinct)
+    (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
                         X64_H.badgeRegister_def badge_register_def)
   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 Q'="\<lambda>fault'. tcb_at' sender and tcb_at' receiver and
-                               case_option \<top> valid_ipc_buffer_ptr' recv_buf"
+                             case_option \<top> in_user_frame recv_buf and
+                             pspace_aligned and pspace_distinct"
+              and Q'="\<lambda>fault'. case_option \<top> valid_ipc_buffer_ptr' recv_buf"
                in corres_underlying_split)
      apply (rule corres_guard_imp)
        apply (rule threadget_fault_corres)
@@ -1769,17 +1756,10 @@ crunch ifunsafe[wp]: doIPCTransfer "if_unsafe_then_cap'"
 crunch iflive[wp]: doIPCTransfer "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 vp[wp]: doIPCTransfer "valid_pspace'"
   (wp: crunch_wps hoare_vcg_const_Ball_lift get_rs_cte_at' wp: transferCapsToSlots_vp simp:ball_conj_distrib )
 crunch sch_act_wf[wp]: doIPCTransfer "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
   (wp: crunch_wps get_rs_cte_at' ignore: transferCapsToSlots simp: zipWithM_x_mapM)
-crunch vq[wp]: doIPCTransfer "Invariants_H.valid_queues"
-  (wp: crunch_wps get_rs_cte_at' ignore: transferCapsToSlots simp: zipWithM_x_mapM)
-crunch vq'[wp]: doIPCTransfer "valid_queues'"
-  (wp: crunch_wps get_rs_cte_at' ignore: transferCapsToSlots simp: zipWithM_x_mapM)
 crunch state_refs_of[wp]: doIPCTransfer "\<lambda>s. P (state_refs_of' s)"
   (wp: crunch_wps get_rs_cte_at' ignore: transferCapsToSlots simp: zipWithM_x_mapM)
 crunch ct[wp]: doIPCTransfer "cur_tcb'"
@@ -1810,7 +1790,7 @@ lemma lec_valid_cap' [wp]:
      apply (rule lookupExtraCaps_srcs)
     apply wp
    apply (clarsimp simp: cte_wp_at_ctes_of)
-   apply (fastforce elim: ctes_of_valid')
+   apply fastforce
   apply simp
   done
 
@@ -1869,7 +1849,7 @@ lemma sanitise_register_corres:
                     sanitiseOrFlags_def sanitiseAndFlags_def)
 
 lemma handle_fault_reply_registers_corres:
-  "corres (=) (tcb_at t) (tcb_at' t)
+  "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
            (do t' \<leftarrow> arch_get_sanitise_register_info t;
                y \<leftarrow> as_user t
                 (zipWithM_x
@@ -1897,7 +1877,7 @@ lemma handle_fault_reply_registers_corres:
 
 lemma handleFaultReply_corres:
   "ft' = fault_map ft \<Longrightarrow>
-   corres (=) (tcb_at t) (tcb_at' t)
+   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)
@@ -1940,18 +1920,6 @@ lemma getThreadCallerSlot_inv:
   "\<lbrace>P\<rbrace> getThreadCallerSlot t \<lbrace>\<lambda>_. P\<rbrace>"
   by (simp add: getThreadCallerSlot_def, wp)
 
-lemma deleteCallerCap_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>
-   deleteCallerCap t
-   \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: deleteCallerCap_def getSlotCap_def getThreadCallerSlot_def locateSlot_conv)
-  apply (wp getThreadCallerSlot_inv cteDeleteOne_ct_not_ksQ getCTE_wp)
-  apply (clarsimp simp: cte_wp_at_ctes_of)
-  done
-
-crunch tcb_at'[wp]: unbindNotification "tcb_at' x"
-
 lemma finaliseCapTrue_standin_tcb_at' [wp]:
   "\<lbrace>tcb_at' x\<rbrace> finaliseCapTrue_standin cap v2 \<lbrace>\<lambda>_. tcb_at' x\<rbrace>"
   apply (simp add: finaliseCapTrue_standin_def Let_def)
@@ -2108,39 +2076,11 @@ lemma cteDeleteOne_weak_sch_act[wp]:
 crunch weak_sch_act_wf[wp]: emptySlot "\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s"
 
 crunch pred_tcb_at'[wp]: handleFaultReply "pred_tcb_at' proj P t"
-crunch valid_queues[wp]: handleFaultReply "Invariants_H.valid_queues"
-crunch valid_queues'[wp]: handleFaultReply "valid_queues'"
 crunch tcb_in_cur_domain'[wp]: handleFaultReply "tcb_in_cur_domain' t"
 
 crunch sch_act_wf[wp]: unbindNotification "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
 (wp: sbn_sch_act')
 
-crunch valid_queues'[wp]: cteDeleteOne valid_queues'
-  (simp: crunch_simps unless_def inQ_def
-     wp: crunch_wps sts_st_tcb' getObject_inv loadObject_default_inv
-         threadSet_valid_queues' rescheduleRequired_valid_queues'_weak)
-
-lemma cancelSignal_valid_queues'[wp]:
-  "\<lbrace>valid_queues'\<rbrace> cancelSignal t ntfn \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (simp add: cancelSignal_def)
-  apply (rule hoare_pre)
-   apply (wp getNotification_wp| wpc | simp)+
-  done
-
-lemma cancelIPC_valid_queues'[wp]:
-  "\<lbrace>valid_queues' and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) \<rbrace> cancelIPC t \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (simp add: cancelIPC_def Let_def getThreadReplySlot_def locateSlot_conv liftM_def)
-  apply (rule hoare_seq_ext[OF _ gts_sp'])
-  apply (case_tac state, simp_all) defer 2
-  apply (rule hoare_pre)
-   apply ((wp getEndpoint_wp getCTE_wp | wpc | simp)+)[8]
-  apply (wp cteDeleteOne_valid_queues')
-  apply (rule_tac Q="\<lambda>_. valid_queues' and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)" in hoare_post_imp)
-  apply (clarsimp simp: capHasProperty_def cte_wp_at_ctes_of)
-   apply (wp threadSet_valid_queues' threadSet_sch_act| simp)+
-  apply (clarsimp simp: inQ_def)
-  done
-
 crunch valid_objs'[wp]: handleFaultReply valid_objs'
 
 lemma cte_wp_at_is_reply_cap_toI:
@@ -2148,6 +2088,17 @@ lemma cte_wp_at_is_reply_cap_toI:
    \<Longrightarrow> cte_wp_at (is_reply_cap_to t) ptr s"
   by (fastforce simp: cte_wp_at_reply_cap_to_ex_rights)
 
+crunches handle_fault_reply
+  for pspace_aligned[wp]: pspace_aligned
+  and pspace_distinct[wp]: pspace_distinct
+
+crunches 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 doReplyTransfer_corres:
   "corres dc
      (einvs and tcb_at receiver and tcb_at sender
@@ -2159,7 +2110,7 @@ lemma doReplyTransfer_corres:
   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)+)
+     apply (rule getThreadState_corres, (fastforce simp add: st_tcb_at_tcb_at)+)
   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
@@ -2193,8 +2144,12 @@ lemma doReplyTransfer_corres:
            apply (rule corres_split[OF setThreadState_corres])
               apply simp
              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_queues sts_valid_objs' delete_one_tcbDomain_obj_at'
-                   | simp add: valid_tcb_state'_def)+
+            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])
@@ -2203,12 +2158,16 @@ lemma doReplyTransfer_corres:
           apply (fastforce)
          apply (clarsimp simp:is_cap_simps)
         apply (wp weak_valid_sched_action_lift)+
-       apply (rule_tac Q="\<lambda>_. valid_queues' and valid_objs' and cur_tcb' and tcb_at' receiver and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)" in hoare_post_imp, simp add: sch_act_wf_weak)
+       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)
+    apply (clarsimp simp: invs_psp_aligned invs_distinct)
     apply (rule conjI, erule invs_valid_objs)
     apply (rule conjI, clarsimp)+
     apply (rule conjI)
@@ -2232,10 +2191,13 @@ lemma doReplyTransfer_corres:
                  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 P="valid_sched and cur_tcb and tcb_at receiver"
+                apply (rule_tac P="valid_sched and cur_tcb and tcb_at receiver
+                                   and pspace_aligned and pspace_distinct"
                             and P'="tcb_at' receiver and cur_tcb'
-                                      and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
-                                      and Invariants_H.valid_queues and valid_queues' and valid_objs'"
+                                    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_inst)
                 apply (case_tac rvb, simp_all)[1]
                  apply (rule corres_guard_imp)
@@ -2243,25 +2205,27 @@ lemma doReplyTransfer_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_queues | simp | force simp: valid_sched_def valid_sched_action_def valid_tcb_state'_def)+
+                    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'
+                           | simp
+                           | 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_valid_queues threadSet_valid_queues'
+                         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 (wp threadSet_cur weak_sch_act_wf_lift_linear threadSet_pred_tcb_no_state
-                      thread_set_not_state_valid_sched threadSet_valid_queues threadSet_valid_queues'
-                 | simp add: runnable_def inQ_def valid_tcb'_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"
+     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)
+     apply fastforce
     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>)
@@ -2472,7 +2436,7 @@ proof -
              apply (rule setEndpoint_corres)
              apply (simp add: ep_relation_def)
             apply wp+
-          apply (clarsimp simp: st_tcb_at_tcb_at valid_tcb_state_def)
+          apply (clarsimp simp: st_tcb_at_tcb_at valid_tcb_state_def invs_psp_aligned invs_distinct)
          apply clarsimp
          \<comment> \<open>concludes IdleEP if bl branch\<close>
         apply (simp add: ep_relation_def)
@@ -2482,7 +2446,7 @@ proof -
             apply (rule setEndpoint_corres)
             apply (simp add: ep_relation_def)
            apply wp+
-         apply (clarsimp simp: st_tcb_at_tcb_at valid_tcb_state_def)
+         apply (clarsimp simp: st_tcb_at_tcb_at valid_tcb_state_def invs_psp_aligned invs_distinct)
         apply clarsimp
         \<comment> \<open>concludes SendEP if bl branch\<close>
        apply (simp add: ep_relation_def)
@@ -2521,10 +2485,12 @@ proof -
                  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 setThreadState_valid_queues' sts_valid_queues sts_weak_sch_act_wf
+               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)
+              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)
@@ -2589,11 +2555,13 @@ proof -
                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 setThreadState_valid_queues' sts_valid_queues sts_weak_sch_act_wf
+              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)+)[1]
+                     | 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)
@@ -2619,8 +2587,6 @@ proof -
   done
 qed
 
-crunch typ_at'[wp]: setMessageInfo "\<lambda>s. P (typ_at' T p s)"
-
 lemmas setMessageInfo_typ_ats[wp] = typ_at_lifts [OF setMessageInfo_typ_at']
 
 (* Annotation added by Simon Winwood (Thu Jul  1 20:54:41 2010) using taint-mode *)
@@ -2629,15 +2595,10 @@ declare tl_drop_1[simp]
 crunch cur[wp]: cancel_ipc "cur_tcb"
   (wp: crunch_wps simp: crunch_simps)
 
-crunch valid_objs'[wp]: asUser "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)
 
-crunch weak_valid_sched_action[wp]: as_user weak_valid_sched_action
-  (wp: weak_valid_sched_action_lift)
-
 lemma sendSignal_corres:
   "corres dc (einvs and ntfn_at ep) (invs' and ntfn_at' ep)
              (send_signal ep bg) (sendSignal ep bg)"
@@ -2674,14 +2635,15 @@ lemma sendSignal_corres:
                apply (rule possibleSwitchTo_corres)
               apply wp
              apply (wp set_thread_state_runnable_weak_valid_sched_action sts_st_tcb_at'
-                       sts_valid_queues sts_st_tcb' hoare_disjI2
+                       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 (clarsimp simp: invs'_def valid_state'_def sch_act_wf_weak
-                               valid_tcb_state'_def)
+         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)+
@@ -2707,23 +2669,23 @@ lemma sendSignal_corres:
           apply (rule corres_split[OF asUser_setRegister_corres])
             apply (rule possibleSwitchTo_corres)
            apply ((wp | simp)+)[1]
-          apply (rule_tac Q="\<lambda>_. Invariants_H.valid_queues and valid_queues' and
-                                 (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and
+          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'"
+                                 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_queues setThreadState_valid_queues'
-                  setThreadState_st_tcb
+        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 (clarsimp 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 (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)
 
@@ -2741,16 +2703,14 @@ lemma sendSignal_corres:
           apply (wp cur_tcb_lift | 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_queues setThreadState_valid_queues'
-                 setThreadState_st_tcb
-            | 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 (clarsimp 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 (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]
@@ -2781,38 +2741,6 @@ lemma possibleSwitchTo_sch_act[wp]:
   apply (auto simp: obj_at'_def projectKOs tcb_in_cur_domain'_def)
   done
 
-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>"
-  apply (simp add: possibleSwitchTo_def curDomain_def bitmap_fun_defs)
-  apply (wp hoare_drop_imps | wpc | simp)+
-  apply (auto simp: valid_tcb'_def weak_sch_act_wf_def
-              dest: pred_tcb_at'
-             elim!: valid_objs_valid_tcbE)
-  done
-
-lemma possibleSwitchTo_ksQ':
-  "\<lbrace>(\<lambda>s. t' \<notin> set (ksReadyQueues s p) \<and> sch_act_not t' s) and K(t' \<noteq> t)\<rbrace>
-     possibleSwitchTo t
-   \<lbrace>\<lambda>_ s. t' \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: possibleSwitchTo_def curDomain_def bitmap_fun_defs)
-  apply (wp hoare_weak_lift_imp rescheduleRequired_ksQ' tcbSchedEnqueue_ksQ threadGet_wp
-         | wpc
-         | simp split del: if_split)+
-  apply (auto simp: obj_at'_def)
-  done
-
-lemma possibleSwitchTo_valid_queues'[wp]:
-  "\<lbrace>valid_queues' and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)
-                  and st_tcb_at' runnable' t\<rbrace>
-   possibleSwitchTo t
-   \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (simp add: possibleSwitchTo_def curDomain_def bitmap_fun_defs)
-  apply (wp hoare_weak_lift_imp threadGet_wp | wpc | simp)+
-  apply (auto simp: obj_at'_def)
-  done
-
 crunches possibleSwitchTo
   for st_refs_of'[wp]: "\<lambda>s. P (state_refs_of' s)"
   and cap_to'[wp]: "ex_nonz_cap_to' p"
@@ -2821,15 +2749,15 @@ crunches possibleSwitchTo
   (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>"
+  "\<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)+
-  apply (auto simp: obj_at'_def projectKOs)
+  apply (auto simp: obj_at'_def)
   done
 
 crunches possibleSwitchTo
@@ -2857,10 +2785,6 @@ crunches sendSignal, setBoundNotification
    rule: irqs_masked_lift)
 end
 
-lemma sts_running_valid_queues:
-  "runnable' st \<Longrightarrow> \<lbrace> Invariants_H.valid_queues \<rbrace> setThreadState st t \<lbrace>\<lambda>_. Invariants_H.valid_queues \<rbrace>"
-  by (wp sts_valid_queues, clarsimp)
-
 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)
@@ -2873,24 +2797,21 @@ lemma setThreadState_nonqueued_state_update:
                \<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)
-               \<and> (\<not> runnable' st \<longrightarrow> (\<forall>p. t \<notin> set (ksReadyQueues s p)))\<rbrace>
-  setThreadState st t \<lbrace>\<lambda>rv. invs'\<rbrace>"
+               \<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
-                            sts_valid_queues
-                            setThreadState_ct_not_inQ)
+  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 (drule simple_st_tcb_at_state_refs_ofD')
   apply (drule bound_tcb_at_state_refs_ofD')
-  apply (rule conjI, fastforce)
-  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 (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
 
 lemma cteDeleteOne_reply_cap_to'[wp]:
@@ -2958,16 +2879,14 @@ lemma cancelAllIPC_not_rct[wp]:
    \<lbrace>\<lambda>_ s. ksSchedulerAction s \<noteq> ResumeCurrentThread \<rbrace>"
   apply (simp add: cancelAllIPC_def)
   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 (wp)+
-     apply (rule hoare_post_imp [OF _ rescheduleRequired_notresume], simp)
-    apply simp
-    apply (rule mapM_x_wp_inv)
-    apply (wp)+
-  apply (wp hoare_vcg_all_lift hoare_drop_imp)
-    apply (simp_all)
+      apply (wpsimp wp: hoare_vcg_all_lift hoare_drop_imp)+
   done
 
 lemma cancelAllSignals_not_rct[wp]:
@@ -2976,12 +2895,10 @@ lemma cancelAllSignals_not_rct[wp]:
    \<lbrace>\<lambda>_ s. ksSchedulerAction s \<noteq> ResumeCurrentThread \<rbrace>"
   apply (simp add: cancelAllSignals_def)
   apply (wp | wpc)+
-     apply (rule hoare_post_imp [OF _ rescheduleRequired_notresume], simp)
-    apply simp
-    apply (rule mapM_x_wp_inv)
-    apply (wp)+
-  apply (wp hoare_vcg_all_lift hoare_drop_imp)
-    apply (simp_all)
+       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 not_rct[wp]: finaliseCapTrue_standin "\<lambda>s. ksSchedulerAction s \<noteq> ResumeCurrentThread"
@@ -3065,7 +2982,6 @@ lemma sai_invs'[wp]:
      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
-               sts_valid_queues [where st="Structures_H.thread_state.Running", simplified]
                set_ntfn_valid_objs' cur_tcb_lift sts_st_tcb'
                hoare_convert_imp [OF setNotification_nosch]
            | simp split del: if_split)+
@@ -3152,6 +3068,8 @@ lemma replyFromKernel_corres:
           apply (rule setMessageInfo_corres)
           apply (wp hoare_case_option_wp hoare_valid_ipc_buffer_ptr_typ_at'
                  | clarsimp)+
+   apply fastforce
+  apply fastforce
   done
 
 lemma rfk_invs':
@@ -3164,8 +3082,7 @@ lemma rfk_invs':
 crunch nosch[wp]: replyFromKernel "\<lambda>s. P (ksSchedulerAction s)"
 
 lemma completeSignal_corres:
-  "corres dc (ntfn_at ntfnptr and tcb_at tcb and pspace_aligned and valid_objs
-        \<comment> \<open>and obj_at (\<lambda>ko. ko = Notification ntfn \<and> Ipc_A.isActive ntfn) ntfnptr\<close>)
+  "corres dc (ntfn_at ntfnptr and tcb_at tcb and pspace_aligned and pspace_distinct and valid_objs)
              (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)
@@ -3189,10 +3106,9 @@ lemma completeSignal_corres:
 
 
 lemma doNBRecvFailedTransfer_corres:
-  "corres dc (tcb_at thread)
-            (tcb_at' thread)
-            (do_nbrecv_failed_transfer thread)
-            (doNBRecvFailedTransfer thread)"
+  "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 (simp add: badgeRegister_def badge_register_def, rule asUser_setRegister_corres)
 
@@ -3279,11 +3195,11 @@ lemma receiveIPC_corres:
                                              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 Invariants_H.valid_queues
-                                                   and valid_queues'
                                                    and valid_pspace'
                                                    and valid_objs'
-                                             and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)"
+                                             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])
@@ -3292,17 +3208,18 @@ lemma receiveIPC_corres:
                        apply (rule corres_split[OF setThreadState_corres])
                           apply simp
                          apply (rule possibleSwitchTo_corres)
-                        apply (wp sts_st_tcb_at' set_thread_state_runnable_weak_valid_sched_action
-                             | simp)+
-                       apply (wp sts_st_tcb_at'_cases sts_valid_queues setThreadState_valid_queues'
-                                 setThreadState_st_tcb
+                        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 (clarsimp simp: st_tcb_at_tcb_at st_tcb_def2 valid_sched_def
-                                            valid_sched_action_def)
+                      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"
-                         in hoare_post_imp, erule sch_act_wf_weak)
+                   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
@@ -3325,13 +3242,13 @@ lemma receiveIPC_corres:
                 apply wp+
               apply (rule corres_guard_imp, rule doNBRecvFailedTransfer_corres, simp)
               apply simp
-             apply (clarsimp simp: valid_tcb_state_def)
+             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 (clarsimp simp: valid_cap_def invs_psp_aligned invs_valid_objs pred_tcb_at_def
-                         valid_obj_def valid_tcb_def valid_bound_ntfn_def
+                         valid_obj_def valid_tcb_def valid_bound_ntfn_def invs_distinct
                   dest!: invs_valid_objs
                   elim!: obj_at_valid_objsE
                   split: option.splits)
@@ -3368,7 +3285,7 @@ lemma receiveSignal_corres:
              apply (rule setNotification_corres)
              apply (simp add: ntfn_relation_def)
             apply wp+
-          apply (rule corres_guard_imp, rule doNBRecvFailedTransfer_corres, simp+)
+          apply (rule corres_guard_imp, rule doNBRecvFailedTransfer_corres, fastforce+)
        \<comment> \<open>WaitingNtfn\<close>
        apply (simp add: ntfn_relation_def)
        apply (rule corres_guard_imp)
@@ -3379,7 +3296,7 @@ lemma receiveSignal_corres:
             apply (simp add: ntfn_relation_def)
            apply wp+
          apply (rule corres_guard_imp)
-           apply (rule doNBRecvFailedTransfer_corres, simp+)
+           apply (rule doNBRecvFailedTransfer_corres, fastforce+)
       \<comment> \<open>ActiveNtfn\<close>
       apply (simp add: ntfn_relation_def)
       apply (rule corres_guard_imp)
@@ -3449,10 +3366,9 @@ lemma sendFaultIPC_corres:
                   | 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 (simp add: valid_cap_def)
-         apply (clarsimp simp: valid_cap'_def inQ_def)
-        apply auto[1]
-        apply (clarsimp simp: lookup_failure_map_def)
+          apply (fastforce simp: valid_cap_def)
+         apply (fastforce simp: valid_cap'_def inQ_def)
+        apply (fastforce simp: lookup_failure_map_def)
        apply wp+
    apply (fastforce elim: st_tcb_at_tcb_at)
   apply fastforce
@@ -3467,14 +3383,14 @@ lemma gets_the_noop_corres:
   done
 
 lemma handleDoubleFault_corres:
-  "corres dc (tcb_at thread)
+  "corres dc (tcb_at thread and pspace_aligned and pspace_distinct)
              (tcb_at' thread and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s))
              (handle_double_fault thread f ft)
              (handleDoubleFault thread f' ft')"
   apply (simp add: handle_double_fault_def handleDoubleFault_def)
   apply (rule corres_guard_imp)
     apply (subst bind_return [symmetric],
-           rule corres_underlying_split [OF setThreadState_corres])
+           rule corres_split [OF setThreadState_corres])
        apply simp
       apply (rule corres_noop2)
          apply (simp add: exs_valid_def return_def)
@@ -3498,10 +3414,6 @@ crunch typ_at'[wp]: receiveSignal "\<lambda>s. P (typ_at' T p s)"
 
 lemmas receiveAIPC_typ_ats[wp] = typ_at_lifts [OF receiveSignal_typ_at']
 
-declare cart_singleton_empty[simp]
-
-declare cart_singleton_empty2[simp]
-
 crunch aligned'[wp]: setupCallerCap "pspace_aligned'"
   (wp: crunch_wps)
 crunch distinct'[wp]: setupCallerCap "pspace_distinct'"
@@ -3519,34 +3431,6 @@ lemma setupCallerCap_state_refs_of[wp]:
   apply (simp add: fun_upd_def cong: if_cong)
   done
 
-crunch sch_act_wf: setupCallerCap
-  "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
-  (wp: crunch_wps ssa_sch_act sts_sch_act rule: sch_act_wf_lift)
-
-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 vq[wp]: cteInsert "Invariants_H.valid_queues"
-  (wp: crunch_wps)
-
-crunch vq[wp]: getThreadCallerSlot "Invariants_H.valid_queues"
-  (wp: crunch_wps)
-
-crunch vq[wp]: getThreadReplySlot "Invariants_H.valid_queues"
-  (wp: crunch_wps)
-
-lemma setupCallerCap_vq[wp]:
-  "\<lbrace>Invariants_H.valid_queues and (\<lambda>s. \<forall>p. send \<notin> set (ksReadyQueues s p))\<rbrace>
-   setupCallerCap send recv grant \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: setupCallerCap_def)
-  apply (wp crunch_wps sts_valid_queues)
-  apply (fastforce simp: valid_queues_def obj_at'_def inQ_def)
-  done
-
-crunch vq'[wp]: setupCallerCap "valid_queues'"
-  (wp: crunch_wps)
-
 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)"
@@ -3590,7 +3474,7 @@ lemma setupCallerCap_vp[wp]:
 declare haskell_assert_inv[wp del]
 
 lemma setupCallerCap_iflive[wp]:
-  "\<lbrace>if_live_then_nonz_cap' and ex_nonz_cap_to' sender\<rbrace>
+  "\<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
@@ -3602,7 +3486,7 @@ lemma setupCallerCap_iflive[wp]:
 
 lemma setupCallerCap_ifunsafe[wp]:
   "\<lbrace>if_unsafe_then_cap' and valid_objs' and
-    ex_nonz_cap_to' rcvr and tcb_at' rcvr\<rbrace>
+    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
@@ -3624,13 +3508,11 @@ lemma setupCallerCap_global_refs'[wp]:
    \<lbrace>\<lambda>rv. valid_global_refs'\<rbrace>"
   unfolding setupCallerCap_def getThreadCallerSlot_def
             getThreadReplySlot_def locateSlot_conv
-  apply (wp getSlotCap_cte_wp_at
-    | simp add: o_def unique_master_reply_cap'
-    | strengthen eq_imp_strg
-    | wp (once) getCTE_wp | clarsimp simp: cte_wp_at_ctes_of)+
-  (* at setThreadState *)
-  apply (rule_tac Q="\<lambda>_. valid_global_refs'" in hoare_post_imp, wpsimp+)
-  done
+  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 valid_arch'[wp]: setupCallerCap "valid_arch_state'"
   (wp: hoare_drop_imps)
@@ -3820,12 +3702,21 @@ crunches possibleSwitchTo
    and ioports'[wp]: valid_ioports'
   (wp: valid_ioports_lift' possibleSwitchTo_ctes_of crunch_wps ignore: constOnFailure)
 
+crunches asUser
+  for valid_bitmaps[wp]: valid_bitmaps
+  (rule: valid_bitmaps_lift wp: crunch_wps)
+
+crunches 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)
+
 (* 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 (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))
           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
@@ -3843,7 +3734,7 @@ lemma ri_invs' [wp]:
      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
-                sts_valid_queues setThreadState_ct_not_inQ
+                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)
@@ -3870,7 +3761,7 @@ lemma ri_invs' [wp]:
     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
-               sts_valid_queues setThreadState_ct_not_inQ
+               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)
@@ -3894,9 +3785,8 @@ lemma ri_invs' [wp]:
    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' sts_valid_queues
-              setThreadState_ct_not_inQ possibleSwitchTo_valid_queues
-              possibleSwitchTo_valid_queues'
+              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
@@ -3914,8 +3804,6 @@ lemma ri_invs' [wp]:
                          st_tcb_at_refs_of_rev' conj_ac
               split del: if_split
                    cong: if_cong)
-   apply (frule_tac t=sender in valid_queues_not_runnable'_not_ksQ)
-    apply (erule pred_tcb'_weakenE, clarsimp)
    apply (subgoal_tac "sch_act_not sender s")
     prefer 2
     apply (clarsimp simp: pred_tcb_at'_def obj_at'_def)
@@ -3949,7 +3837,6 @@ lemma ri_invs' [wp]:
 lemma rai_invs'[wp]:
   "\<lbrace>invs' and sch_act_not t
           and st_tcb_at' simple' t
-          and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))
           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
@@ -3966,7 +3853,7 @@ lemma rai_invs'[wp]:
     apply (simp add: invs'_def valid_state'_def)
     apply (rule hoare_pre)
      apply (wp valid_irq_node_lift sts_sch_act' typ_at_lifts
-               sts_valid_queues setThreadState_ct_not_inQ
+               setThreadState_ct_not_inQ
                asUser_urz
             | simp add: valid_ntfn'_def doNBRecvFailedTransfer_def | wpc)+
     apply (clarsimp simp: pred_tcb_at' valid_tcb_state'_def)
@@ -3984,7 +3871,7 @@ lemma rai_invs'[wp]:
        apply (clarsimp split: if_split_asm)
       apply (fastforce simp: tcb_bound_refs'_def symreftype_inverse'
                       split: if_split_asm)
-     apply (clarsimp dest!: global'_no_ex_cap)
+     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)
@@ -4004,7 +3891,7 @@ lemma rai_invs'[wp]:
   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'
-             sts_valid_queues setThreadState_ct_not_inQ typ_at_lifts
+             setThreadState_ct_not_inQ typ_at_lifts
              asUser_urz
         | simp add: valid_ntfn'_def doNBRecvFailedTransfer_def | wpc)+
   apply (clarsimp simp: valid_tcb_state'_def)
@@ -4032,7 +3919,7 @@ lemma rai_invs'[wp]:
         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 (clarsimp dest!: global'_no_ex_cap)
+  apply (fastforce dest!: global'_no_ex_cap)
   done
 
 lemma getCTE_cap_to_refs[wp]:
@@ -4064,7 +3951,6 @@ 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>Invariants_H.valid_queues\<rbrace> cteInsert a b c \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<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
@@ -4089,9 +3975,12 @@ crunch irqs_masked'[wp]: possibleSwitchTo "irqs_masked'"
 crunch urz[wp]: possibleSwitchTo "untyped_ranges_zero'"
   (simp: crunch_simps unless_def wp: crunch_wps)
 
+crunches possibleSwitchTo
+  for pspace_aligned'[wp]: pspace_aligned'
+  and pspace_distinct'[wp]: pspace_distinct'
+
 lemma si_invs'[wp]:
   "\<lbrace>invs' and st_tcb_at' simple' t
-          and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))
           and sch_act_not t
           and ex_nonz_cap_to' ep and ex_nonz_cap_to' t\<rbrace>
   sendIPC bl call ba cg cgr t ep
@@ -4110,8 +3999,8 @@ lemma si_invs'[wp]:
      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 sts_valid_queues setThreadState_ct_not_inQ
-               possibleSwitchTo_ksQ' possibleSwitchTo_ct_not_inQ hoare_vcg_all_lift sts_ksQ'
+               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"]
@@ -4165,8 +4054,7 @@ lemma si_invs'[wp]:
     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' sts_valid_queues
-               setThreadState_ct_not_inQ)
+     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")
@@ -4185,8 +4073,7 @@ lemma si_invs'[wp]:
    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'
-              sts_valid_queues setThreadState_ct_not_inQ)
+    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)
@@ -4213,19 +4100,15 @@ lemma si_invs'[wp]:
 lemma sfi_invs_plus':
   "\<lbrace>invs' and st_tcb_at' simple' t
           and sch_act_not t
-          and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))
           and ex_nonz_cap_to' t\<rbrace>
-      sendFaultIPC t f
-   \<lbrace>\<lambda>rv. invs'\<rbrace>, \<lbrace>\<lambda>rv. invs' and st_tcb_at' simple' t
-                      and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))
-                      and sch_act_not t and (\<lambda>s. ksIdleThread s \<noteq> 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'
            | wpc | simp)+
    apply (rule_tac Q'="\<lambda>rv s. invs' s \<and> sch_act_not t s
                              \<and> st_tcb_at' simple' t s
-                             \<and> (\<forall>p. t \<notin> set (ksReadyQueues s p))
                              \<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)"
@@ -4237,12 +4120,16 @@ lemma sfi_invs_plus':
   apply (subst(asm) global'_no_ex_cap, auto)
   done
 
+crunches send_fault_ipc
+  for pspace_aligned[wp]: pspace_aligned
+  and psapce_distinct[wp]: pspace_distinct
+  (simp: crunch_simps wp: crunch_wps)
+
 lemma handleFault_corres:
   "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 (\<lambda>s. \<forall>p. thread \<notin> set(ksReadyQueues s p))
                     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)
@@ -4270,17 +4157,13 @@ lemma sts_invs_minor'':
                    \<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. (\<exists>p. t \<in> set (ksReadyQueues s p)) \<longrightarrow> runnable' st)
-      and (\<lambda>s. runnable' st \<and> obj_at' tcbQueued t s
-                                      \<longrightarrow> st_tcb_at' runnable' t s)
       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' sts_valid_queues
-             setThreadState_ct_not_inQ)
+   apply (wp valid_irq_node_lift sts_sch_act' setThreadState_ct_not_inQ)
   apply clarsimp
   apply (rule conjI)
    apply fastforce
@@ -4295,12 +4178,11 @@ lemma sts_invs_minor'':
    apply (clarsimp dest!: st_tcb_at_state_refs_ofD'
                    elim!: rsubst[where P=sym_refs]
                   intro!: ext)
-  apply (clarsimp elim!: st_tcb_ex_cap'')
+  apply (fastforce elim!: st_tcb_ex_cap'')
   done
 
 lemma hf_invs' [wp]:
   "\<lbrace>invs' and sch_act_not t
-          and (\<lambda>s. \<forall>p. t \<notin> set(ksReadyQueues s p))
           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>"
diff --git a/proof/refine/X64/KHeap_R.thy b/proof/refine/X64/KHeap_R.thy
index 199dd740ef..e8e5790784 100644
--- a/proof/refine/X64/KHeap_R.thy
+++ b/proof/refine/X64/KHeap_R.thy
@@ -14,8 +14,46 @@ lemma lookupAround2_known1:
   "m x = Some y \<Longrightarrow> fst (lookupAround2 x m) = Some (x, y)"
   by (fastforce simp: lookupAround2_char1)
 
+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
+
 context begin interpretation Arch . (*FIXME: arch_split*)
 
+lemma setObject_modify_variable_size:
+  fixes v :: "'a :: pspace_storable" shows
+  "\<lbrakk>obj_at' (P :: 'a \<Rightarrow> bool) p s; updateObject v = updateObject_default v;
+    (1 :: machine_word) < 2 ^ objBits v; obj_at' (\<lambda>obj. objBits v = objBits obj) p s\<rbrakk>
+   \<Longrightarrow> setObject p v s = modify (ksPSpace_update (\<lambda>ps. ps (p \<mapsto> injectKO v))) s"
+  supply projectKOs[simp]
+  apply (clarsimp simp: setObject_def split_def exec_gets obj_at'_def lookupAround2_known1
+                        assert_opt_def updateObject_default_def bind_assoc)
+  apply (simp add: projectKO_def alignCheck_assert)
+  apply (simp add: project_inject objBits_def)
+  apply (clarsimp simp only: koTypeOf_injectKO)
+  apply (frule in_magnitude_check[where s'=s])
+    apply blast
+   apply fastforce
+  apply (simp add: magnitudeCheck_assert in_monad bind_def gets_def oassert_opt_def
+                   get_def return_def)
+  apply (simp add: simpler_modify_def)
+  done
+
+lemma setObject_modify:
+  fixes v :: "'a :: pspace_storable" shows
+  "\<lbrakk>obj_at' (P :: 'a \<Rightarrow> bool) p s; updateObject v = updateObject_default v;
+    (1 :: machine_word) < 2 ^ objBits v; \<And>ko. P ko \<Longrightarrow> objBits ko = objBits v \<rbrakk>
+   \<Longrightarrow> setObject p v s = modify (ksPSpace_update (\<lambda>ps. ps (p \<mapsto> injectKO v))) s"
+  apply (rule setObject_modify_variable_size)
+     apply fastforce
+    apply fastforce
+  apply fastforce
+  unfolding obj_at'_def
+  by fastforce
+
 lemma obj_at_getObject:
   assumes R:
   "\<And>a b p q n ko s obj::'a::pspace_storable.
@@ -100,9 +138,223 @@ lemmas typ_at_to_obj_at_arches
 lemmas page_table_at_obj_at'
   = page_table_at'_def[unfolded typ_at_to_obj_at_arches]
 
+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  projectKOs)
+  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 is_tcb_def pde_relation_def
+                     pdpte_relation_def pml4e_relation_def
+              split: Structures_A.kernel_object.split_asm if_split_asm arch_kernel_obj.split_asm)
+
+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 simp flip: shiftl_t2n')
+         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_shiftl_self, simp)
+
+        \<comment>\<open>TCB\<close>
+        apply (clarsimp simp: tcbBlockSizeBits_def elim!: is_aligned_weaken)
+
+       \<comment>\<open>PTE\<close>
+       apply (clarsimp simp: archObjSize_def table_size_def ptTranslationBits_def)
+       apply (rule is_aligned_add)
+        apply (erule is_aligned_weaken)
+        apply simp
+       apply (simp add: word_size_bits_def)
+       apply (rule is_aligned_shift)
+
+       \<comment>\<open>PDE\<close>
+      apply (clarsimp simp: archObjSize_def table_size_def ptTranslationBits_def)
+      apply (rule is_aligned_add)
+       apply (erule is_aligned_weaken)
+       apply simp
+      apply (simp add: word_size_bits_def)
+      apply (rule is_aligned_shift)
+
+     \<comment>\<open>PDPTE\<close>
+     apply (clarsimp simp: archObjSize_def table_size_def ptTranslationBits_def)
+     apply (rule is_aligned_add)
+      apply (erule is_aligned_weaken)
+      apply simp
+     apply (simp add: word_size_bits_def)
+     apply (rule is_aligned_shift)
+
+    \<comment>\<open>PML4E\<close>
+    apply (clarsimp simp: archObjSize_def table_size_def ptTranslationBits_def)
+    apply (rule is_aligned_add)
+     apply (erule is_aligned_weaken)
+     apply simp
+    apply (simp add: word_size_bits_def)
+    apply (rule is_aligned_shift)
+
+   \<comment>\<open>DataPage\<close>
+   apply (rule is_aligned_add)
+    apply (erule is_aligned_weaken)
+    apply (rule pbfs_atleast_pageBits)
+   apply (rule is_aligned_mult_triv2)
+
+  \<comment>\<open>other_obj_relation\<close>
+  apply (simp add: other_obj_relation_def)
+  apply (clarsimp simp: tcbBlockSizeBits_def epSizeBits_def ntfnSizeBits_def
+                 split: kernel_object.splits Structures_A.kernel_object.splits)
+  apply (fastforce simp: archObjSize_def split: arch_kernel_object.splits arch_kernel_obj.splits)
+  done
+
+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 bit_simps 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 simp flip: shiftl_t2n')
+         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=tcbBlockSizeBits in exI)
+        apply (simp add: tcbBlockSizeBits_def)
+       apply (rule_tac x=word_size_bits in exI, simp add: bit_simps is_aligned_shift mask_def, word_bitwise)
+      apply (rule_tac x=word_size_bits in exI, simp add: bit_simps is_aligned_shift mask_def, word_bitwise)
+     apply (rule_tac x=word_size_bits in exI, simp add: bit_simps is_aligned_shift mask_def, word_bitwise)
+    apply (rule_tac x=word_size_bits in exI, simp add: bit_simps is_aligned_shift mask_def, word_bitwise)
+   apply (rule_tac x=pageBits in exI)
+   apply (simp add: is_aligned_mult_triv2 pbfs_atleast_pageBits)
+   apply (simp add: mask_def shiftl_t2n mult_ac pbfs_less_wb')
+   apply (erule word_less_power_trans2, rule pbfs_atleast_pageBits)
+   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 bit_simps cte_level_bits_def
+                         pbfs_atleast_pageBits[simplified bit_simps])
+      prefer 5
+      apply (cases ko; simp add: other_obj_relation_def objBits_defs split: kernel_object.splits)
+      apply (rename_tac ako, case_tac ako; clarsimp simp: archObjSize_def)+
+  done
+
+lemmas is_aligned_add_step_le' = is_aligned_add_step_le[simplified mask_2pm1 add_diff_eq]
+
+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 (rule ps_clearI, assumption)
+   apply (case_tac ko'; simp add: objBits_simps objBits_defs pageBits_def)
+   apply (simp add: archObjSize_def pageBits_def split: arch_kernel_object.splits)
+  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=cte_level_bits in is_aligned_add_step_le'; assumption?)
+           apply (rule is_aligned_add; (rule is_aligned_mult_triv2)?)
+           apply (erule is_aligned_weaken, simp add: cte_level_bits_def)
+          apply (rule is_aligned_add; (rule is_aligned_mult_triv2)?)
+          apply (erule is_aligned_weaken, simp add: cte_level_bits_def)
+         apply (simp add: cte_level_bits_def cteSizeBits_def)
+        apply (clarsimp simp: pte_relation_def objBits_simps archObjSize_def)
+        apply (rule_tac n=word_size_bits in is_aligned_add_step_le'; simp add: word_size_bits_def)
+       apply (clarsimp simp: pde_relation_def objBits_simps archObjSize_def)
+       apply (rule_tac n=word_size_bits in is_aligned_add_step_le'; simp add: word_size_bits_def)
+      apply (clarsimp simp: pdpte_relation_def objBits_simps archObjSize_def)
+      apply (rule_tac n=word_size_bits in is_aligned_add_step_le'; simp add: word_size_bits_def)
+     apply (clarsimp simp: pml4e_relation_def objBits_simps archObjSize_def)
+     apply (rule_tac n=word_size_bits in is_aligned_add_step_le'; simp add: word_size_bits_def)
+    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: other_obj_relation_def)
+   apply (rename_tac ako, case_tac ako; simp add: is_other_obj_relation_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)
+  done
+
+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 project_inject pspace_distinct'_def pspace_aligned'_def projectKOs)
+  apply (drule bspec, erule domI)+
+  apply (clarsimp simp: bit_simps objBits_simps' word_bits_def
+                 split: kernel_object.splits arch_kernel_object.splits)
+  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 projectKOs)
+  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 corres_get_tcb:
-  "corres (tcb_relation \<circ> the) (tcb_at t) (tcb_at' t) (gets (get_tcb t)) (getObject t)"
+  "corres (tcb_relation \<circ> the) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+          (gets (get_tcb t)) (getObject t)"
+  apply (rule corres_cross_over_guard[where Q="tcb_at' t"])
+   apply (fastforce simp: tcb_at_cross state_relation_def)
   apply (rule corres_no_failI)
    apply wp
   apply (clarsimp simp add: gets_def get_def return_def bind_def get_tcb_def)
@@ -118,8 +370,7 @@ lemma corres_get_tcb:
   apply (drule bspec)
    apply clarsimp
    apply blast
-  apply (clarsimp simp add: other_obj_relation_def
-                            lookupAround2_known1)
+  apply (clarsimp simp: tcb_relation_cut_def lookupAround2_known1)
   done
 
 lemma lookupAround2_same1[simp]:
@@ -394,6 +645,40 @@ lemma setObject_tcb_strongest:
                         ps_clear_upd)
   done
 
+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 projectKOs
+                 typeError_def opt_map_def opt_pred_def projectKO_opts_defs
+          split: if_split_asm
+                 Structures_H.kernel_object.split_asm
+
+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_tcbs_of'[wp]:
+  "setObject c (notification :: notification) \<lbrace>\<lambda>s. P' (tcbs_of' s)\<rbrace>"
+  by setObject_easy_cases
+
+lemma setObject_cte_tcbSchedNexts_of[wp]:
+  "setObject c (cte :: cte) \<lbrace>\<lambda>s. P' (tcbSchedNexts_of s)\<rbrace>"
+  by setObject_easy_cases
+
+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_tcbQueued[wp]:
+  "setObject c (cte :: cte) \<lbrace>\<lambda>s. P' (tcbQueued |< tcbs_of' s)\<rbrace>"
+  supply inQ_def[simp]
+  by setObject_easy_cases
+
+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 getObject_obj_at':
   assumes x: "\<And>q n ko. loadObject p q n ko =
                 (loadObject_default p q n ko :: ('a :: pspace_storable) kernel)"
@@ -921,7 +1206,7 @@ lemma obj_relation_cut_same_type:
          \<or> (\<exists>sz sz'. a_type ko = AArch (ADeviceData sz) \<and> a_type ko' = AArch (ADeviceData sz'))"
   apply (rule ccontr)
   apply (simp add: obj_relation_cuts_def2 a_type_def)
-  by (auto simp: other_obj_relation_def cte_relation_def
+  by (auto simp: other_obj_relation_def cte_relation_def tcb_relation_cut_def
                  pte_relation_def pde_relation_def
                  pdpte_relation_def pml4e_relation_def
            split: Structures_A.kernel_object.split_asm if_split_asm
@@ -939,6 +1224,16 @@ where
   "exst_same' (KOTCB tcb) (KOTCB tcb') = exst_same tcb tcb'" |
   "exst_same' _ _ = True"
 
+lemma tcbs_of'_non_tcb_update:
+  "\<lbrakk>typ_at' (koTypeOf ko) ptr s'; koTypeOf ko \<noteq> TCBT\<rbrakk>
+   \<Longrightarrow> tcbs_of' (s'\<lparr>ksPSpace := (ksPSpace s')(ptr \<mapsto> ko)\<rparr>) = tcbs_of' s'"
+  by (fastforce simp: typ_at'_def ko_wp_at'_def opt_map_def projectKO_opts_defs
+               split: kernel_object.splits)
+
+lemma typ_at'_koTypeOf:
+  "ko_at' ob' ptr b \<Longrightarrow> typ_at' (koTypeOf (injectKO ob')) ptr b"
+  by (auto simp: typ_at'_def ko_wp_at'_def obj_at'_def project_inject projectKOs)
+
 lemma setObject_other_corres:
   fixes ob' :: "'a :: pspace_storable"
   assumes x: "updateObject ob' = updateObject_default ob'"
@@ -968,7 +1263,7 @@ lemma setObject_other_corres:
   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 (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 simp: obj_at_def a_type_def
@@ -978,6 +1273,14 @@ lemma setObject_other_corres:
   apply (simp only: pspace_relation_def pspace_dom_update dom_fun_upd2 simp_thms)
   apply (elim conjE)
   apply (frule bspec, erule domI)
+  apply (prop_tac "typ_at' (koTypeOf (injectKO ob')) ptr b")
+   subgoal
+     by (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 clarsimp
   apply (rule conjI)
    apply (rule ballI, drule(1) bspec)
    apply (drule domD)
@@ -986,28 +1289,30 @@ lemma setObject_other_corres:
    apply clarsimp
    apply (frule_tac ko'=ko and x'=ptr in obj_relation_cut_same_type,
            (fastforce simp add: is_other_obj_relation_type t)+)
-   apply (erule disjE)
-    apply (simp add: is_other_obj_relation_type t)
-   apply (erule disjE)
-    apply (insert t,
-      clarsimp simp: is_other_obj_relation_type_CapTable a_type_def)
-   apply (erule disjE)
-    apply (insert t, clarsimp simp: is_other_obj_relation_type_UserData a_type_def)
-   apply (insert t, clarsimp simp: is_other_obj_relation_type_DeviceData a_type_def)
-  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)
-    by (clarsimp simp: is_other_obj_relation_type t exst_same_def
-                 split: Structures_A.kernel_object.splits Structures_H.kernel_object.splits
-                        X64_A.arch_kernel_obj.splits)+
+   apply (insert t)
+   apply ((erule disjE
+          | clarsimp simp: is_other_obj_relation_type is_other_obj_relation_type_def a_type_def)+)[1]
+  apply (extract_conjunct \<open>match conclusion in "ekheap_relation _ _" \<Rightarrow> -\<close>)
+   apply (simp only: ekheap_relation_def)
+   apply (rule ballI, drule(1) bspec)
+   apply (drule domD)
+   apply (insert e)
+   apply atomize
+   apply (clarsimp simp: obj_at'_def)
+   apply (erule_tac x=obj in allE)
+   apply (clarsimp simp: projectKO_eq project_inject)
+   apply (case_tac ob;
+          simp_all add: a_type_def other_obj_relation_def etcb_relation_def
+                        is_other_obj_relation_type t exst_same_def)
+     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
@@ -1100,13 +1405,14 @@ lemma typ_at'_valid_obj'_lift:
       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,
+             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 valid_bound_ntfn'_def
-              split: option.splits,
-           wpsimp)
+           simp add: valid_tcb'_def valid_tcb_state'_def split_def none_top_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)
@@ -1389,32 +1695,6 @@ lemma set_ep_bitmapQ_no_L2_orphans[wp]:
   apply (wp hoare_Ball_helper hoare_vcg_all_lift updateObject_default_inv | simp add: bitmapQ_def)+
   done
 
-lemma set_ep_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> setEndpoint epptr ep \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: Invariants_H.valid_queues_def)
-  apply (wp hoare_vcg_conj_lift)
-    apply (simp add: setEndpoint_def valid_queues_no_bitmap_def)
-    apply (wp hoare_Ball_helper hoare_vcg_all_lift)
-      apply (rule obj_at_setObject2)
-      apply (clarsimp simp: updateObject_default_def in_monad)
-     apply (wp updateObject_default_inv set_ep_valid_bitmapQ[unfolded setEndpoint_def]
-            | simp add: valid_queues_no_bitmap_def)+
-  done
-
-lemma set_ep_valid_queues'[wp]:
-  "\<lbrace>valid_queues'\<rbrace> setEndpoint epptr ep \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (unfold setEndpoint_def)
-  apply (simp only: valid_queues'_def imp_conv_disj
-                    obj_at'_real_def)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-    apply (rule setObject_ko_wp_at)
-      apply simp
-     apply (simp add: objBits_simps')
-    apply simp
-   apply (wp updateObject_default_inv | simp)+
-  apply (clarsimp simp: projectKOs ko_wp_at'_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>"
@@ -1614,34 +1894,6 @@ lemma set_ntfn_bitmapQ_no_L2_orphans[wp]:
   apply (wp hoare_Ball_helper hoare_vcg_all_lift updateObject_default_inv | simp)+
   done
 
-lemma set_ntfn_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> setNotification p ntfn \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: Invariants_H.valid_queues_def)
-  apply (rule hoare_pre)
-   apply (wp hoare_vcg_conj_lift)
-    apply (simp add: setNotification_def valid_queues_no_bitmap_def)
-    apply (wp hoare_Ball_helper hoare_vcg_all_lift)
-      apply (rule obj_at_setObject2)
-      apply (clarsimp simp: updateObject_default_def in_monad)
-     apply (wp updateObject_default_inv set_ep_valid_bitmapQ[unfolded setEndpoint_def]
-            | simp add: valid_queues_no_bitmap_def)+
-  done
-
-lemma set_ntfn_valid_queues'[wp]:
-  "\<lbrace>valid_queues'\<rbrace> setNotification p ntfn \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (unfold setNotification_def)
-  apply (rule setObject_ntfn_pre)
-  apply (simp only: valid_queues'_def imp_conv_disj
-                    obj_at'_real_def)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-    apply (rule setObject_ko_wp_at)
-      apply simp
-     apply (simp add: objBits_simps')
-    apply simp
-   apply (wp updateObject_default_inv | simp)+
-  apply (clarsimp simp: projectKOs ko_wp_at'_def)
-  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>
@@ -2052,6 +2304,21 @@ lemma setNotification_ct_idle_or_in_cur_domain'[wp]:
 crunch gsUntypedZeroRanges[wp]: setNotification "\<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>"
+  assumes nexts: "\<And>P. f \<lbrace>\<lambda>s. P (tcbSchedNexts_of s)\<rbrace>"
+  shows "f \<lbrace>sym_heap_sched_pointers\<rbrace>"
+  by (rule_tac f=tcbSchedPrevs_of in hoare_lift_Pf2; wpsimp wp: assms)
+
+crunches setNotification
+  for tcbSchedNexts_of[wp]: "\<lambda>s. P (tcbSchedNexts_of s)"
+  and tcbSchedPrevs_of[wp]: "\<lambda>s. P (tcbSchedPrevs_of s)"
+  and valid_sched_pointers[wp]: valid_sched_pointers
+  and ksReadyQueues[wp]: "\<lambda>s. P (ksReadyQueues s)"
+  and ksReadyQueuesL1Bitmap[wp]: "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
+  and ksReadyQueuesL2Bitmap[wp]: "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
+  (simp: updateObject_default_def)
+
 lemma set_ntfn_minor_invs':
   "\<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))
@@ -2061,9 +2328,10 @@ lemma set_ntfn_minor_invs':
          and (\<lambda>s. ptr \<noteq> ksIdleThread s) \<rbrace>
      setNotification ptr val
    \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (clarsimp simp add: invs'_def valid_state'_def cteCaps_of_def)
-  apply (wp irqs_masked_lift valid_irq_node_lift untyped_ranges_zero_lift,
-    simp_all add: o_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')+
@@ -2149,21 +2417,17 @@ crunch typ_at'[wp]: doMachineOp "\<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>"
+  "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
-                valid_pspace'_def valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs
-       | wp cur_tcb_lift sch_act_wf_lift tcb_in_cur_domain'_lift
-       | fastforce elim: state_refs_of'_pspaceI)+
+      | wp
+      | fastforce elim: state_refs_of'_pspaceI)+
 
 crunch obj_at'[wp]: doMachineOp "\<lambda>s. P (obj_at' P' p s)"
 
@@ -2193,5 +2457,15 @@ lemma obj_at'_is_canonical:
   apply (clarsimp simp: obj_at'_def pspace_canonical'_def projectKOs)
   by (drule_tac x=t in bspec) clarsimp+
 
+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 aligned'_distinct'_ko_at'I = aligned_distinct_obj_atI'
+
 end
 end
diff --git a/proof/refine/X64/Refine.thy b/proof/refine/X64/Refine.thy
index 530bbac778..9b579df531 100644
--- a/proof/refine/X64/Refine.thy
+++ b/proof/refine/X64/Refine.thy
@@ -80,7 +80,7 @@ lemma typ_at_UserDataI:
   apply (drule (1) bspec)
   apply clarsimp
   apply (subst mask_lower_twice [where n = pageBits, OF pbfs_atleast_pageBits, symmetric])
-  apply (clarsimp simp: obj_relation_cuts_def2 pte_relation_def
+  apply (clarsimp simp: obj_relation_cuts_def2 pte_relation_def tcb_relation_cut_def
                         cte_relation_def other_obj_relation_def
                         pde_relation_def pdpte_relation_def pml4e_relation_def
               split: Structures_A.kernel_object.split_asm
@@ -111,7 +111,7 @@ lemma typ_at_DeviceDataI:
   apply (drule (1) bspec)
   apply clarsimp
   apply (subst mask_lower_twice [where n = pageBits, OF pbfs_atleast_pageBits, symmetric])
-  apply (clarsimp simp: obj_relation_cuts_def2 pte_relation_def
+  apply (clarsimp simp: obj_relation_cuts_def2 pte_relation_def tcb_relation_cut_def
                         cte_relation_def other_obj_relation_def
                         pde_relation_def pdpte_relation_def pml4e_relation_def
               split: Structures_A.kernel_object.split_asm
@@ -558,7 +558,7 @@ lemma kernel_corres':
            apply simp
            apply (rule handleInterrupt_corres[simplified dc_def])
           apply simp
-          apply (wp hoare_drop_imps hoare_vcg_all_lift)[1]
+          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>
@@ -635,7 +635,7 @@ lemma entry_corres:
     apply (rule corres_split[OF getCurThread_corres])
       apply (rule corres_split)
          apply simp
-         apply (rule threadset_corresT)
+         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)
@@ -647,7 +647,7 @@ lemma entry_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, simp add: invs_def cur_tcb_def)
+         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'
@@ -655,8 +655,8 @@ lemma entry_corres:
                  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)
+              | (wps, wp threadSet_st_tcb_at2))+
+   apply (fastforce simp: invs_def cur_tcb_def)
   apply (clarsimp simp: ct_in_state'_def)
   done
 
diff --git a/proof/refine/X64/Retype_R.thy b/proof/refine/X64/Retype_R.thy
index b63669123a..1e87a9df47 100644
--- a/proof/refine/X64/Retype_R.thy
+++ b/proof/refine/X64/Retype_R.thy
@@ -315,7 +315,7 @@ lemma state_relation_null_filterE:
      null_filter (caps_of_state t) = null_filter (caps_of_state s);
      null_filter' (ctes_of t') = null_filter' (ctes_of s');
      pspace_relation (kheap t) (ksPSpace t');
-     ekheap_relation (ekheap t) (ksPSpace t');
+     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';
@@ -1003,7 +1003,7 @@ lemma retype_ekheap_relation:
      apply (intro impI conjI)
       apply clarsimp
       apply (drule_tac x=a in bspec,force)
-      apply (clarsimp simp add: other_obj_relation_def split: if_split_asm)
+      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 X64_H.object_type.splits
@@ -1193,6 +1193,149 @@ lemma update_gs_simps[simp]:
    gsUserPages_update (\<lambda>ups x. if x \<in> ptrs then Some X64HugePage else ups x)"
   by (simp_all add: update_gs_def)
 
+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 -
+  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_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>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 (fastforce simp: ptr_add_def p_assoc_help)
+    done
+qed
+
+lemma retype_tcbSchedPrevs_of:
+  assumes   vs': "pspace_aligned' s'" "pspace_distinct' s'"
+  assumes   pn': "pspace_no_overlap' ptr sz s'"
+  assumes    ko: "makeObjectKO dev ty = Some ko"
+  assumes 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
+    "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 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_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
+    "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 -
+  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
+    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
+    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 ksReadyQueues_update_gs[simp]:
+  "ksReadyQueues (update_gs tp us addrs s) = ksReadyQueues s"
+  by (simp add: update_gs_def
+         split: aobject_type.splits Structures_A.apiobject_type.splits)
+
 lemma retype_state_relation:
   notes data_map_insert_def[simp del]
   assumes  sr:   "(s, s') \<in> state_relation"
@@ -1221,7 +1364,7 @@ lemma retype_state_relation:
           \<in> state_relation"
   (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)
+  proof (rule state_relation_null_filterE[OF sr refl _ _ _ _ _ _ _ _ vs'], simp_all add: trans_state_update[symmetric] del: trans_state_update)
 
   have cover':"range_cover ptr sz (objBitsKO ko) m"
     by (rule range_cover_rel[OF cover objBits_le_obj_bits_api[OF ko] num_r])
@@ -1410,6 +1553,16 @@ lemma retype_state_relation:
                                    else cns x" in exI, simp)
       apply (rule_tac x=id in exI, simp)+
     done
+
+  have rdyqrel: "ready_queues_relation s s'"
+    using sr by (simp add: state_relation_def)
+
+  thus "ready_queues_relation_2 (ready_queues s) (ksReadyQueues s')
+                                (?ps' |> tcb_of' |> tcbSchedNext) (?ps' |> tcb_of' |> tcbSchedPrev)
+                                (\<lambda>d p. inQ d p |< (?ps' |> tcb_of'))"
+    using retype_ready_queues_relation[OF _ vs' pn' ko cover num_r]
+    by (clarsimp simp: ready_queues_relation_def Let_def)
+
 qed
 
 lemma new_cap_addrs_fold':
@@ -2432,7 +2585,6 @@ 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 :: Structures_H.notification)
-             | Structures_A.TCBObject \<Rightarrow> ko = injectKO (makeObject :: tcb)
              | _ \<Rightarrow> False \<rbrakk> \<Longrightarrow>
     obj_relation_retype (default_object ty dev n) ko"
   apply (rule obj_relation_retype_other_obj)
@@ -2453,6 +2605,13 @@ lemma other_objs_default_relation:
                  split: Structures_A.apiobject_type.split_asm)
   done
 
+lemma tcb_relation_retype:
+  "obj_relation_retype (default_object Structures_A.TCBObject dev n) (KOTCB makeObject)"
+  by (clarsimp simp: default_object_def obj_relation_retype_def tcb_relation_def default_tcb_def
+                     makeObject_tcb makeObject_cte new_context_def newContext_def
+                     fault_rel_optionation_def initContext_def default_arch_tcb_def newArchTCB_def
+                     arch_tcb_relation_def objBits_simps' tcb_relation_cut_def)
+
 lemma captable_relation_retype:
   "n < word_bits \<Longrightarrow>
    obj_relation_retype (default_object Structures_A.CapTableObject dev n) (KOCTE makeObject)"
@@ -2595,6 +2754,7 @@ lemma ksMachineState_update_gs[simp]:
   "ksMachineState (update_gs tp us addrs s) = ksMachineState s"
   by (simp add: update_gs_def
          split: aobject_type.splits Structures_A.apiobject_type.splits)
+
 lemma update_gs_ksMachineState_update_swap:
   "update_gs tp us addrs (ksMachineState_update f s) =
    ksMachineState_update f (update_gs tp us addrs s)"
@@ -3230,10 +3390,10 @@ proof (intro conjI impI)
        apply (rule_tac ptr="x + xa" in cte_wp_at_tcbI', assumption+)
         apply fastforce
        apply simp
-      apply (rename_tac thread_state mcp priority bool option nat cptr vptr bound user_context)
-      apply (case_tac thread_state, simp_all add: valid_tcb_state'_def
-                                                  valid_bound_ntfn'_def obj_at_disj'
-                                           split: option.splits)[2]
+      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' none_top_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)])
@@ -3960,16 +4120,6 @@ lemma sch_act_wf_lift_asm:
   apply auto
   done
 
-lemma valid_queues_lift_asm':
-  assumes tat: "\<And>d p t. \<lbrace>\<lambda>s. \<not> obj_at' (inQ d p) t s \<and> Q d p s\<rbrace> f \<lbrace>\<lambda>_ s. \<not> obj_at' (inQ d p) t s\<rbrace>"
-  and     prq: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueues s)\<rbrace>"
-  shows   "\<lbrace>\<lambda>s. valid_queues' s \<and> (\<forall>d p. Q d p s)\<rbrace> f \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp only: valid_queues'_def imp_conv_disj)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift
-            tat prq)
-  apply simp
-  done
-
 lemma createObjects'_ct[wp]:
   "\<lbrace>\<lambda>s. P (ksCurThread s)\<rbrace> createObjects' p n v us \<lbrace>\<lambda>rv s. P (ksCurThread s)\<rbrace>"
   by (rule createObjects_pspace_only, simp)
@@ -4368,35 +4518,157 @@ crunch ksMachine[wp]: createObjects "\<lambda>s. P (ksMachineState s)"
 crunch cur_domain[wp]: createObjects "\<lambda>s. P (ksCurDomain s)"
   (simp: unless_def)
 
-lemma createNewCaps_valid_queues':
-  "\<lbrace>valid_queues' and pspace_no_overlap' ptr sz
-       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_queues'\<rbrace>"
-  apply (wp valid_queues_lift_asm' [OF createNewCaps_obj_at2])
-  apply (clarsimp simp: projectKOs)
-  apply (simp add: makeObjectKO_def
-            split: object_type.split_asm
-                   apiobject_type.split_asm)
-  apply (clarsimp simp: inQ_def)
-  apply (auto simp: makeObject_tcb
-             split: object_type.splits apiobject_type.splits)
+lemma createObjects_valid_bitmaps:
+  "createObjects' ptr n val gbits \<lbrace>valid_bitmaps\<rbrace>"
+  apply (clarsimp simp: createObjects'_def alignError_def split_def)
+  apply (wp case_option_wp[where P="\<lambda>_. P" and P'=P for P, simplified] assert_inv
+         | clarsimp simp del: fun_upd_apply)+
+  apply (clarsimp simp: valid_bitmaps_def valid_bitmapQ_def bitmapQ_def bitmapQ_no_L2_orphans_def
+                        bitmapQ_no_L1_orphans_def)
   done
 
-lemma createNewCaps_valid_queues:
-  "\<lbrace>valid_queues and pspace_no_overlap' ptr sz
-       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_queues\<rbrace>"
-  apply (rule hoare_gen_asm)
-  apply (wpsimp wp: valid_queues_lift_asm createNewCaps_obj_at2[where sz=sz])
-       apply (clarsimp simp: projectKO_opts_defs)
-       apply (simp add: inQ_def)
-      apply (wpsimp wp: createNewCaps_pred_tcb_at'[where sz=sz])+
+lemma valid_bitmaps_gsCNodes_update[simp]:
+  "valid_bitmaps (gsCNodes_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
+
+lemma valid_bitmaps_gsUserPages_update[simp]:
+  "valid_bitmaps (gsUserPages_update f s) = valid_bitmaps s"
+  by (simp add: valid_bitmaps_def bitmapQ_defs)
+
+crunches curDomain, copyGlobalMappings
+  for valid_bitmaps[wp]: valid_bitmaps
+  and sched_pointers[wp]: "\<lambda>s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)"
+  and valid_sched_pointers[wp]: valid_sched_pointers
+  (wp: crunch_wps valid_bitmaps_lift)
+
+lemma createNewCaps_valid_bitmaps:
+  "\<lbrace>\<lambda>s. valid_pspace' s \<and> pspace_no_overlap' ptr sz s \<and> valid_bitmaps s\<rbrace>
+   createNewCaps ty ptr n us dev
+   \<lbrace>\<lambda>_. valid_bitmaps\<rbrace>"
+  unfolding createNewCaps_def
+  apply (clarsimp simp: X64_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 (wpsimp wp: createObjects_valid_bitmaps)
+           by (wpsimp wp: createObjects_valid_bitmaps[simplified o_def] mapM_x_wp
+               | simp add: makeObject_tcb objBits_def createObjects_def
+               | intro conjI impI)+
+
+lemma createObjects_sched_queues:
+  "\<lbrace>\<lambda>s. n \<noteq> 0
+        \<and> range_cover ptr sz (objBitsKO val + gbits) n
+        \<and> P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)
+        \<and> (case val of KOTCB tcb \<Rightarrow> tcbSchedNext tcb = None \<and> tcbSchedPrev tcb = None
+                     | _ \<Rightarrow> True)
+        \<and> pspace_aligned' s \<and> pspace_distinct' s
+        \<and> pspace_no_overlap' ptr sz s\<rbrace>
+   createObjects' ptr n val gbits
+   \<lbrace>\<lambda>_ s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of 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>_ s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)\<rbrace>"
+    proof -
+      have shiftr_not_zero:" 1 \<le> ((of_nat n)::machine_word) << gbits"
+        using range_cover_not_zero_shift[OF not_0 cover,where gbits = gbits]
+        by (simp add:word_le_sub1)
+      show ?thesis
+        supply projectKOs[simp]
+        apply (clarsimp simp: createObjects'_def unless_def alignError_def split_def)
+        apply (wp | clarsimp simp del: fun_upd_apply)+
+        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 (clarsimp simp: foldr_upd_app_if)
+        apply (rule_tac a="tcbSchedNexts_of s" and b="tcbSchedPrevs_of s"
+                     in rsubst2[rotated, OF sym sym, where P=P])
+          apply (rule ext)
+          apply (clarsimp simp: opt_map_def)
+          apply (frule (3) retype_ksPSpace_None[simplified mult.commute])
+            apply (fastforce intro: cover)
+           apply fastforce
+          apply (clarsimp split: kernel_object.splits option.splits)
+         apply (rule ext)
+         apply (clarsimp simp: opt_map_def)
+         apply (frule (3) retype_ksPSpace_None[simplified mult.commute])
+           apply (fastforce intro: cover)
+          apply fastforce
+         apply (clarsimp split: kernel_object.splits option.splits)
+        apply simp
+        done
+    qed
+  qed
+qed
+
+lemma createNewCaps_sched_queues:
+  assumes cover: "range_cover ptr sz (APIType_capBits ty us) n"
+  assumes not_0: "n \<noteq> 0"
+  shows
+    "\<lbrace>\<lambda>s. valid_pspace' s \<and> pspace_no_overlap' ptr sz s
+          \<and> P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)\<rbrace>
+     createNewCaps ty ptr n us dev
+     \<lbrace>\<lambda>_ s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)\<rbrace>"
+  unfolding createNewCaps_def
+  apply (clarsimp simp: X64_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)
+           apply (wpsimp wp: mapM_x_wp' createObjects_sched_queues
+                       simp: curDomain_def)
+           by (wpsimp wp: mapM_x_wp' createObjects_sched_queues[simplified o_def]
+                          threadSet_sched_pointers
+               | simp add: objBitsKO_def APIType_capBits_def valid_pspace'_def makeObject_tcb
+                           objBits_def archObjSize_def createObjects_def
+                           bit_simps
+               | intro conjI impI)+
+
+lemma createObjects_valid_sched_pointers:
+  "\<lbrace>\<lambda>s. valid_sched_pointers s
+        \<and> (case val of KOTCB tcb \<Rightarrow> tcbSchedNext tcb = None \<and> tcbSchedPrev tcb = None
+                     | _ \<Rightarrow> True)\<rbrace>
+   createObjects' ptr n val gbits
+   \<lbrace>\<lambda>_. valid_sched_pointers\<rbrace>"
+  supply projectKOs[simp]
+  apply (clarsimp simp: createObjects'_def unless_def alignError_def split_def)
+  apply (wp case_option_wp[where P="\<lambda>_. P" and P'=P for P, simplified] assert_inv
+         | clarsimp simp del: fun_upd_apply)+
+  apply (clarsimp simp: valid_sched_pointers_def foldr_upd_app_if opt_pred_def opt_map_def comp_def)
+  apply (cases "tcb_of' val"; clarsimp)
   done
 
+lemma createNewCaps_valid_sched_pointers:
+  "\<lbrace>\<lambda>s. valid_pspace' s \<and> pspace_no_overlap' ptr sz s \<and> valid_sched_pointers s\<rbrace>
+   createNewCaps ty ptr n us dev
+   \<lbrace>\<lambda>_. valid_sched_pointers\<rbrace>"
+  unfolding createNewCaps_def
+  apply (clarsimp simp: X64_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 (wpsimp wp: createObjects_valid_sched_pointers)
+           by (wpsimp wp: createObjects_valid_sched_pointers[simplified o_def] mapM_x_wp
+                          threadSet_valid_sched_pointers
+               | simp add: makeObject_tcb objBits_def createObjects_def
+               | intro conjI impI)+
+
 lemma mapM_x_threadSet_valid_pspace:
   "\<lbrace>valid_pspace' and K (curdom \<le> maxDomain)\<rbrace>
     mapM_x (threadSet (tcbDomain_update (\<lambda>_. curdom))) addrs \<lbrace>\<lambda>y. valid_pspace'\<rbrace>"
@@ -4783,12 +5055,13 @@ proof (rule hoare_gen_asm, elim conjE)
                createNewCaps_valid_arch_state
                valid_irq_node_lift_asm [unfolded pred_conj_def, OF _ createNewCaps_obj_at']
                createNewCaps_irq_handlers' createNewCaps_vms createNewCaps_ioports'
-               createNewCaps_valid_queues
-               createNewCaps_valid_queues'
                createNewCaps_pred_tcb_at' cnc_ct_not_inQ
                createNewCaps_ct_idle_or_in_cur_domain'
                createNewCaps_sch_act_wf
                createNewCaps_urz[where sz=sz]
+               createNewCaps_sched_queues[OF cover not_0]
+               createNewCaps_valid_sched_pointers
+               createNewCaps_valid_bitmaps
            | simp)+
   using not_0
   apply (clarsimp simp: valid_pspace'_def)
@@ -4861,35 +5134,6 @@ lemma createObjects_sch:
   apply (wp sch_act_wf_lift_asm createObjects_pred_tcb_at' createObjects_orig_obj_at3 | force)+
   done
 
-lemma createObjects_queues:
-  "\<lbrace>\<lambda>s. valid_queues 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. valid_queues\<rbrace>"
-  apply (wpsimp wp: valid_queues_lift_asm [unfolded pred_conj_def, OF createObjects_orig_obj_at3]
-                    createObjects_pred_tcb_at' [unfolded pred_conj_def])
-      apply fastforce
-     apply wp+
-  apply fastforce
-  done
-
-lemma createObjects_queues':
-  assumes no_tcb: "\<And>t. projectKO_opt val \<noteq> Some (t::tcb)"
-  shows
-  "\<lbrace>\<lambda>s. valid_queues' 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. valid_queues'\<rbrace>"
-  apply (simp add: createObjects_def)
-  apply (wp valid_queues_lift_asm')
-    apply (wp createObjects_orig_obj_at2')
-    apply clarsimp
-    apply assumption
-   apply wp
-  apply (clarsimp simp: no_tcb split: option.splits)
-  apply fastforce
-  done
-
 lemma createObjects_no_cte_ifunsafe':
   assumes no_cte: "\<And>c. projectKO_opt val \<noteq> Some (c::cte)"
   assumes no_tcb: "\<And>t. projectKO_opt val \<noteq> Some (t::tcb)"
@@ -5155,43 +5399,53 @@ proof -
       apply (simp)+
     done
   show ?thesis
-  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 createObjects_queues)
-   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'
-             createObjects_queues' [OF no_tcb] createObjects_no_cte_ioports
-             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'
-             createObjects_queues' [OF no_tcb] assms
-             createObjects_pspace_domain_valid co_ct_not_inQ
-             createObjects_ct_idle_or_in_cur_domain' createObjects_no_cte_ioports
-             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 (clarsimp simp: invs'_def no_tcb valid_state'_def no_cte  split: option.splits)
-  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' assms)
+      apply (rule hoare_vcg_conj_lift)
+       apply (simp add: createObjects_def)
+       apply (wp createObjects_idle')
+      apply (wp irqs_masked_lift createObjects_no_cte_valid_global
+                createObjects_valid_arch createObjects_irq_state
+                createObjects_no_cte_irq_handlers createObjects_no_cte_ioports assms
+            | 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]
+                createObjects_sched_queues
+            | 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:
@@ -5227,7 +5481,7 @@ lemma gcd_corres: "corres (=) \<top> \<top> (gets cur_domain) curDomain"
 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. 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
@@ -5238,7 +5492,7 @@ lemma retype_region2_extra_ext_mapM_x_corres:
     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. tcb_at' t 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)
@@ -5246,8 +5500,10 @@ lemma retype_region2_extra_ext_mapM_x_corres:
             apply (case_tac tcb')
             apply simp
            apply fastforce
-          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
@@ -5280,10 +5536,11 @@ lemma retype_region2_obj_at:
   apply (auto simp: obj_at_def default_object_def is_tcb_def)
   done
 
-lemma createObjects_tcb_at':
+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\<rbrace>
-   createObjects ptr n (KOTCB makeObject) 0 \<lbrace>\<lambda>ptrs s. \<forall>addr\<in>set ptrs. tcb_at' addr 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
@@ -5391,8 +5648,9 @@ lemma corres_retype_region_createNewCaps:
                  apply (rule corres_retype[where 'a = tcb],
                         simp_all add: obj_bits_api_def objBits_simps' pageBits_def
                                       APIType_map2_def makeObjectKO_def
-                                      other_objs_default_relation)[1]
+                                      tcb_relation_retype)[1]
                  apply (fastforce simp: range_cover_def)
+                apply (simp add: tcb_relation_retype)
                 apply (rule corres_split_nor)
                    apply (simp add: APIType_map2_def)
                    apply (rule retype_region2_extra_ext_mapM_x_corres)
@@ -5402,7 +5660,7 @@ lemma corres_retype_region_createNewCaps:
                  apply wp
                 apply wp
                apply ((wp retype_region2_obj_at | simp add: APIType_map2_def)+)[1]
-              apply ((wp createObjects_tcb_at'[where sz=sz]
+              apply ((wp createObjects_Not_tcbQueued[where sz=sz]
                       | simp add: APIType_map2_def objBits_simps' obj_bits_api_def)+)[1]
              apply simp
             apply simp
diff --git a/proof/refine/X64/Schedule_R.thy b/proof/refine/X64/Schedule_R.thy
index 4d6bf37acf..06186ff96d 100644
--- a/proof/refine/X64/Schedule_R.thy
+++ b/proof/refine/X64/Schedule_R.thy
@@ -15,11 +15,6 @@ declare hoare_weak_lift_imp[wp_split del]
 (* Levity: added (20090713 10:04:12) *)
 declare sts_rel_idle [simp]
 
-lemma invs_no_cicd'_queues:
-  "invs_no_cicd' s \<Longrightarrow> valid_queues s"
-  unfolding invs_no_cicd'_def
-  by simp
-
 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)"
@@ -86,227 +81,231 @@ lemma schedule_choose_new_thread_sched_act_rct[wp]:
   unfolding schedule_choose_new_thread_def
   by wp
 
+\<comment> \<open>This proof shares many similarities with the proof of @{thm tcbSchedEnqueue_corres}\<close>
 lemma tcbSchedAppend_corres:
-  notes trans_state_update'[symmetric, simp del]
-  shows
-  "corres dc (is_etcb_at t) (tcb_at' t and Invariants_H.valid_queues and valid_queues') (tcb_sched_action (tcb_sched_append) t) (tcbSchedAppend t)"
-  apply (simp only: tcbSchedAppend_def tcb_sched_action_def)
-  apply (rule corres_symb_exec_r [OF _ _ threadGet_inv, 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, simp)
-   apply (rule no_fail_pre, wp, simp)
-  apply (case_tac queued)
-   apply (simp add: unless_def when_def)
-   apply (rule corres_no_failI)
-    apply wp+
-   apply (clarsimp simp: in_monad ethread_get_def gets_the_def bind_assoc
-                         assert_opt_def exec_gets is_etcb_at_def get_etcb_def get_tcb_queue_def
-                         set_tcb_queue_def simpler_modify_def)
-
-   apply (subgoal_tac "tcb_sched_append t (ready_queues a (tcb_domain y) (tcb_priority y))
-                       = (ready_queues a (tcb_domain y) (tcb_priority y))")
-    apply (simp add: state_relation_def ready_queues_relation_def)
-   apply (clarsimp simp: tcb_sched_append_def state_relation_def
-                         valid_queues'_def ready_queues_relation_def
-                         ekheap_relation_def etcb_relation_def
-                         obj_at'_def inQ_def projectKO_eq project_inject)
-   apply (drule_tac x=t in bspec,clarsimp)
+  "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_append tcb_ptr) (tcbSchedAppend tcbPtr)"
+  supply if_split[split del]
+         heap_path_append[simp del] fun_upd_apply[simp del] distinct_append[simp del]
+  supply projectKOs[simp]
+  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_append_def get_tcb_queue_def
+                        tcbSchedAppend_def getQueue_def unless_def when_def)
+  apply (rule corres_symb_exec_l[OF _ _ ethread_get_sp]; (solves wpsimp)?)
+  apply (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]; 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)
+   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 (clarsimp simp: unless_def when_def cong: if_cong)
-  apply (rule stronger_corres_guard_imp)
-    apply (rule corres_split[where r'="(=)"])
-       apply (rule ethreadget_corres)
-       apply (simp add: etcb_relation_def)
-      apply (rule corres_split[where r'="(=)"])
-         apply (rule ethreadget_corres)
-         apply (simp add: etcb_relation_def)
-        apply (rule corres_split[where r'="(=)"])
-           apply simp
-           apply (rule getQueue_corres)
-          apply (rule corres_split_noop_rhs2)
-             apply (simp add: tcb_sched_append_def)
-             apply (intro conjI impI)
-              apply (rule corres_guard_imp)
-                apply (rule setQueue_corres)
-               prefer 3
-               apply (rule_tac P=\<top> and Q="K (t \<notin> set queuea)" in corres_assume_pre)
-               apply simp
-              apply simp
-             apply simp
-            apply (rule corres_split_noop_rhs2)
-               apply (rule addToBitmap_if_null_noop_corres)
-              apply (rule threadSet_corres_noop, simp_all add: tcb_relation_def exst_same_def)[1]
-             apply wp+
-          apply (wp getObject_tcb_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)
+  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)?)
+
+  \<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)
+
+  apply (rule corres_from_valid_det)
+    apply (fastforce intro: det_wp_modify det_wp_pre simp: set_tcb_queue_def)
+   apply (wpsimp simp: tcbQueueAppend_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'_tcbQueueEnd_ksReadyQueues simp: obj_at'_def)
+
+  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 simp: setQueue_def tcbQueueAppend_def)
+  apply normalise_obj_at'
+  apply (frule (1) tcb_at_is_etcb_at)
+  apply (clarsimp simp: obj_at_def is_etcb_at_def etcb_at_def)
+  apply (rename_tac s d p s' tcb' tcb etcb)
+  apply (frule_tac t=tcbPtr in ekheap_relation_tcb_domain_priority)
+    apply (force simp: obj_at_def)
+   apply (force simp: obj_at'_def)
+  apply (clarsimp split: if_splits)
+  apply (cut_tac ts="ready_queues s d p" in list_queue_relation_nil)
+   apply (force dest!: spec simp: list_queue_relation_def)
+  apply (cut_tac ts="ready_queues s (tcb_domain etcb) (tcb_priority etcb)"
+              in obj_at'_tcbQueueEnd_ksReadyQueues)
+      apply fast
+     apply fast
+    apply fastforce
+   apply fastforce
+  apply (cut_tac xs="ready_queues s d p" in heap_path_head')
+   apply (force dest!: spec simp: list_queue_relation_def)
+  apply (clarsimp simp: list_queue_relation_def)
+
+  apply (case_tac "d \<noteq> tcb_domain etcb \<or> p \<noteq> tcb_priority etcb")
+   apply (cut_tac d=d and d'="tcb_domain etcb" and p=p and p'="tcb_priority etcb"
+               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)
+    apply (metis inQ_def option.simps(5) tcb_of'_TCB)
+   apply (intro conjI impI; clarsimp)
+
+    \<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 (tcbQueueEnd (ksReadyQueues s' (tcb_domain etcb, tcb_priority etcb)))
+                    \<notin> set (ready_queues s d p)")
+    apply (erule orthD2)
+    apply (drule_tac x="tcb_domain etcb" in spec)
+    apply (drule_tac x="tcb_priority etcb" in spec)
+    apply clarsimp
+    apply (drule_tac x="the (tcbQueueEnd (ksReadyQueues s' (tcb_domain etcb, tcb_priority etcb)))"
+                 in spec)
+    subgoal by (auto simp: in_opt_pred opt_map_red)
+   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";
+              clarsimp 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 split: if_splits)
+     apply (case_tac "t = the (tcbQueueEnd (ksReadyQueues s' (tcb_domain etcb, tcb_priority etcb)))")
+      apply (clarsimp simp: inQ_def opt_pred_def fun_upd_apply)
+     apply (clarsimp simp: inQ_def in_opt_pred opt_map_def fun_upd_apply)
+    apply (clarsimp simp: fun_upd_apply split: if_splits)
+   apply (clarsimp simp: fun_upd_apply split: if_splits)
+
+  \<comment> \<open>d = tcb_domain tcb \<and> p = tcb_priority tcb\<close>
+  apply clarsimp
+  apply (drule_tac x="tcb_domain etcb" in spec)
+  apply (drule_tac x="tcb_priority etcb" in spec)
+  apply (cut_tac ts="ready_queues s (tcb_domain etcb) (tcb_priority etcb)"
+              in tcbQueueHead_iff_tcbQueueEnd)
+   apply (force simp: list_queue_relation_def)
+  apply (frule valid_tcbs'_maxDomain[where t=tcbPtr], simp add: obj_at'_def)
+  apply (frule valid_tcbs'_maxPriority[where t=tcbPtr], simp add: obj_at'_def)
+  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)
+  apply (intro conjI; clarsimp)
+
+   \<comment> \<open>the ready queue was originally empty\<close>
+   apply (force simp: inQ_def in_opt_pred fun_upd_apply opt_map_def obj_at'_def
+                      queue_end_valid_def prev_queue_head_def
+               split: if_splits option.splits)
+
+   \<comment> \<open>the ready queue was not originally empty\<close>
+  apply (drule (2) heap_ls_append[where new=tcbPtr])
+  apply (rule conjI)
+   apply (clarsimp simp: fun_upd_apply queue_end_valid_def opt_map_def split: if_splits)
+  apply (rule conjI)
+   apply (clarsimp simp: fun_upd_apply queue_end_valid_def)
+  apply (rule conjI)
+   apply (subst opt_map_upd_triv)
+    apply (clarsimp simp: opt_map_def fun_upd_apply queue_end_valid_def split: if_splits)
+   apply (clarsimp simp: prev_queue_head_def fun_upd_apply split: if_splits)
+  by (clarsimp simp: inQ_def in_opt_pred fun_upd_apply queue_end_valid_def split: if_splits)
+
+lemma tcbQueueAppend_valid_objs'[wp]:
+  "\<lbrace>\<lambda>s. valid_objs' s \<and> tcb_at' tcbPtr s \<and> (\<forall>end. tcbQueueEnd queue = Some end \<longrightarrow> tcb_at' end s)\<rbrace>
+   tcbQueueAppend queue tcbPtr
+   \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
+  unfolding tcbQueueAppend_def
+  apply (wpsimp wp: hoare_vcg_if_lift2 hoare_vcg_imp_lift')
+  apply (clarsimp simp: tcbQueueEmpty_def valid_bound_tcb'_def split: option.splits)
+  done
+
+lemma tcbSchedAppend_valid_objs'[wp]:
+  "\<lbrace>valid_objs' and pspace_aligned' and pspace_distinct'\<rbrace>
+   tcbSchedAppend tcbPtr
+   \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
+  apply (clarsimp simp: tcbSchedAppend_def setQueue_def)
+  apply (wpsimp wp: threadSet_valid_objs' threadGet_wp hoare_vcg_all_lift)
+  apply (normalise_obj_at', rename_tac tcb "end")
+  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
+  apply (frule tcbQueueHead_iff_tcbQueueEnd)
+  apply (force dest!: obj_at'_tcbQueueEnd_ksReadyQueues simp: tcbQueueEmpty_def obj_at'_def)
   done
 
-
-crunches tcbSchedEnqueue, tcbSchedAppend, tcbSchedDequeue
-  for valid_pspace'[wp]: valid_pspace'
-  and valid_arch_state'[wp]: valid_arch_state'
-  (simp: unless_def)
-
 crunches tcbSchedAppend, tcbSchedDequeue
   for pred_tcb_at'[wp]: "pred_tcb_at' proj P t"
   (wp: threadSet_pred_tcb_no_state simp: unless_def tcb_to_itcb'_def)
 
 crunch state_refs_of'[wp]: setQueue "\<lambda>s. P (state_refs_of' s)"
 
-lemma removeFromBitmap_valid_queues_no_bitmap_except[wp]:
-" \<lbrace> valid_queues_no_bitmap_except t \<rbrace>
-     removeFromBitmap d p
-  \<lbrace>\<lambda>_. valid_queues_no_bitmap_except t \<rbrace>"
-  unfolding bitmapQ_defs valid_queues_no_bitmap_except_def
-  by (wp| clarsimp simp: bitmap_fun_defs)+
-
-lemma removeFromBitmap_bitmapQ:
-  "\<lbrace> \<lambda>s. True \<rbrace> removeFromBitmap d p \<lbrace>\<lambda>_ s. \<not> bitmapQ d p s \<rbrace>"
-  unfolding bitmapQ_defs bitmap_fun_defs
-  by (wp| clarsimp simp: bitmap_fun_defs)+
-
-lemma removeFromBitmap_valid_bitmapQ[wp]:
-" \<lbrace> valid_bitmapQ_except d p and bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans and
-    (\<lambda>s. ksReadyQueues s (d,p) = []) \<rbrace>
-     removeFromBitmap d p
-  \<lbrace>\<lambda>_. valid_bitmapQ \<rbrace>"
-proof -
-  have "\<lbrace> valid_bitmapQ_except d p and bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans and
-            (\<lambda>s. ksReadyQueues s (d,p) = []) \<rbrace>
-         removeFromBitmap d p
-         \<lbrace>\<lambda>_. valid_bitmapQ_except d p and  bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans and
-              (\<lambda>s. \<not> bitmapQ d p s \<and> ksReadyQueues s (d,p) = []) \<rbrace>"
-    by (rule hoare_pre)
-       (wp removeFromBitmap_valid_queues_no_bitmap_except removeFromBitmap_valid_bitmapQ_except
-           removeFromBitmap_bitmapQ, simp)
-  thus ?thesis
-    by - (erule hoare_strengthen_post; fastforce elim: valid_bitmap_valid_bitmapQ_exceptE)
-qed
-
-(* this should be the actual weakest precondition to establish valid_queues
-   under tagging a thread as not queued *)
-lemma threadSet_valid_queues_dequeue_wp:
- "\<lbrace> valid_queues_no_bitmap_except t and
-        valid_bitmapQ and bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans and
-        (\<lambda>s. \<forall>d p. t \<notin> set (ksReadyQueues s (d,p))) \<rbrace>
-          threadSet (tcbQueued_update (\<lambda>_. False)) t
-       \<lbrace>\<lambda>rv. valid_queues \<rbrace>"
-  unfolding threadSet_def
-  apply (rule hoare_seq_ext[OF _ getObject_tcb_sp])
-  apply (rule hoare_pre)
-   apply (simp add: valid_queues_def valid_queues_no_bitmap_except_def valid_queues_no_bitmap_def)
-   apply (wp setObject_queues_unchanged_tcb hoare_Ball_helper hoare_vcg_all_lift
-             setObject_tcb_strongest)
-  apply (clarsimp simp: valid_queues_no_bitmap_except_def obj_at'_def valid_queues_no_bitmap_def)
-  done
-
 (* FIXME move *)
 lemmas obj_at'_conjI = obj_at_conj'
 
-lemma setQueue_valid_queues_no_bitmap_except_dequeue_wp:
-  "\<And>d p ts t.
-   \<lbrace> \<lambda>s. valid_queues_no_bitmap_except t s \<and>
-         (\<forall>t' \<in> set ts. obj_at' (inQ d p and runnable' \<circ> tcbState) t' s) \<and>
-         t \<notin> set ts \<and> distinct ts \<and> p \<le> maxPriority \<and> d \<le> maxDomain \<rbrace>
-       setQueue d p ts
-   \<lbrace>\<lambda>rv. valid_queues_no_bitmap_except t \<rbrace>"
-  unfolding setQueue_def valid_queues_no_bitmap_except_def null_def
-  by wp force
-
-definition (* if t is in a queue, it should be tagged with right priority and domain *)
-  "correct_queue t s \<equiv> \<forall>d p. t \<in> set(ksReadyQueues s (d, p)) \<longrightarrow>
-             (obj_at' (\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d \<and> tcbPriority tcb = p) t s)"
-
-lemma valid_queues_no_bitmap_correct_queueI[intro]:
-  "valid_queues_no_bitmap s \<Longrightarrow> correct_queue t s"
-  unfolding correct_queue_def valid_queues_no_bitmap_def
-  by (fastforce simp: obj_at'_def inQ_def)
-
-
-lemma tcbSchedDequeue_valid_queues_weak:
-  "\<lbrace> valid_queues_no_bitmap_except t and valid_bitmapQ and
-     bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans and
-     correct_queue t and
-     obj_at' (\<lambda>tcb. tcbDomain tcb \<le> maxDomain \<and> tcbPriority tcb \<le> maxPriority) t \<rbrace>
-   tcbSchedDequeue t
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-proof -
-  show ?thesis
-  unfolding tcbSchedDequeue_def null_def valid_queues_def
-  apply wp (* stops on threadSet *)
-          apply (rule hoare_post_eq[OF _ threadSet_valid_queues_dequeue_wp],
-                 simp add: valid_queues_def)
-         apply (wp hoare_vcg_if_lift hoare_vcg_conj_lift hoare_vcg_imp_lift)+
-             apply (wp hoare_vcg_imp_lift setQueue_valid_queues_no_bitmap_except_dequeue_wp
-                       setQueue_valid_bitmapQ threadGet_const_tcb_at hoare_vcg_if_lift)+
-  (* wp done *)
-  apply (normalise_obj_at')
-  apply (clarsimp simp: correct_queue_def)
-  apply (normalise_obj_at')
-  apply (fastforce simp add: valid_queues_no_bitmap_except_def valid_queues_no_bitmap_def elim: obj_at'_weaken)+
-  done
-qed
-
-lemma tcbSchedDequeue_valid_queues:
-  "\<lbrace>Invariants_H.valid_queues
-    and obj_at' (\<lambda>tcb. tcbDomain tcb \<le> maxDomain) t
-    and obj_at' (\<lambda>tcb. tcbPriority tcb \<le> maxPriority) t\<rbrace>
-     tcbSchedDequeue t
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (rule hoare_pre, rule tcbSchedDequeue_valid_queues_weak)
-  apply (fastforce simp: valid_queues_def valid_queues_no_bitmap_def obj_at'_def inQ_def)
-  done
-
-lemma tcbSchedAppend_valid_queues'[wp]:
-  (* most of this is identical to tcbSchedEnqueue_valid_queues' in TcbAcc_R *)
-  "\<lbrace>valid_queues' and tcb_at' t\<rbrace> tcbSchedAppend t \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp add: tcbSchedAppend_def)
-  apply (rule hoare_pre)
-   apply (rule_tac B="\<lambda>rv. valid_queues' and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"
-           in hoare_seq_ext)
-    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_def)+
-     apply (clarsimp simp: obj_at'_def inQ_def projectKOs valid_queues'_def)
-    apply (wp getObject_tcb_wp | simp add: threadGet_def)+
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-lemma threadSet_valid_queues'_dequeue: (* threadSet_valid_queues' is too weak for dequeue *)
-  "\<lbrace>\<lambda>s. (\<forall>d p t'. obj_at' (inQ d p) t' s \<and> t' \<noteq> t \<longrightarrow> t' \<in> set (ksReadyQueues s (d, p))) \<and>
-        obj_at' (inQ d p) t s \<rbrace>
-   threadSet (tcbQueued_update (\<lambda>_. False)) t
-   \<lbrace>\<lambda>rv. valid_queues' \<rbrace>"
-   unfolding valid_queues'_def
-   apply (rule hoare_pre)
-    apply (wp hoare_vcg_all_lift)
-    apply (simp only: imp_conv_disj not_obj_at')
-   apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-   apply (simp add: not_obj_at')
-   apply (clarsimp simp: typ_at_tcb')
-   apply normalise_obj_at'
-   apply (fastforce elim: obj_at'_weaken simp: inQ_def)
-   done
-
 lemma setQueue_ksReadyQueues_lift:
   "\<lbrace> \<lambda>s. P (s\<lparr>ksReadyQueues := (ksReadyQueues s)((d, p) := ts)\<rparr>) ts \<rbrace>
    setQueue d p ts
@@ -314,116 +313,42 @@ lemma setQueue_ksReadyQueues_lift:
   unfolding setQueue_def
   by (wp, clarsimp simp: fun_upd_def cong: if_cong)
 
-lemma tcbSchedDequeue_valid_queues'[wp]:
-  "\<lbrace>valid_queues' and tcb_at' t\<rbrace>
-    tcbSchedDequeue t \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  unfolding tcbSchedDequeue_def
-  apply (rule_tac B="\<lambda>rv. valid_queues' and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"
-                in hoare_seq_ext)
-   prefer 2
-   apply (wp threadGet_const_tcb_at)
-   apply (fastforce simp: obj_at'_def)
-  apply clarsimp
-  apply (rename_tac queued)
-  apply (case_tac queued, simp_all)
-   apply wp
-        apply (rule_tac d=tdom and p=prio in threadSet_valid_queues'_dequeue)
-       apply (rule hoare_pre_post, assumption)
-       apply (wp | clarsimp simp: bitmap_fun_defs)+
-      apply (wp hoare_vcg_all_lift setQueue_ksReadyQueues_lift)
-     apply clarsimp
-     apply (wp threadGet_obj_at' threadGet_const_tcb_at)+
-   apply clarsimp
-   apply (rule context_conjI, clarsimp simp: obj_at'_def)
-   apply (clarsimp simp: valid_queues'_def obj_at'_def projectKOs inQ_def|wp)+
-  done
-
-crunch tcb_at'[wp]: tcbSchedEnqueue "tcb_at' t"
-  (simp: unless_def)
-crunch tcb_at'[wp]: tcbSchedAppend "tcb_at' t"
-  (simp: unless_def)
-crunch tcb_at'[wp]: tcbSchedDequeue "tcb_at' t"
-
-crunch state_refs_of'[wp]: tcbSchedEnqueue "\<lambda>s. P (state_refs_of' s)"
-  (wp: refl simp: crunch_simps unless_def)
-crunch state_refs_of'[wp]: tcbSchedAppend "\<lambda>s. P (state_refs_of' s)"
-  (wp: refl simp: crunch_simps unless_def)
-crunch state_refs_of'[wp]: tcbSchedDequeue "\<lambda>s. P (state_refs_of' s)"
-  (wp: refl simp: crunch_simps)
-
-crunch cap_to'[wp]: tcbSchedEnqueue "ex_nonz_cap_to' p"
-  (simp: unless_def)
-crunch cap_to'[wp]: tcbSchedAppend "ex_nonz_cap_to' p"
-  (simp: unless_def)
-crunch cap_to'[wp]: tcbSchedDequeue "ex_nonz_cap_to' p"
+crunches tcbSchedAppend, tcbSchedDequeue, tcbSchedEnqueue
+  for tcb_at'[wp]: "tcb_at' t"
+  and cap_to'[wp]: "ex_nonz_cap_to' p"
+  and ifunsafe'[wp]: if_unsafe_then_cap'
+  (wp: crunch_wps simp: crunch_simps)
 
 lemma tcbSchedAppend_iflive'[wp]:
-  "\<lbrace>if_live_then_nonz_cap' and ex_nonz_cap_to' tcb\<rbrace>
-    tcbSchedAppend tcb \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
-  apply (simp add: tcbSchedAppend_def unless_def)
-  apply (wp threadSet_iflive' hoare_drop_imps | simp add: crunch_simps)+
+  "\<lbrace>if_live_then_nonz_cap' and pspace_aligned' and pspace_distinct'\<rbrace>
+   tcbSchedAppend tcbPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  unfolding tcbSchedAppend_def
+  supply projectKOs[simp]
+  apply (wpsimp wp: tcbQueueAppend_if_live_then_nonz_cap' threadGet_wp simp: bitmap_fun_defs)
+  apply (frule_tac p=tcbPtr in if_live_then_nonz_capE')
+   apply (fastforce simp: ko_wp_at'_def st_tcb_at'_def obj_at'_def runnable_eq_active')
+  apply (clarsimp simp: tcbQueueEmpty_def)
+  apply (erule if_live_then_nonz_capE')
+  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 (fastforce dest!: obj_at'_tcbQueueEnd_ksReadyQueues
+                    simp: ko_wp_at'_def inQ_def obj_at'_def tcbQueueEmpty_def)
   done
 
 lemma tcbSchedDequeue_iflive'[wp]:
-  "\<lbrace>if_live_then_nonz_cap'\<rbrace> tcbSchedDequeue tcb \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  "\<lbrace>if_live_then_nonz_cap' and valid_objs' and sym_heap_sched_pointers\<rbrace>
+   tcbSchedDequeue tcbPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
   apply (simp add: tcbSchedDequeue_def)
-  apply (wp threadSet_iflive' hoare_when_weak_wp | simp add: crunch_simps)+
-       apply ((wp | clarsimp simp: bitmap_fun_defs)+)[1] (* deal with removeFromBitmap *)
-      apply (wp threadSet_iflive' hoare_when_weak_wp | simp add: crunch_simps)+
-      apply (rule_tac Q="\<lambda>rv. \<top>" in hoare_post_imp, fastforce)
-      apply (wp | simp add: crunch_simps)+
+  apply (wpsimp wp: tcbQueueRemove_if_live_then_nonz_cap' threadGet_wp)
+  apply (fastforce elim: if_live_then_nonz_capE' simp: obj_at'_def ko_wp_at'_def projectKOs)
   done
 
-crunch ifunsafe'[wp]: tcbSchedAppend if_unsafe_then_cap'
-  (simp: unless_def)
-crunch ifunsafe'[wp]: tcbSchedDequeue if_unsafe_then_cap'
-
 crunch idle'[wp]: tcbSchedAppend valid_idle'
   (simp: crunch_simps unless_def)
 
-crunch global_refs'[wp]: tcbSchedEnqueue valid_global_refs'
-  (wp: threadSet_global_refs simp: unless_def)
-crunch global_refs'[wp]: tcbSchedAppend valid_global_refs'
-  (wp: threadSet_global_refs simp: unless_def)
-crunch global_refs'[wp]: tcbSchedDequeue valid_global_refs'
-  (wp: threadSet_global_refs)
-
-crunch irq_node'[wp]: tcbSchedEnqueue "\<lambda>s. P (irq_node' s)"
-  (simp: unless_def)
-crunch irq_node'[wp]: tcbSchedAppend "\<lambda>s. P (irq_node' s)"
-  (simp: unless_def)
-crunch irq_node'[wp]: tcbSchedDequeue "\<lambda>s. P (irq_node' s)"
-
-crunch typ_at'[wp]: tcbSchedEnqueue "\<lambda>s. P (typ_at' T p s)"
-  (simp: unless_def)
-crunch typ_at'[wp]: tcbSchedAppend "\<lambda>s. P (typ_at' T p s)"
-  (simp: unless_def)
-crunch typ_at'[wp]: tcbSchedDequeue "\<lambda>s. P (typ_at' T p s)"
-
-crunch ctes_of[wp]: tcbSchedEnqueue "\<lambda>s. P (ctes_of s)"
-  (simp: unless_def)
-crunch ctes_of[wp]: tcbSchedAppend "\<lambda>s. P (ctes_of s)"
-  (simp: unless_def)
-crunch ctes_of[wp]: tcbSchedDequeue "\<lambda>s. P (ctes_of s)"
-
-crunch ksInterrupt[wp]: tcbSchedEnqueue "\<lambda>s. P (ksInterruptState s)"
-  (simp: unless_def)
-crunch ksInterrupt[wp]: tcbSchedAppend "\<lambda>s. P (ksInterruptState s)"
-  (simp: unless_def)
-crunch ksInterrupt[wp]: tcbSchedDequeue "\<lambda>s. P (ksInterruptState s)"
-
-crunch irq_states[wp]: tcbSchedEnqueue valid_irq_states'
-  (simp: unless_def)
-crunch irq_states[wp]: tcbSchedAppend valid_irq_states'
-  (simp: unless_def)
-crunch irq_states[wp]: tcbSchedDequeue valid_irq_states'
-
-crunch ct'[wp]: tcbSchedEnqueue "\<lambda>s. P (ksCurThread s)"
-  (simp: unless_def)
-crunch ct'[wp]: tcbSchedAppend "\<lambda>s. P (ksCurThread s)"
-  (simp: unless_def)
-crunch ct'[wp]: tcbSchedDequeue "\<lambda>s. P (ksCurThread s)"
-
 lemma tcbSchedEnqueue_vms'[wp]:
   "\<lbrace>valid_machine_state'\<rbrace> tcbSchedEnqueue t \<lbrace>\<lambda>_. valid_machine_state'\<rbrace>"
   apply (simp add: valid_machine_state'_def pointerInUserData_def pointerInDeviceData_def)
@@ -452,57 +377,117 @@ lemma ct_idle_or_in_cur_domain'_lift2:
   apply simp+
   done
 
+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>"
+  supply projectKOs[simp]
+  apply (wpsimp wp: setObject_tcb_mdb' getTCB_wp simp: threadSet_def obj_at'_def)
+  apply fastforce
+  done
+
+lemma tcbSchedNext_update_valid_mdb'[wp]:
+  "\<lbrace>valid_mdb' and tcb_at' tcbPtr\<rbrace> threadSet (tcbSchedNext_update f) tcbPtr \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  apply (wpsimp wp: threadSet_mdb')
+  apply (fastforce simp: obj_at'_def valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)
+  done
+
+lemma tcbSchedPrev_update_valid_mdb'[wp]:
+  "\<lbrace>valid_mdb' and tcb_at' tcbPtr\<rbrace> threadSet (tcbSchedPrev_update f) tcbPtr \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  apply (wpsimp wp: threadSet_mdb')
+  apply (fastforce simp: obj_at'_def valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)
+  done
+
+lemma tcbQueueRemove_valid_mdb':
+  "\<lbrace>\<lambda>s. valid_mdb' s \<and> valid_objs' s\<rbrace> tcbQueueRemove q tcbPtr \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  unfolding tcbQueueRemove_def
+  apply (wpsimp wp: getTCB_wp)
+  apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+  apply (fastforce simp: valid_tcb'_def obj_at'_def)
+  done
+
+lemma tcbQueuePrepend_valid_mdb':
+  "\<lbrace>valid_mdb' and tcb_at' tcbPtr
+    and (\<lambda>s. \<not> tcbQueueEmpty queue \<longrightarrow> tcb_at' (the (tcbQueueHead queue)) s)\<rbrace>
+   tcbQueuePrepend queue tcbPtr
+   \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  unfolding tcbQueuePrepend_def
+  by (wpsimp wp: hoare_vcg_if_lift2 hoare_vcg_imp_lift')
+
+lemma tcbQueueAppend_valid_mdb':
+  "\<lbrace>\<lambda>s. valid_mdb' s \<and> tcb_at' tcbPtr s
+        \<and> (\<not> tcbQueueEmpty queue \<longrightarrow> tcb_at' (the (tcbQueueEnd queue)) s)\<rbrace>
+   tcbQueueAppend queue tcbPtr
+   \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  unfolding tcbQueueAppend_def
+  by (wpsimp wp: hoare_vcg_if_lift2 hoare_vcg_imp_lift')
+
+lemma tcbQueued_update_valid_mdb'[wp]:
+  "\<lbrace>valid_mdb' and tcb_at' tcbPtr\<rbrace> threadSet (tcbQueued_update f) tcbPtr \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  apply (wpsimp wp: threadSet_mdb')
+  apply (fastforce simp: obj_at'_def valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)
+  done
+
+lemma valid_mdb'_ksReadyQueuesL1Bitmap_update[simp]:
+  "valid_mdb' (ksReadyQueuesL1Bitmap_update f s) = valid_mdb' s"
+  by (simp add: valid_mdb'_def)
+
+lemma valid_mdb'_ksReadyQueuesL2Bitmap_update[simp]:
+  "valid_mdb' (ksReadyQueuesL2Bitmap_update f s) = valid_mdb' s"
+  by (simp add: valid_mdb'_def)
+
+lemma tcbSchedEnqueue_valid_mdb'[wp]:
+  "\<lbrace>valid_mdb' and valid_objs' and pspace_aligned' and pspace_distinct'\<rbrace>
+   tcbSchedEnqueue tcbPtr
+   \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  apply (clarsimp simp: tcbSchedEnqueue_def setQueue_def)
+  apply (wpsimp wp: tcbQueuePrepend_valid_mdb' threadGet_wp simp: bitmap_fun_defs)
+  apply normalise_obj_at'
+  apply (fastforce dest!: obj_at'_tcbQueueHead_ksReadyQueues
+                    simp: ready_queue_relation_def ksReadyQueues_asrt_def obj_at'_def)
+  done
+
+crunches tcbSchedEnqueue
+  for cur_tcb'[wp]: cur_tcb'
+  (wp: threadSet_cur)
+
 lemma tcbSchedEnqueue_invs'[wp]:
-  "\<lbrace>invs'
-    and st_tcb_at' runnable' t
-    and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t)\<rbrace>
-     tcbSchedEnqueue t
+  "\<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_state'_def)
-  apply (rule hoare_pre)
-   apply (wp tcbSchedEnqueue_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 valid_ioports_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 tcbSchedEnqueue_ct_not_inQ valid_ioports_lift'
+              simp: cteCaps_of_def o_def)
   done
 
-crunch ksMachine[wp]: tcbSchedAppend "\<lambda>s. P (ksMachineState s)"
-  (simp: unless_def)
-
 lemma tcbSchedAppend_vms'[wp]:
   "\<lbrace>valid_machine_state'\<rbrace> tcbSchedAppend t \<lbrace>\<lambda>_. valid_machine_state'\<rbrace>"
   apply (simp add: valid_machine_state'_def pointerInUserData_def pointerInDeviceData_def)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift tcbSchedAppend_ksMachine)
+  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
   done
 
-crunch pspace_domain_valid[wp]: tcbSchedAppend "pspace_domain_valid"
-  (simp: unless_def)
-
-crunch ksCurDomain[wp]: tcbSchedAppend "\<lambda>s. P (ksCurDomain s)"
-(simp: unless_def)
+lemma tcbQueueAppend_tcbPriority_obj_at'[wp]:
+  "tcbQueueAppend queue tptr \<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
+  unfolding tcbQueueAppend_def
+  apply (wpsimp wp: threadSet_wp)
+  by (auto simp: obj_at'_def objBits_simps ps_clear_def projectKOs split: if_splits)
 
-crunch ksIdleThread[wp]: tcbSchedAppend "\<lambda>s. P (ksIdleThread s)"
-(simp: unless_def)
-
-crunch ksDomSchedule[wp]: tcbSchedAppend "\<lambda>s. P (ksDomSchedule s)"
-(simp: unless_def)
+lemma tcbQueueAppend_tcbDomain_obj_at'[wp]:
+  "tcbQueueAppend queue tptr \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  unfolding tcbQueueAppend_def
+  apply (wpsimp wp: threadSet_wp)
+  by (auto simp: obj_at'_def objBits_simps ps_clear_def projectKOs split: if_splits)
 
 lemma tcbSchedAppend_tcbDomain[wp]:
-  "\<lbrace> obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t' \<rbrace>
-     tcbSchedAppend t
-   \<lbrace> \<lambda>_. obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t' \<rbrace>"
+  "tcbSchedAppend t \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
   apply (clarsimp simp: tcbSchedAppend_def)
-  apply (wpsimp simp: unless_def)+
-  done
+  by wpsimp
 
 lemma tcbSchedAppend_tcbPriority[wp]:
-  "\<lbrace> obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t' \<rbrace>
-     tcbSchedAppend t
-   \<lbrace> \<lambda>_. obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t' \<rbrace>"
+  "tcbSchedAppend t \<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
   apply (clarsimp simp: tcbSchedAppend_def)
-  apply (wpsimp simp: unless_def)+
-  done
+  by wpsimp
 
 lemma tcbSchedAppend_tcb_in_cur_domain'[wp]:
   "\<lbrace>tcb_in_cur_domain' t'\<rbrace> tcbSchedAppend t \<lbrace>\<lambda>_. tcb_in_cur_domain' t' \<rbrace>"
@@ -510,36 +495,66 @@ lemma tcbSchedAppend_tcb_in_cur_domain'[wp]:
    apply wp+
   done
 
-crunch ksDomScheduleIdx[wp]: tcbSchedAppend "\<lambda>s. P (ksDomScheduleIdx s)"
-  (simp: unless_def)
-
 crunches tcbSchedAppend, tcbSchedDequeue
-  for gsUntypedZeroRanges[wp]: "\<lambda>s. P (gsUntypedZeroRanges s)"
-  and arch'[wp]: "\<lambda>s. P (ksArchState s)"
+  for arch'[wp]: "\<lambda>s. P (ksArchState s)"
   and ioports'[wp]: valid_ioports'
   (simp: unless_def wp: valid_ioports_lift'')
 
 lemma tcbSchedAppend_sch_act_wf[wp]:
-  "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace> tcbSchedAppend thread
-  \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  apply (simp add:tcbSchedAppend_def bitmap_fun_defs)
-  apply (wp unless_wp setQueue_sch_act threadGet_wp|simp)+
-  apply (fastforce simp:typ_at'_def obj_at'_def)
+  "tcbSchedAppend thread \<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
+  by (wpsimp wp: sch_act_wf_lift)
+
+lemma tcbSchedAppend_valid_bitmapQ[wp]:
+  "\<lbrace>valid_bitmaps\<rbrace> tcbSchedAppend tcbPtr \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
+  supply if_split[split del]
+  unfolding tcbSchedAppend_def
+  apply (wpsimp simp: tcbQueueAppend_def
+                  wp: setQueue_valid_bitmapQ' addToBitmap_valid_bitmapQ_except addToBitmap_bitmapQ
+                      threadGet_wp hoare_vcg_if_lift2)
+  apply (clarsimp simp: ksReadyQueues_asrt_def split: if_splits)
+  apply normalise_obj_at'
+  apply (force dest: tcbQueueHead_iff_tcbQueueEnd
+               simp: valid_bitmaps_def valid_bitmapQ_def tcbQueueEmpty_def)
+  done
+
+lemma tcbSchedAppend_valid_mdb'[wp]:
+  "\<lbrace>valid_mdb' and valid_tcbs' and pspace_aligned' and pspace_distinct'\<rbrace>
+   tcbSchedAppend tcbPtr
+   \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  supply projectKOs[simp]
+  apply (clarsimp simp: tcbSchedAppend_def setQueue_def)
+  apply (wpsimp wp: tcbQueueAppend_valid_mdb' threadGet_wp simp: bitmap_fun_defs)
+  apply (fastforce dest: obj_at'_tcbQueueEnd_ksReadyQueues
+                   simp: ready_queue_relation_def ksReadyQueues_asrt_def obj_at'_def)
+  done
+
+lemma tcbSchedAppend_valid_bitmaps[wp]:
+  "tcbSchedAppend tcbPtr \<lbrace>valid_bitmaps\<rbrace>"
+  unfolding valid_bitmaps_def
+  apply wpsimp
+  apply (clarsimp simp: valid_bitmaps_def)
   done
 
 lemma tcbSchedAppend_invs'[wp]:
-  "\<lbrace>invs'
-    and st_tcb_at' runnable' t
-    and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t)\<rbrace>
-     tcbSchedAppend t
+  "\<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_state'_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:
@@ -562,70 +577,98 @@ 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)
 
-crunch ksMachine[wp]: tcbSchedDequeue "\<lambda>s. P (ksMachineState s)"
-  (simp: unless_def)
-
 lemma tcbSchedDequeue_vms'[wp]:
   "\<lbrace>valid_machine_state'\<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>_. valid_machine_state'\<rbrace>"
   apply (simp add: valid_machine_state'_def pointerInUserData_def pointerInDeviceData_def)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift tcbSchedDequeue_ksMachine)
+  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
   done
 
-crunch pspace_domain_valid[wp]: tcbSchedDequeue "pspace_domain_valid"
-
-crunch ksCurDomain[wp]: tcbSchedDequeue "\<lambda>s. P (ksCurDomain s)"
-(simp: unless_def)
-
-crunch ksIdleThread[wp]: tcbSchedDequeue "\<lambda>s. P (ksIdleThread s)"
-(simp: unless_def)
-
-crunch ksDomSchedule[wp]: tcbSchedDequeue "\<lambda>s. P (ksDomSchedule s)"
-(simp: unless_def)
-
 lemma tcbSchedDequeue_tcb_in_cur_domain'[wp]:
   "\<lbrace>tcb_in_cur_domain' t'\<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>_. tcb_in_cur_domain' t' \<rbrace>"
   apply (rule tcb_in_cur_domain'_lift)
    apply wp
-  apply (clarsimp simp: tcbSchedDequeue_def)
-  apply (wp hoare_when_weak_wp | simp)+
+  apply (clarsimp simp: tcbSchedDequeue_def tcbQueueRemove_def)
+  apply (wpsimp wp: hoare_when_weak_wp getObject_tcb_wp threadGet_wp)
   done
 
-lemma tcbSchedDequeue_tcbDomain[wp]:
-  "\<lbrace> obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t' \<rbrace>
-     tcbSchedDequeue t
-   \<lbrace> \<lambda>_. obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t' \<rbrace>"
-  apply (clarsimp simp: tcbSchedDequeue_def)
-  apply (wp hoare_when_weak_wp | simp)+
-  done
-
-lemma tcbSchedDequeue_tcbPriority[wp]:
-  "\<lbrace> obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t' \<rbrace>
-     tcbSchedDequeue t
-   \<lbrace> \<lambda>_. obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t' \<rbrace>"
-  apply (clarsimp simp: tcbSchedDequeue_def)
-  apply (wp hoare_when_weak_wp | simp)+
+lemma tcbSchedDequeue_valid_mdb'[wp]:
+  "\<lbrace>valid_mdb' and valid_objs'\<rbrace> tcbSchedDequeue tcbPtr \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  unfolding tcbSchedDequeue_def
+  apply (wpsimp simp: bitmap_fun_defs setQueue_def wp: threadSet_mdb' tcbQueueRemove_valid_mdb')
+      apply (rule_tac Q="\<lambda>_. tcb_at' tcbPtr" in hoare_post_imp)
+       apply (fastforce simp: tcb_cte_cases_def cteSizeBits_def)
+      apply (wpsimp wp: threadGet_wp)+
+  apply (fastforce simp: obj_at'_def)
   done
 
-crunch ksDomScheduleIdx[wp]: tcbSchedDequeue "\<lambda>s. P (ksDomScheduleIdx s)"
-  (simp: unless_def)
-
 lemma tcbSchedDequeue_invs'[wp]:
-  "\<lbrace>invs' and tcb_at' t\<rbrace>
-     tcbSchedDequeue t
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  unfolding invs'_def valid_state'_def
-  apply (rule hoare_pre)
-   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
-             tcbSchedDequeue_valid_queues
-             untyped_ranges_zero_lift
-        | simp add: cteCaps_of_def o_def)+
-  apply (fastforce elim: valid_objs'_maxDomain valid_objs'_maxPriority simp: valid_pspace'_def)+
+  "tcbSchedDequeue t \<lbrace>invs'\<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 ct_idle_or_in_cur_domain'_lift2 cur_tcb_lift
+              simp: cteCaps_of_def o_def)
+  done
+
+lemma ready_qs_runnable_cross:
+  "\<lbrakk>(s, s') \<in> state_relation; pspace_aligned s; pspace_distinct s; valid_queues s\<rbrakk>
+   \<Longrightarrow> ready_qs_runnable s'"
+  supply projectKOs[simp]
+  apply (clarsimp simp: ready_qs_runnable_def)
+  apply normalise_obj_at'
+  apply (frule state_relation_ready_queues_relation)
+  apply (clarsimp simp: ready_queues_relation_def ready_queue_relation_def Let_def
+                        list_queue_relation_def)
+  apply (drule_tac x="tcbDomain ko" in spec)
+  apply (drule_tac x="tcbPriority ko" in spec)
+  apply (clarsimp simp: valid_queues_def)
+  apply (drule_tac x="tcbDomain ko" in spec)
+  apply (drule_tac x="tcbPriority ko" in spec)
+  apply clarsimp
+  apply (drule_tac x=t in bspec)
+   apply (fastforce simp: inQ_def in_opt_pred obj_at'_def opt_map_red)
+  apply (fastforce dest: st_tcb_at_runnable_cross simp: obj_at'_def st_tcb_at'_def)
+  done
+
+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_queues)?, (frule invs_psp_aligned)?, (frule invs_distinct)?,
+  fastforce dest: ready_qs_runnable_cross
+
+defs idleThreadNotQueued_def:
+  "idleThreadNotQueued s \<equiv> obj_at' (Not \<circ> tcbQueued) (ksIdleThread s) s"
+
+lemma idle_thread_not_queued:
+  "\<lbrakk>valid_idle s; valid_queues s; valid_etcbs s\<rbrakk>
+   \<Longrightarrow> \<not> (\<exists>d p. idle_thread s \<in> set (ready_queues s d p))"
+  apply (clarsimp simp: valid_queues_def)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply clarsimp
+  apply (drule_tac x="idle_thread s" in bspec)
+   apply fastforce
+  apply (clarsimp simp: valid_idle_def pred_tcb_at_def obj_at_def valid_etcbs_def)
   done
 
+lemma valid_idle_tcb_at:
+  "valid_idle s \<Longrightarrow> tcb_at (idle_thread s) s"
+  by (clarsimp simp: valid_idle_def pred_tcb_at_def obj_at_def is_tcb_def)
+
 lemma setCurThread_corres:
-  "corres dc \<top> \<top> (modify (cur_thread_update (\<lambda>_. t))) (setCurThread t)"
-  apply (unfold setCurThread_def)
+  "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)"
+  supply projectKOs[simp]
+  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 opt_pred_def opt_map_def)
   apply (rule corres_modify)
   apply (simp add: state_relation_def swp_def)
   done
@@ -664,47 +707,62 @@ lemma arch_switch_thread_ksQ[wp]:
   apply (wp)
   done
 
-crunch valid_queues[wp]: "Arch.switchToThread" "Invariants_H.valid_queues"
-(wp: crunch_wps simp: crunch_simps)
+crunches storeWordUser, setVMRoot, asUser, storeWordUser, Arch.switchToThread
+  for ksIdleThread[wp]: "\<lambda>s. P (ksIdleThread s)"
+  and sym_heap_sched_pointers[wp]: sym_heap_sched_pointers
+  and valid_objs'[wp]: valid_objs'
+  (wp: crunch_wps threadSet_sched_pointers simp: crunch_simps)
+
+crunches arch_switch_to_thread, arch_switch_to_idle_thread
+  for pspace_aligned[wp]: pspace_aligned
+  and pspace_distinct[wp]: pspace_distinct
+  and ready_qs_distinct[wp]: ready_qs_distinct
+  (wp: ready_qs_distinct_lift simp: crunch_simps)
+
+crunches arch_switch_to_thread, arch_switch_to_idle_thread
+  for valid_idle[wp]: "\<lambda>s::det_ext state. valid_idle s"
+
+lemma valid_queues_in_correct_ready_q[elim!]:
+  "valid_queues s \<Longrightarrow> in_correct_ready_q s"
+  by (clarsimp simp: valid_queues_def in_correct_ready_q_def)
+
+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)
 
 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_vs_lookup and valid_global_objs
                 and unique_table_refs o caps_of_state
-                and st_tcb_at runnable t and valid_etcbs)
-             (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_pspace' and valid_arch_state')
              (switch_to_thread t) (switchToThread t)"
-  (is "corres _ ?PA ?PH _ _")
-
-proof -
-  have mainpart: "corres dc (?PA) (?PH)
-     (do y \<leftarrow> arch_switch_to_thread t;
-         y \<leftarrow> (tcb_sched_action tcb_sched_dequeue t);
-         modify (cur_thread_update (\<lambda>_. t))
-      od)
-     (do y \<leftarrow> Arch.switchToThread t;
-         y \<leftarrow> tcbSchedDequeue t;
-         setCurThread 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)
+  apply add_ready_qs_runnable
+  apply (simp add: switch_to_thread_def Thread_H.switchToThread_def)
+  apply (rule corres_symb_exec_l[OF _ _ get_sp]; (solves wpsimp)?)
+  apply (rule corres_symb_exec_l[OF _ _ assert_sp]; (solves wpsimp)?)
+  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_stateAssert_ignore)
+     apply (fastforce dest!: state_relation_ready_queues_relation intro: ksReadyQueues_asrt_cross)
+    apply (rule corres_stateAssert_add_assertion[rotated])
+     apply fastforce
     apply (rule corres_guard_imp)
       apply (rule corres_split[OF arch_switchToThread_corres])
         apply (rule corres_split[OF tcbSchedDequeue_corres setCurThread_corres])
-         apply (wp|clarsimp simp: tcb_at_is_etcb_at st_tcb_at_tcb_at)+
-    done
-
-  show ?thesis
-    apply -
-    apply (simp add: switch_to_thread_def Thread_H.switchToThread_def)
-    apply (rule corres_symb_exec_l [where Q = "\<lambda> s rv. (?PA and (=) rv) s",
-                                    OF corres_symb_exec_l [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
@@ -720,15 +778,21 @@ lemma arch_switchToIdleThread_corres:
   done
 
 lemma switchToIdleThread_corres:
-  "corres dc invs invs_no_cicd' switch_to_idle_thread switchToIdleThread"
+  "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 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_trivial, rule corres_modify)
-        apply (simp add: state_relation_def cdt_relation_def)
-       apply (wp+, simp+)
+        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)
@@ -763,11 +827,9 @@ proof -
     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 Invariants_H.valid_queues_def
-                              sch_act_wf ct_in_state'_def state_refs_of'_def
-                              ps_clear_def valid_irq_node'_def valid_queues'_def ct_not_inQ_ct
-                              ct_idle_or_in_cur_domain'_def
-                              bitmapQ_defs valid_queues_no_bitmap_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
@@ -781,101 +843,20 @@ lemma setCurThread_invs:
   by (rule hoare_pre, rule setCurThread_invs_no_cicd')
      (simp add: invs'_to_invs_no_cicd'_def)
 
-lemma valid_queues_not_runnable_not_queued:
-  fixes s
-  assumes vq:  "Invariants_H.valid_queues 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
-
-  with vq have "st_tcb_at' runnable' t s"
-    unfolding Invariants_H.valid_queues_def valid_queues_no_bitmap_def
-    apply -
-    apply clarsimp
-    apply (drule_tac x=d in spec)
-    apply (drule_tac x=p in spec)
-    apply (clarsimp simp add: st_tcb_at'_def)
-    apply (drule(1) bspec)
-    apply (erule obj_at'_weakenE)
-    apply (clarsimp)
-    done
-
-  with st show False
-    apply -
-    apply (drule(1) pred_tcb_at_conj')
-    apply (clarsimp)
-    done
-qed
-
-(*
- * The idle thread is not part of any ready queues.
- *)
-lemma idle'_not_tcbQueued':
- assumes vq:   "Invariants_H.valid_queues 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 vq' show ?thesis
-     by (rule valid_queues_not_runnable_not_queued)
- qed
-
 lemma setCurThread_invs_no_cicd'_idle_thread:
-  "\<lbrace>invs_no_cicd' and (\<lambda>s. t = ksIdleThread s) \<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
-  have idle'_activatable': "\<And> s t. st_tcb_at' idle' t s \<Longrightarrow> st_tcb_at' activatable' t s"
-    apply (clarsimp simp: st_tcb_at'_def o_def obj_at'_def)
+  "\<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 st_tcb_at'_def
+                        idleThreadNotQueued_def projectKOs)
   done
-  show ?thesis
-    apply (simp add: setCurThread_def)
-    apply wp
-    apply (clarsimp simp: all_invs_but_ct_idle_or_in_cur_domain'_def)
-    apply (frule (2) idle'_not_tcbQueued'[simplified o_def])
-    apply (clarsimp simp add: ct_not_inQ_ct idle'_activatable'
-                              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_queues_no_bitmap_def valid_queues'_def
-                              pred_tcb_at'_def
-                        cong: option.case_cong)
-    apply (clarsimp simp: obj_at'_def projectKOs idle_tcb'_def)
-    done
-qed
 
 lemma setCurThread_invs_idle_thread:
   "\<lbrace>invs' and (\<lambda>s. t = ksIdleThread s) \<rbrace> setCurThread t \<lbrace>\<lambda>rv. invs'\<rbrace>"
@@ -910,13 +891,13 @@ lemma Arch_switchToThread_tcb_in_cur_domain'[wp]:
   done
 
 lemma tcbSchedDequeue_not_tcbQueued:
-  "\<lbrace> tcb_at' t \<rbrace> tcbSchedDequeue t \<lbrace> \<lambda>_. obj_at' (\<lambda>x. \<not> tcbQueued x) t \<rbrace>"
+  "\<lbrace>\<top>\<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>_. obj_at' (\<lambda>x. \<not> tcbQueued x) t\<rbrace>"
   apply (simp add: tcbSchedDequeue_def)
   apply (wp|clarsimp)+
   apply (rule_tac Q="\<lambda>queued. obj_at' (\<lambda>x. tcbQueued x = queued) t" in hoare_post_imp)
-   apply (clarsimp simp: obj_at'_def)
-  apply (wp threadGet_obj_at')
-  apply (simp)
+     apply (clarsimp simp: obj_at'_def)
+    apply (wpsimp wp: threadGet_wp)+
+  apply (clarsimp simp: obj_at'_def)
   done
 
 lemma Arch_switchToThread_obj_at[wp]:
@@ -938,10 +919,6 @@ crunch valid_irq_states'[wp]: asUser "valid_irq_states'"
 crunch valid_machine_state'[wp]: asUser "valid_machine_state'"
 (wp: crunch_wps simp: crunch_simps)
 
-crunch valid_queues'[wp]: asUser "valid_queues'"
-(wp: crunch_wps simp: crunch_simps)
-
-
 lemma asUser_valid_irq_node'[wp]:
   "\<lbrace>\<lambda>s. valid_irq_node' (irq_node' s) s\<rbrace> asUser t (setRegister f r)
           \<lbrace>\<lambda>_ s. valid_irq_node' (irq_node' s) s\<rbrace>"
@@ -1012,22 +989,17 @@ lemma Arch_switchToThread_invs_no_cicd':
   by (wp|rule setVMRoot_invs_no_cicd')+
 
 lemma tcbSchedDequeue_invs_no_cicd'[wp]:
-  "\<lbrace>invs_no_cicd' and tcb_at' t\<rbrace>
-     tcbSchedDequeue t
-   \<lbrace>\<lambda>_. invs_no_cicd'\<rbrace>"
-  unfolding all_invs_but_ct_idle_or_in_cur_domain'_def valid_state'_def
+  "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
-            tcbSchedDequeue_valid_queues_weak
             untyped_ranges_zero_lift
         | simp add: cteCaps_of_def o_def)+
   apply clarsimp
-  apply (fastforce simp: valid_pspace'_def valid_queues_def
-                   elim: valid_objs'_maxDomain valid_objs'_maxPriority intro: obj_at'_conjI)
   done
 
 lemma switchToThread_invs_no_cicd':
-  "\<lbrace>invs_no_cicd' and st_tcb_at' runnable' t and tcb_in_cur_domain' t \<rbrace> ThreadDecls_H.switchToThread t \<lbrace>\<lambda>rv. invs' \<rbrace>"
+  "\<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')
@@ -1035,7 +1007,7 @@ lemma switchToThread_invs_no_cicd':
   done
 
 lemma switchToThread_invs[wp]:
-  "\<lbrace>invs' and st_tcb_at' runnable' t and tcb_in_cur_domain' t \<rbrace> switchToThread t \<lbrace>\<lambda>rv. invs' \<rbrace>"
+  "\<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 threadSet_timeslice_invs setCurThread_invs
              Arch_switchToThread_invs dmo_invs'
@@ -1110,61 +1082,6 @@ 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 invs'_not_runnable_not_queued:
-  fixes s
-  assumes inv: "invs' s"
-      and st: "st_tcb_at' (Not \<circ> runnable') t s"
-  shows "obj_at' (Not \<circ> tcbQueued) t s"
-  apply (insert assms)
-  apply (rule valid_queues_not_runnable_not_queued)
-    apply (clarsimp simp add: invs'_def valid_state'_def)+
-  done
-
-lemma valid_queues_not_tcbQueued_not_ksQ:
-  fixes s
-  assumes   vq: "Invariants_H.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"
-    unfolding Invariants_H.valid_queues_def valid_queues_no_bitmap_def
-    apply clarify
-    apply (drule_tac x=d in spec)
-    apply (drule_tac x=p in spec)
-    apply (clarsimp)
-    apply (drule(1) bspec)
-    apply (erule obj_at'_weakenE)
-    apply (simp)
-    done
-  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 valid_state'_def)
-  apply (drule(1) valid_queues_not_tcbQueued_not_ksQ)
-  apply (clarsimp)
-  done
-
-lemma ct_not_ksQ:
-  "\<lbrakk> invs' s; ksSchedulerAction s = ResumeCurrentThread \<rbrakk>
-   \<Longrightarrow> \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)"
-  apply (clarsimp simp: invs'_def valid_state'_def ct_not_inQ_def)
-  apply (frule(1) valid_queues_not_tcbQueued_not_ksQ)
-  apply (fastforce)
-  done
-
 lemma setThreadState_rct:
   "\<lbrace>\<lambda>s. (runnable' st \<or> ksCurThread s \<noteq> t)
         \<and> ksSchedulerAction s = ResumeCurrentThread\<rbrace>
@@ -1236,21 +1153,24 @@ lemma bitmapQ_from_bitmap_lookup:
   done
 
 lemma lookupBitmapPriority_obj_at':
-  "\<lbrakk>ksReadyQueuesL1Bitmap s (ksCurDomain s) \<noteq> 0; valid_queues_no_bitmap s; valid_bitmapQ s;
-         bitmapQ_no_L1_orphans s\<rbrakk>
-        \<Longrightarrow> obj_at' (inQ (ksCurDomain s) (lookupBitmapPriority (ksCurDomain s) s) and runnable' \<circ> tcbState)
-             (hd (ksReadyQueues s (ksCurDomain s, lookupBitmapPriority (ksCurDomain s) s))) s"
+  "\<lbrakk>ksReadyQueuesL1Bitmap s d \<noteq> 0; valid_bitmapQ s; bitmapQ_no_L1_orphans s;
+    ksReadyQueues_asrt s; ready_qs_runnable s; pspace_aligned' s; pspace_distinct' s\<rbrakk>
+   \<Longrightarrow> obj_at' (inQ d (lookupBitmapPriority d s) and runnable' \<circ> tcbState)
+               (the (tcbQueueHead (ksReadyQueues s (d, lookupBitmapPriority d s)))) s"
   apply (drule (2) bitmapQ_from_bitmap_lookup)
   apply (simp add: valid_bitmapQ_bitmapQ_simp)
-  apply (case_tac "ksReadyQueues s (ksCurDomain s, lookupBitmapPriority (ksCurDomain s) s)", simp)
-  apply (clarsimp, rename_tac t ts)
-  apply (drule cons_set_intro)
-  apply (drule (2) valid_queues_no_bitmap_objD)
+  apply (clarsimp simp: ready_queue_relation_def ksReadyQueues_asrt_def tcbQueueEmpty_def)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x="lookupBitmapPriority d s" in spec)
+  apply clarsimp
+  apply (frule (3) obj_at'_tcbQueueHead_ksReadyQueues)
+  apply (fastforce simp: obj_at'_and ready_qs_runnable_def obj_at'_def st_tcb_at'_def inQ_def
+                         tcbQueueEmpty_def)
   done
 
 lemma bitmapL1_zero_ksReadyQueues:
   "\<lbrakk> valid_bitmapQ s ; bitmapQ_no_L1_orphans s \<rbrakk>
-   \<Longrightarrow> (ksReadyQueuesL1Bitmap s d = 0) = (\<forall>p. ksReadyQueues s (d,p) = [])"
+   \<Longrightarrow> (ksReadyQueuesL1Bitmap s d = 0) = (\<forall>p. tcbQueueEmpty (ksReadyQueues s (d, p)))"
   apply (cases "ksReadyQueuesL1Bitmap s d = 0")
    apply (force simp add: bitmapQ_def valid_bitmapQ_def)
   apply (fastforce dest: bitmapQ_from_bitmap_lookup simp: valid_bitmapQ_bitmapQ_simp)
@@ -1321,7 +1241,7 @@ lemma bitmapL1_highest_lookup:
   done
 
 lemma bitmapQ_ksReadyQueuesI:
-  "\<lbrakk> bitmapQ d p s ; valid_bitmapQ s \<rbrakk> \<Longrightarrow> ksReadyQueues s (d, p) \<noteq> []"
+  "\<lbrakk> bitmapQ d p s ; valid_bitmapQ s \<rbrakk> \<Longrightarrow> \<not> tcbQueueEmpty (ksReadyQueues s (d, p))"
   unfolding valid_bitmapQ_def by simp
 
 lemma getReadyQueuesL2Bitmap_inv[wp]:
@@ -1330,24 +1250,22 @@ lemma getReadyQueuesL2Bitmap_inv[wp]:
 
 lemma switchToThread_lookupBitmapPriority_wp:
   "\<lbrace>\<lambda>s. invs_no_cicd' s \<and> bitmapQ (ksCurDomain s) (lookupBitmapPriority (ksCurDomain s) s) s \<and>
-        t = hd (ksReadyQueues s (ksCurDomain s, lookupBitmapPriority (ksCurDomain s) s)) \<rbrace>
+        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 ; 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 elim: obj_at'_weaken simp: inQ_def tcb_in_cur_domain'_def st_tcb_at'_def)
-    done
-  thus ?thesis
-    by (wp switchToThread_invs_no_cicd') (fastforce dest: invs_no_cicd'_queues)
-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_no_cicd':
   "\<lbrace>invs_no_cicd'\<rbrace> switchToIdleThread \<lbrace>\<lambda>rv. invs'\<rbrace>"
@@ -1446,8 +1364,9 @@ 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 st_tcb_at runnable t and valid_etcbs)
-             (valid_arch_state' and valid_pspace' and Invariants_H.valid_queues
+                and st_tcb_at runnable t and valid_etcbs
+                and valid_queues and valid_idle)
+             (valid_arch_state' and valid_pspace' and sym_heap_sched_pointers
                 and st_tcb_at' runnable' t and cur_tcb')
              (guarded_switch_to t) (switchToThread t)"
   apply (simp add: guarded_switch_to_def)
@@ -1457,8 +1376,8 @@ lemma guarded_switch_to_corres:
       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)+
-    done
+   apply (force simp: st_tcb_at_tcb_at)+
+  done
 
 abbreviation "enumPrio \<equiv> [0.e.maxPriority]"
 
@@ -1493,7 +1412,7 @@ lemma curDomain_corres: "corres (=) \<top> \<top> (gets cur_domain) (curDomain)"
 
 lemma curDomain_corres':
   "corres (=) \<top> (\<lambda>s. ksCurDomain s \<le> maxDomain)
-    (gets cur_domain) (if 1 < numDomains then curDomain else return 0)"
+    (gets cur_domain) (if Suc 0 < numDomains then curDomain else return 0)"
   apply (case_tac "1 < numDomains"; simp)
    apply (rule corres_guard_imp[OF curDomain_corres]; solves simp)
   (* if we have only one domain, then we are in it *)
@@ -1503,27 +1422,32 @@ lemma curDomain_corres':
 
 lemma lookupBitmapPriority_Max_eqI:
   "\<lbrakk> valid_bitmapQ s ; bitmapQ_no_L1_orphans s ; ksReadyQueuesL1Bitmap s d \<noteq> 0 \<rbrakk>
-   \<Longrightarrow> lookupBitmapPriority d s = (Max {prio. ksReadyQueues s (d, prio) \<noteq> []})"
+   \<Longrightarrow> lookupBitmapPriority d s = (Max {prio. \<not> tcbQueueEmpty (ksReadyQueues s (d, prio))})"
   apply (rule Max_eqI[simplified eq_commute]; simp)
    apply (fastforce simp: bitmapL1_highest_lookup valid_bitmapQ_bitmapQ_simp)
   apply (metis valid_bitmapQ_bitmapQ_simp bitmapQ_from_bitmap_lookup)
   done
 
 lemma corres_gets_queues_getReadyQueuesL1Bitmap:
-  "corres (\<lambda>qs l1. ((l1 = 0) = (\<forall>p. qs p = []))) \<top> valid_queues
+  "corres (\<lambda>qs l1. (l1 = 0) = (\<forall>p. qs p = [])) \<top> valid_bitmaps
     (gets (\<lambda>s. ready_queues s d)) (getReadyQueuesL1Bitmap d)"
-  unfolding state_relation_def valid_queues_def getReadyQueuesL1Bitmap_def
-  by (clarsimp simp: bitmapL1_zero_ksReadyQueues ready_queues_relation_def)
+  unfolding state_relation_def valid_bitmaps_def getReadyQueuesL1Bitmap_def
+  apply (clarsimp simp: ready_queues_relation_def ready_queue_relation_def Let_def)
+  apply (drule_tac x=d in spec)
+  apply (fastforce simp: bitmapL1_zero_ksReadyQueues list_queue_relation_def tcbQueueEmpty_def)
+  done
 
 lemma guarded_switch_to_chooseThread_fragment_corres:
   "corres dc
     (P and st_tcb_at runnable t and invs and valid_sched)
-    (P' and st_tcb_at' runnable' t and invs_no_cicd')
-          (guarded_switch_to t)
-          (do runnable \<leftarrow> isRunnable t;
-              y \<leftarrow> assert runnable;
-              ThreadDecls_H.switchToThread t
-           od)"
+    (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)
@@ -1538,35 +1462,50 @@ lemma guarded_switch_to_chooseThread_fragment_corres:
               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'
+   \<Longrightarrow> Max {prio. ready_queues s d prio \<noteq> []}
+       = Max {prio. \<not> tcbQueueEmpty (ksReadyQueues s' (d, prio))}"
+  apply (clarsimp simp: ready_queues_relation_def ready_queue_relation_def Let_def
+                        list_queue_relation_def tcbQueueEmpty_def)
+  apply (rule Max_eq_if)
+     apply fastforce
+    apply fastforce
+   apply (fastforce dest: heap_path_head)
+  apply clarsimp
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=b in spec)
+  apply force
+  done
+
 lemma bitmap_lookup_queue_is_max_non_empty:
-  "\<lbrakk> valid_queues s'; (s, s') \<in> state_relation; invs s;
+  "\<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 all_invs_but_ct_idle_or_in_cur_domain'_def 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 \<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 (simp add: valid_queues_no_bitmap_def)
-   apply (erule_tac x="ksCurDomain s" in allE)
-   apply (erule_tac x="lookupBitmapPriority (ksCurDomain s) s" in allE)
-   apply (clarsimp simp: st_tcb_at'_def)
-   apply (erule obj_at'_weaken)
-   apply simp
-   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>"
@@ -1578,52 +1517,72 @@ lemma invs_no_cicd_ksCurDomain_maxDomain':
   "invs_no_cicd' s \<Longrightarrow> ksCurDomain s \<le> maxDomain"
   unfolding invs_no_cicd'_def by simp
 
+crunches curDomain
+  for valid_bitmaps[wp]: valid_bitmaps
+
 lemma chooseThread_corres:
-  "corres dc (invs and valid_sched) (invs_no_cicd')
-     choose_thread chooseThread" (is "corres _ ?PREI ?PREH _ _")
+  "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
-  unfolding choose_thread_def chooseThread_def
-  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> 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 dest!: invs_no_cicd'_queues simp: bitmap_lookup_queue_is_max_non_empty)
-              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 (clarsimp simp: if_apply_def2)
-      apply (wp hoare_vcg_conj_lift hoare_vcg_imp_lift ksReadyQueuesL1Bitmap_return_wp)
-     apply (wpsimp wp: curDomain_or_return_0 simp: curDomain_def)+
-    apply (fastforce simp: invs_no_cicd'_def)
-   apply (clarsimp simp: valid_sched_def DetSchedInvs_AI.valid_queues_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 (simp add: invs_no_cicd_ksCurDomain_maxDomain')
-  apply (clarsimp dest!: invs_no_cicd'_queues)
-  apply (fastforce intro: ksReadyQueuesL1Bitmap_st_tcb_at')
-  done
+    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 (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 =
@@ -1712,7 +1671,7 @@ lemma isHighestPrio_corres:
   assumes "d' = d"
   assumes "p' = p"
   shows
-    "corres ((=)) \<top> valid_queues
+    "corres ((=)) \<top> valid_bitmaps
       (gets (is_highest_prio d p))
       (isHighestPrio d' p')"
   using assms
@@ -1722,18 +1681,16 @@ lemma isHighestPrio_corres:
     apply (rule corres_split[OF corres_gets_queues_getReadyQueuesL1Bitmap])
       apply (rule corres_if_r'[where P'="\<lambda>_. True",rotated])
        apply (rule_tac corres_symb_exec_r)
-              apply (rule_tac
-                       P="\<lambda>s. q = ready_queues s d
-                              " and
-                       P'="\<lambda>s. valid_queues s \<and>
-                               l1 = ksReadyQueuesL1Bitmap s d \<and>
-                               l1 \<noteq> 0 \<and> hprio = lookupBitmapPriority d s" and
-                       F="hprio = Max {prio. q prio \<noteq> []}" in corres_req)
-              apply (elim conjE)
-              apply (clarsimp simp: valid_queues_def)
-              apply (subst lookupBitmapPriority_Max_eqI; blast?)
-              apply (fastforce simp: ready_queues_relation_def dest!: state_relationD)
-             apply fastforce
+          apply (rule_tac P="\<lambda>s. q = ready_queues s d"
+                      and P'="\<lambda>s. valid_bitmaps s \<and> l1 = ksReadyQueuesL1Bitmap s d \<and>
+                                  l1 \<noteq> 0 \<and> hprio = lookupBitmapPriority d s"
+                      and F="hprio = Max {prio. q prio \<noteq> []}" in corres_req)
+           apply (elim conjE)
+           apply (clarsimp simp: valid_bitmaps_def)
+           apply (subst lookupBitmapPriority_Max_eqI; blast?)
+           apply (fastforce dest: state_relation_ready_queues_relation Max_prio_helper[where d=d]
+                            simp: tcbQueueEmpty_def)
+          apply fastforce
          apply (wpsimp simp: if_apply_def2 wp: hoare_drop_imps ksReadyQueuesL1Bitmap_return_wp)+
   done
 
@@ -1745,9 +1702,8 @@ crunch inv[wp]: schedule_switch_thread_fastfail P
 crunch inv[wp]: scheduleSwitchThreadFastfail P
 
 lemma setSchedulerAction_invs': (* not in wp set, clobbered by ssa_wp *)
-  "\<lbrace>\<lambda>s. invs' s \<rbrace> setSchedulerAction ChooseNewThread \<lbrace>\<lambda>_. invs' \<rbrace>"
+  "setSchedulerAction ChooseNewThread \<lbrace>invs' \<rbrace>"
   by (wpsimp simp: invs'_def cur_tcb'_def valid_state'_def valid_irq_node'_def ct_not_inQ_def
-                   valid_queues_def valid_queues_no_bitmap_def valid_queues'_def
                    ct_idle_or_in_cur_domain'_def)
 
 lemma scheduleChooseNewThread_corres:
@@ -1779,6 +1735,51 @@ lemma ethread_get_when_corres:
   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
+
+crunches 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)
+
+crunches reschedule_required
+  for in_correct_ready_q[wp]: in_correct_ready_q
+  and ready_qs_distinct[wp]: ready_qs_distinct
+  (wp: crunch_wps ignore_del: reschedule_required)
+
+lemma tcbSchedEnqueue_valid_pspace'[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>valid_pspace'\<rbrace>"
+  unfolding valid_pspace'_def
+  by wpsimp
+
 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]
@@ -1807,7 +1808,7 @@ lemma schedule_corres:
          apply (rule corres_split[OF thread_get_isRunnable_corres])
            apply (rule corres_split)
               apply (rule corres_when, simp)
-              apply (rule tcbSchedEnqueue_corres)
+              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)+
@@ -1816,7 +1817,7 @@ lemma schedule_corres:
                 rename_tac was_running wasRunning)
           apply (rule corres_split)
              apply (rule corres_when, simp)
-             apply (rule tcbSchedEnqueue_corres)
+             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)
@@ -1832,7 +1833,7 @@ lemma schedule_corres:
                     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])
+                         apply (rule corres_split[OF tcbSchedEnqueue_corres], simp)
                            apply (simp, fold dc_def)
                            apply (rule corres_split)
                               apply (rule setSchedulerAction_corres; simp)
@@ -1846,7 +1847,7 @@ lemma schedule_corres:
                           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])
+                         apply (rule corres_split[OF tcbSchedAppend_corres], simp)
                            apply (simp, fold dc_def)
                            apply (rule corres_split)
                               apply (rule setSchedulerAction_corres; simp)
@@ -1878,7 +1879,8 @@ lemma schedule_corres:
                     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)+
+                     del: gets_wp
+                  | strengthen valid_objs'_valid_tcbs')+
        apply (clarsimp simp: conj_ac if_apply_def2 cong: imp_cong conj_cong del: hoare_gets)
        apply (wp gets_wp)+
 
@@ -1901,18 +1903,17 @@ lemma schedule_corres:
                                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 (clarsimp simp add: pred_tcb_at_def obj_at_def is_tcb valid_idle_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)+
-     apply (simp add: valid_sched_def valid_blocked_def valid_blocked_except_def)
      done
 
   (* haskell final subgoal *)
-  apply (clarsimp simp: if_apply_def2 invs'_def valid_state'_def
+  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
@@ -1926,11 +1927,8 @@ proof -
     apply (simp add: setSchedulerAction_def)
     apply wp
     apply (clarsimp simp add: invs'_def valid_state'_def cur_tcb'_def
-                              Invariants_H.valid_queues_def
-                              state_refs_of'_def ps_clear_def
-                              valid_irq_node'_def valid_queues'_def
-                              tcb_in_cur_domain'_def ct_idle_or_in_cur_domain'_def
-                              bitmapQ_defs valid_queues_no_bitmap_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
@@ -1965,13 +1963,10 @@ lemma getDomainTime_wp[wp]: "\<lbrace>\<lambda>s. P (ksDomainTime s) s \<rbrace>
   by wp
 
 lemma switchToThread_ct_not_queued_2:
-  "\<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 (simp add: X64_H.switchToThread_def setCurThread_def)
-    apply (wp tcbSchedDequeue_not_tcbQueued | simp )+
-  done
+  "\<lbrace>invs_no_cicd' and tcb_at' t\<rbrace> switchToThread t \<lbrace>\<lambda>_ s. obj_at' (Not \<circ> tcbQueued) (ksCurThread s) s\<rbrace>"
+  unfolding Thread_H.switchToThread_def
+  by (wpsimp simp: X64_H.switchToThread_def setCurThread_def
+             wp: hoare_drop_imp tcbSchedDequeue_not_tcbQueued)
 
 lemma setCurThread_obj_at':
   "\<lbrace> obj_at' P t \<rbrace> setCurThread t \<lbrace>\<lambda>rv s. obj_at' P (ksCurThread s) s \<rbrace>"
@@ -1984,11 +1979,12 @@ proof -
 qed
 
 lemma switchToIdleThread_ct_not_queued_no_cicd':
-  "\<lbrace> invs_no_cicd' \<rbrace> switchToIdleThread \<lbrace>\<lambda>rv s. obj_at' (Not \<circ> tcbQueued) (ksCurThread s) s \<rbrace>"
+  "\<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 (rule idle'_not_tcbQueued')
-  apply (simp add: invs_no_cicd'_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]:
@@ -2005,7 +2001,7 @@ lemma switchToThread_tcb_in_cur_domain':
    ThreadDecls_H.switchToThread thread
    \<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)
+  apply (wpsimp wp: tcbSchedDequeue_not_tcbQueued hoare_drop_imps)
   done
 
 lemma chooseThread_invs_no_cicd'_posts: (* generic version *)
@@ -2027,11 +2023,14 @@ proof -
     by (simp add: all_invs_but_ct_idle_or_in_cur_domain'_def maxDomain_def)
 
   show ?thesis
-    unfolding chooseThread_def Let_def curDomain_def
+    apply (clarsimp simp: chooseThread_def Let_def curDomain_def)
+    apply (rule hoare_seq_ext[OF _ stateAssert_sp])+
     apply (simp only: return_bind, simp)
-    apply (rule hoare_seq_ext[where B="\<lambda>rv s. invs_no_cicd' s \<and> rv = ksCurDomain s"])
+    apply (rule hoare_seq_ext[where B="\<lambda>rv s. invs_no_cicd' s \<and> rv = ksCurDomain s
+                                              \<and> ksReadyQueues_asrt s \<and> ready_qs_runnable s"])
      apply (rule_tac B="\<lambda>rv s. invs_no_cicd' s \<and> curdom = ksCurDomain s \<and>
-                               rv = ksReadyQueuesL1Bitmap s curdom" in hoare_seq_ext)
+                               rv = ksReadyQueuesL1Bitmap s curdom \<and>
+                               ksReadyQueues_asrt s \<and> ready_qs_runnable s" in hoare_seq_ext)
       apply (rename_tac l1)
       apply (case_tac "l1 = 0")
        (* switch to idle thread *)
@@ -2045,12 +2044,10 @@ proof -
       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
-      apply (clarsimp dest!: invs_no_cicd'_queues
-                      simp: valid_queues_def lookupBitmapPriority_def[symmetric])
-      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 (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
@@ -2089,11 +2086,14 @@ proof -
 
   (* FIXME this is almost identical to the chooseThread_invs_no_cicd'_posts proof, can generalise? *)
   show ?thesis
-    unfolding chooseThread_def Let_def curDomain_def
+    apply (clarsimp simp: chooseThread_def Let_def curDomain_def)
+    apply (rule hoare_seq_ext[OF _ stateAssert_sp])+
     apply (simp only: return_bind, simp)
-    apply (rule hoare_seq_ext[where B="\<lambda>rv s. invs_no_cicd' s \<and> rv = ksCurDomain s"])
+    apply (rule hoare_seq_ext[where B="\<lambda>rv s. invs_no_cicd' s \<and> rv = ksCurDomain s
+                                              \<and> ksReadyQueues_asrt s \<and> ready_qs_runnable s"])
      apply (rule_tac B="\<lambda>rv s. invs_no_cicd' s \<and> curdom = ksCurDomain s \<and>
-                               rv = ksReadyQueuesL1Bitmap s curdom" in hoare_seq_ext)
+                               rv = ksReadyQueuesL1Bitmap s curdom \<and>
+                               ksReadyQueues_asrt s \<and> ready_qs_runnable s" in hoare_seq_ext)
       apply (rename_tac l1)
       apply (case_tac "l1 = 0")
        (* switch to idle thread *)
@@ -2101,7 +2101,10 @@ proof -
       (* we have a thread to switch to *)
       apply (clarsimp simp: bitmap_fun_defs)
       apply (wp assert_inv)
-      apply (clarsimp dest!: invs_no_cicd'_queues simp: valid_queues_def)
+      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
@@ -2250,11 +2253,18 @@ lemma sbn_sch_act_sane:
   done
 
 lemma possibleSwitchTo_corres:
-  "corres dc (valid_etcbs and weak_valid_sched_action and cur_tcb and st_tcb_at runnable t)
-    (Invariants_H.valid_queues and valid_queues' and
-    (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and cur_tcb' and tcb_at' t and st_tcb_at' runnable' t and valid_objs')
-      (possible_switch_to t)
-      (possibleSwitchTo t)"
+  "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)
+  apply (rule_tac Q'="tcb_at' t" in corres_cross_add_guard)
+   apply (fastforce dest!: st_tcb_at_tcb_at elim!: tcb_at_cross)
   supply ethread_get_wp[wp del]
   apply (simp add: possible_switch_to_def possibleSwitchTo_def cong: if_cong)
   apply (rule corres_guard_imp)
@@ -2264,12 +2274,12 @@ lemma possibleSwitchTo_corres:
          apply (clarsimp simp: etcb_relation_def)
         apply (rule corres_split[OF getSchedulerAction_corres])
           apply (rule corres_if, simp)
-           apply (rule tcbSchedEnqueue_corres)
+           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)
-            apply (wp rescheduleRequired_valid_queues'_weak)+
+             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])+
@@ -2278,7 +2288,7 @@ lemma possibleSwitchTo_corres:
    apply (fastforce simp: valid_sched_def invs_def valid_state_def cur_tcb_def
                           valid_sched_action_def weak_valid_sched_action_def
                           tcb_at_is_etcb_at[OF st_tcb_at_tcb_at[rotated]])
-  apply (simp add: tcb_at_is_etcb_at)
+  apply fastforce
   done
 
 end
diff --git a/proof/refine/X64/StateRelation.thy b/proof/refine/X64/StateRelation.thy
index 88f7b61666..1df131c221 100644
--- a/proof/refine/X64/StateRelation.thy
+++ b/proof/refine/X64/StateRelation.thy
@@ -200,17 +200,24 @@ where
   \<and> tcb_bound_notification tcb = tcbBoundNotification tcb'
   \<and> tcb_mcpriority tcb = tcbMCP tcb'"
 
+
+\<comment> \<open>
+  A pair of objects @{term "(obj, obj')"} should satisfy the following relation when, under further
+  mild assumptions, a @{term corres_underlying} lemma for @{term "set_object obj"}
+  and @{term "setObject obj'"} can be stated: see setObject_other_corres in KHeap_R.
+
+  TCBs do not satisfy this relation because the tcbSchedPrev and tcbSchedNext fields of a TCB are
+  used to model the ready queues, and so an update to such a field would correspond to an update
+  to a ready queue (see ready_queues_relation below).\<close>
 definition
   other_obj_relation :: "Structures_A.kernel_object \<Rightarrow> Structures_H.kernel_object \<Rightarrow> bool"
 where
   "other_obj_relation obj obj' \<equiv>
-  (case (obj, obj') of
-        (TCB tcb, KOTCB tcb') \<Rightarrow> tcb_relation tcb tcb'
-      | (Endpoint ep, KOEndpoint ep') \<Rightarrow> ep_relation ep ep'
+   case (obj, obj') of
+        (Endpoint ep, KOEndpoint ep') \<Rightarrow> ep_relation ep ep'
       | (Notification ntfn, KONotification ntfn') \<Rightarrow> ntfn_relation ntfn ntfn'
-      | (ArchObj (X64_A.ASIDPool pool), KOArch (KOASIDPool pool'))
-             \<Rightarrow> asid_pool_relation pool pool'
-      | _ \<Rightarrow> False)"
+      | (ArchObj (X64_A.ASIDPool pool), KOArch (KOASIDPool pool')) \<Rightarrow> asid_pool_relation pool pool'
+      | _ \<Rightarrow> False"
 
 primrec
    pml4e_relation' :: "X64_A.pml4e \<Rightarrow> X64_H.pml4e \<Rightarrow> bool"
@@ -290,6 +297,12 @@ where
 | "aobj_relation_cuts (PageMapL4 pm) x =
      (\<lambda>y. (x + (ucast y << word_size_bits), pml4e_relation y)) ` UNIV"
 
+definition tcb_relation_cut :: "Structures_A.kernel_object \<Rightarrow> kernel_object \<Rightarrow> bool" where
+  "tcb_relation_cut obj obj' \<equiv>
+   case (obj, obj') of
+       (TCB t, KOTCB t') \<Rightarrow> tcb_relation t t'
+     | _ \<Rightarrow> False"
+
 primrec
   obj_relation_cuts :: "Structures_A.kernel_object \<Rightarrow> machine_word \<Rightarrow> obj_relation_cuts"
 where
@@ -297,17 +310,17 @@ where
      (if well_formed_cnode_n sz cs
       then {(cte_map (x, y), cte_relation y) | y. y \<in> dom cs}
       else {(x, \<bottom>\<bottom>)})"
-| "obj_relation_cuts (TCB tcb) x = {(x, other_obj_relation)}"
+| "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 (ArchObj ao) x = aobj_relation_cuts ao x"
 
-
 lemma obj_relation_cuts_def2:
   "obj_relation_cuts ko x =
    (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>)}
+             | TCB tcb \<Rightarrow> {(x, tcb_relation_cut)}
              | ArchObj (PageTable pt) \<Rightarrow> (\<lambda>y. (x + (ucast y << word_size_bits), pte_relation y))
                                            ` (UNIV :: 9 word set)
              | ArchObj (PageDirectory pd) \<Rightarrow> (\<lambda>y. (x + (ucast y << word_size_bits), pde_relation y))
@@ -326,6 +339,7 @@ lemma obj_relation_cuts_def3:
   "obj_relation_cuts ko x =
   (case (a_type ko) of
      ACapTable n \<Rightarrow> {(cte_map (x, y), cte_relation y) | y. length y = n}
+   | ATCB \<Rightarrow> {(x, tcb_relation_cut)}
    | AArch APageTable \<Rightarrow> (\<lambda>y. (x + (ucast y << word_size_bits), pte_relation y))
                             ` (UNIV :: 9 word set)
    | AArch APageDirectory \<Rightarrow> (\<lambda>y. (x + (ucast y << word_size_bits), pde_relation y))
@@ -345,22 +359,27 @@ lemma obj_relation_cuts_def3:
   done
 
 definition
- "is_other_obj_relation_type tp \<equiv>
-  case tp of
-     ACapTable n \<Rightarrow> False
-   | AArch APageTable \<Rightarrow> False
-   | AArch APageDirectory \<Rightarrow> False
-   | AArch APDPointerTable \<Rightarrow> False
-   | AArch APageMapL4 \<Rightarrow> False
-   | AArch (AUserData _)   \<Rightarrow> False
-   | AArch (ADeviceData _)   \<Rightarrow> False
-   | AGarbage _ \<Rightarrow> False
-   | _ \<Rightarrow> True"
+  "is_other_obj_relation_type tp \<equiv>
+     case tp of
+       ACapTable n \<Rightarrow> False
+     | ATCB \<Rightarrow> False
+     | AArch APageTable \<Rightarrow> False
+     | AArch APageDirectory \<Rightarrow> False
+     | AArch APDPointerTable \<Rightarrow> False
+     | AArch APageMapL4 \<Rightarrow> False
+     | AArch (AUserData _)   \<Rightarrow> False
+     | AArch (ADeviceData _)   \<Rightarrow> False
+     | AGarbage _ \<Rightarrow> False
+     | _ \<Rightarrow> True"
 
 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_TCB:
+  "\<not> is_other_obj_relation_type ATCB"
+  by (simp add: is_other_obj_relation_type_def)
+
 lemma is_other_obj_relation_type_UserData:
   "\<not> is_other_obj_relation_type (AArch (AUserData sz))"
   unfolding is_other_obj_relation_type_def by simp
@@ -408,11 +427,55 @@ where
   "sched_act_relation choose_new_thread a' = (a' = ChooseNewThread)" |
   "sched_act_relation (switch_thread x) a' = (a' = SwitchToThread x)"
 
-definition
-  ready_queues_relation :: "(Deterministic_A.domain \<Rightarrow> Structures_A.priority \<Rightarrow> Deterministic_A.ready_queue)
-                         \<Rightarrow> (domain \<times> priority \<Rightarrow> KernelStateData_H.ready_queue) \<Rightarrow> bool"
-where
-  "ready_queues_relation qs qs' \<equiv> \<forall>d p. (qs d p = qs' (d, p))"
+definition queue_end_valid :: "obj_ref list \<Rightarrow> tcb_queue \<Rightarrow> bool" where
+  "queue_end_valid ts q \<equiv>
+     (ts = [] \<longrightarrow> tcbQueueEnd q = None) \<and> (ts \<noteq> [] \<longrightarrow> tcbQueueEnd q = Some (last ts))"
+
+definition prev_queue_head :: "tcb_queue \<Rightarrow> (obj_ref \<rightharpoonup> 'a) \<Rightarrow> bool" where
+  "prev_queue_head q prevs \<equiv> \<forall>head. tcbQueueHead q = Some head \<longrightarrow> prevs head = None"
+
+lemma prev_queue_head_heap_upd:
+  "\<lbrakk>prev_queue_head q prevs; Some r \<noteq> tcbQueueHead q\<rbrakk> \<Longrightarrow> prev_queue_head q (prevs(r := x))"
+  by (clarsimp simp: prev_queue_head_def)
+
+definition list_queue_relation ::
+  "obj_ref list \<Rightarrow> tcb_queue \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> bool"
+  where
+  "list_queue_relation ts q nexts prevs \<equiv>
+     heap_ls nexts (tcbQueueHead q) ts \<and> queue_end_valid ts q \<and> prev_queue_head q prevs"
+
+lemma list_queue_relation_nil:
+  "list_queue_relation ts q nexts prevs \<Longrightarrow> ts = [] \<longleftrightarrow> tcbQueueEmpty q"
+  by (fastforce dest: heap_path_head simp: tcbQueueEmpty_def list_queue_relation_def)
+
+definition ready_queue_relation ::
+  "Deterministic_A.domain \<Rightarrow> Structures_A.priority
+   \<Rightarrow> Deterministic_A.ready_queue \<Rightarrow> ready_queue
+   \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref)
+   \<Rightarrow> (obj_ref \<Rightarrow> bool) \<Rightarrow> bool"
+  where
+  "ready_queue_relation d p q q' nexts prevs flag \<equiv>
+     list_queue_relation q q' nexts prevs
+     \<and> (\<forall>t. flag t \<longleftrightarrow> t \<in> set q)
+     \<and> (d > maxDomain \<or> p > maxPriority \<longrightarrow> tcbQueueEmpty q')"
+
+definition ready_queues_relation_2 ::
+  "(Deterministic_A.domain \<Rightarrow> Structures_A.priority \<Rightarrow> Deterministic_A.ready_queue)
+   \<Rightarrow> (domain \<times> priority \<Rightarrow> ready_queue)
+   \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref)
+   \<Rightarrow> (domain \<Rightarrow> priority \<Rightarrow> obj_ref \<Rightarrow> bool) \<Rightarrow> bool"
+  where
+  "ready_queues_relation_2 qs qs' nexts prevs inQs \<equiv>
+     \<forall>d p. let q = qs d p; q' = qs' (d, p); flag = inQs d p in
+           ready_queue_relation d p q q' nexts prevs flag"
+
+abbreviation ready_queues_relation :: "det_state \<Rightarrow> kernel_state \<Rightarrow> bool" where
+  "ready_queues_relation s s' \<equiv>
+     ready_queues_relation_2
+      (ready_queues s) (ksReadyQueues s') (tcbSchedNexts_of s') (tcbSchedPrevs_of s')
+      (\<lambda>d p. inQ d p |< tcbs_of' s')"
+
+lemmas ready_queues_relation_def = ready_queues_relation_2_def
 
 definition
   ghost_relation :: "Structures_A.kheap \<Rightarrow> (machine_word \<rightharpoonup> vmpage_size) \<Rightarrow> (machine_word \<rightharpoonup> nat) \<Rightarrow> bool"
@@ -507,6 +570,8 @@ lemma obj_relation_cutsE:
      \<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>tcb tcb'. \<lbrakk> y = x; ko = TCB tcb; ko' = KOTCB tcb'; tcb_relation tcb tcb' \<rbrakk>
+               \<Longrightarrow> R;
      \<And>pt (z :: 9 word) pte'. \<lbrakk> ko = ArchObj (PageTable pt); y = x + (ucast z << word_size_bits);
                               ko' = KOArch (KOPTE pte'); pte_relation' (pt z) pte' \<rbrakk>
               \<Longrightarrow> R;
@@ -524,8 +589,8 @@ lemma obj_relation_cutsE:
             \<lbrakk> y = x; other_obj_relation ko ko'; is_other_obj_relation_type (a_type ko) \<rbrakk> \<Longrightarrow> R
     \<rbrakk> \<Longrightarrow> R"
   apply (simp add: obj_relation_cuts_def2 is_other_obj_relation_type_def
-                   a_type_def
-            split: Structures_A.kernel_object.split_asm if_split_asm
+                   a_type_def tcb_relation_cut_def
+            split: Structures_A.kernel_object.split_asm if_split_asm kernel_object.split_asm
                    X64_A.arch_kernel_obj.split_asm)
     apply ((clarsimp split: if_splits,
                 force simp: cte_relation_def pte_relation_def pde_relation_def
@@ -606,7 +671,7 @@ where
          pspace_relation (kheap s) (ksPSpace s')
        \<and> ekheap_relation (ekheap s) (ksPSpace s')
        \<and> sched_act_relation (scheduler_action s) (ksSchedulerAction s')
-       \<and> ready_queues_relation (ready_queues s) (ksReadyQueues s')
+       \<and> ready_queues_relation s 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')
@@ -628,6 +693,10 @@ lemma curthread_relation:
   "(a, b) \<in> state_relation \<Longrightarrow> ksCurThread b = cur_thread a"
   by (simp add: state_relation_def)
 
+lemma curdomain_relation[elim!]:
+  "(s, s') \<in> state_relation \<Longrightarrow> cur_domain s = ksCurDomain s'"
+  by (clarsimp simp: state_relation_def)
+
 lemma state_relation_pspace_relation[elim!]:
   "(s,s') \<in> state_relation \<Longrightarrow> pspace_relation (kheap s) (ksPSpace s')"
   by (simp add: state_relation_def)
@@ -636,12 +705,24 @@ lemma state_relation_ekheap_relation[elim!]:
   "(s,s') \<in> state_relation \<Longrightarrow> ekheap_relation (ekheap s) (ksPSpace s')"
   by (simp add: state_relation_def)
 
+lemma state_relation_sched_act_relation[elim!]:
+  "(s,s') \<in> state_relation \<Longrightarrow> sched_act_relation (scheduler_action s) (ksSchedulerAction s')"
+  by (clarsimp simp: state_relation_def)
+
+lemma state_relation_ready_queues_relation[elim!]:
+  "(s, s') \<in> state_relation \<Longrightarrow> ready_queues_relation s s'"
+  by (simp add: state_relation_def)
+
+lemma state_relation_idle_thread[elim!]:
+  "(s, s') \<in> state_relation \<Longrightarrow> idle_thread s = ksIdleThread s'"
+  by (clarsimp simp: state_relation_def)
+
 lemma state_relationD:
   assumes sr:  "(s, s') \<in> state_relation"
   shows "pspace_relation (kheap s) (ksPSpace s') \<and>
   ekheap_relation (ekheap s) (ksPSpace s') \<and>
   sched_act_relation (scheduler_action s) (ksSchedulerAction s') \<and>
-  ready_queues_relation (ready_queues s) (ksReadyQueues s') \<and>
+  ready_queues_relation s 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>
@@ -663,7 +744,7 @@ lemma state_relationE [elim?]:
   and rl: "\<lbrakk>pspace_relation (kheap s) (ksPSpace s');
   ekheap_relation (ekheap s) (ksPSpace s');
   sched_act_relation (scheduler_action s) (ksSchedulerAction s');
-  ready_queues_relation (ready_queues s) (ksReadyQueues s');
+  ready_queues_relation s 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');
diff --git a/proof/refine/X64/Syscall_R.thy b/proof/refine/X64/Syscall_R.thy
index 98ef62652a..a6e8133c98 100644
--- a/proof/refine/X64/Syscall_R.thy
+++ b/proof/refine/X64/Syscall_R.thy
@@ -350,16 +350,14 @@ lemma threadSet_tcbDomain_update_sch_act_wf[wp]:
 
 lemma setDomain_corres:
   "corres dc
-     (valid_etcbs and valid_sched and tcb_at tptr)
-     (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)"
+     (valid_etcbs and valid_sched and pspace_aligned and pspace_distinct and tcb_at tptr)
+     (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 corres_guard_imp)
     apply (rule corres_split[OF getCurThread_corres])
-      apply (rule corres_split[OF tcbSchedDequeue_corres])
+      apply (rule corres_split[OF tcbSchedDequeue_corres], simp)
         apply (rule corres_split)
            apply (rule ethread_set_corres; simp)
            apply (clarsimp simp: etcb_relation_def)
@@ -368,26 +366,38 @@ lemma setDomain_corres:
             apply (rule corres_split)
                apply clarsimp
                apply (rule corres_when[OF refl])
-               apply (rule tcbSchedEnqueue_corres)
+               apply (rule tcbSchedEnqueue_corres, simp)
               apply (rule corres_when[OF refl])
               apply (rule rescheduleRequired_corres)
-             apply ((wp hoare_drop_imps hoare_vcg_conj_lift | clarsimp| assumption)+)[5]
-        apply clarsimp
-        apply (rule_tac Q="\<lambda>_. valid_objs' and valid_queues' and valid_queues and
-          (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and tcb_at' tptr"
-          in hoare_strengthen_post[rotated])
-         apply (auto simp: invs'_def valid_state'_def sch_act_wf_weak st_tcb_at'_def o_def)[1]
-        apply (wp threadSet_valid_objs' threadSet_valid_queues'_no_state
-          threadSet_valid_queues_no_state
-          threadSet_pred_tcb_no_state | simp)+
-      apply (rule_tac Q = "\<lambda>r s. invs' s \<and> (\<forall>p. tptr \<notin> set (ksReadyQueues s p)) \<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)
-       apply (drule(1) bspec)
-       apply (clarsimp simp:tcb_cte_cases_def)
+             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 Tcb_R.tcbSchedDequeue_not_in_queue)+
+      apply (wp hoare_vcg_all_lift tcbSchedDequeue_not_queued)+
    apply clarsimp
    apply (frule tcb_at_is_etcb_at)
     apply simp+
@@ -395,7 +405,6 @@ lemma setDomain_corres:
                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> (=))
@@ -457,7 +466,7 @@ lemma performInvocation_corres:
         apply (rule corres_split[OF setDomain_corres])
           apply (rule corres_trivial, simp)
          apply (wp)+
-       apply (clarsimp+)[2]
+       apply (fastforce+)[2]
      \<comment> \<open>CNodes\<close>
      apply clarsimp
      apply (rule corres_guard_imp)
@@ -766,90 +775,71 @@ 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>rv. invs'\<rbrace>"
+   doReplyTransfer t' t slot grant
+   \<lbrace>\<lambda>_. invs'\<rbrace>"
   apply (simp add: doReplyTransfer_def liftM_def)
   apply (rule hoare_seq_ext [OF _ gts_sp'])
   apply (rule hoare_seq_ext [OF _ assert_sp])
   apply (rule hoare_seq_ext [OF _ getCTE_sp])
   apply (wp, wpc)
-        apply (wp)
+        apply wp
           apply (wp (once) sts_invs_minor'')
-          apply (simp)
+          apply simp
           apply (wp (once) sts_st_tcb')
-          apply (wp)[1]
-         apply (rule_tac Q="\<lambda>rv s. invs' s
-                                   \<and> t \<noteq> ksIdleThread s
-                                   \<and> st_tcb_at' awaiting_reply' t s"
+          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 (frule_tac t=t in invs'_not_runnable_not_queued)
-           apply (erule pred_tcb'_weakenE, case_tac st, clarsimp+)
+          apply clarsimp
           apply (rule conjI, erule pred_tcb'_weakenE, case_tac st, clarsimp+)
-          apply (rule conjI, rule impI, erule pred_tcb'_weakenE, case_tac st)
-                  apply (clarsimp | drule(1) obj_at_conj')+
           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 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 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])
+                               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 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>rv 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 (frule_tac t=t in invs'_not_runnable_not_queued)
-               apply (erule pred_tcb'_weakenE, case_tac st, clarsimp+)
+             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 (rule conjI, rule impI, erule pred_tcb'_weakenE, case_tac st)
-                      apply (clarsimp | drule(1) obj_at_conj')+
               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 clarsimp
               apply (erule_tac P="\<lambda>st. awaiting_reply' st \<and> activatable' st"
-                      in pred_tcb'_weakenE)
+                            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 clarsimp
             apply (rule conjI)
-             apply (clarsimp simp: invs'_def valid_state'_def valid_idle'_def)
-             apply (rule conjI)
-              apply clarsimp
-             apply (clarsimp simp: obj_at'_def idle_tcb'_def pred_tcb_at'_def)
+             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 (rule conjI)
              apply (clarsimp simp : invs'_def valid_state'_def valid_idle'_def pred_tcb_at'_def
                                     obj_at'_def idle_tcb'_def)
-            apply (rule conjI)
-             apply clarsimp
-             apply (frule invs'_not_runnable_not_queued)
-              apply (erule pred_tcb'_weakenE, clarsimp)
-             apply (frule (1) not_tcbQueued_not_ksQ)
-             apply simp
-            apply clarsimp
            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)
@@ -859,35 +849,9 @@ lemma ct_active_runnable' [simp]:
   "ct_active' s \<Longrightarrow> ct_in_state' runnable' s"
   by (fastforce simp: ct_in_state'_def elim!: pred_tcb'_weakenE)
 
-lemma valid_irq_node_tcbSchedEnqueue[wp]:
-  "\<lbrace>\<lambda>s. valid_irq_node' (irq_node' s) s \<rbrace> tcbSchedEnqueue ptr
-  \<lbrace>\<lambda>rv s'. valid_irq_node' (irq_node' s') s'\<rbrace>"
-  apply (rule hoare_pre)
-  apply (simp add:valid_irq_node'_def )
-  apply (wp unless_wp hoare_vcg_all_lift | wps)+
-  apply (simp add:tcbSchedEnqueue_def)
-  apply (wp unless_wp| simp)+
-  apply (simp add:valid_irq_node'_def)
-  done
-
-lemma rescheduleRequired_valid_queues_but_ct_domain:
-  "\<lbrace>\<lambda>s. Invariants_H.valid_queues s \<and> valid_objs' s
-     \<and> (\<forall>x. ksSchedulerAction s = SwitchToThread x \<longrightarrow> st_tcb_at' runnable' x s) \<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | wpc | simp)+
-  done
-
-lemma rescheduleRequired_valid_queues'_but_ct_domain:
-  "\<lbrace>\<lambda>s. valid_queues' s
-     \<and> (\<forall>x. ksSchedulerAction s = SwitchToThread x \<longrightarrow> st_tcb_at' runnable' x s)
-   \<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | wpc | simp | fastforce simp: valid_queues'_def)+
-  done
+crunches tcbSchedEnqueue
+  for valid_irq_node[wp]: "\<lambda>s. valid_irq_node' (irq_node' s) s"
+  (rule: valid_irq_node_lift)
 
 lemma tcbSchedEnqueue_valid_action:
   "\<lbrace>\<lambda>s. \<forall>x. ksSchedulerAction s = SwitchToThread x \<longrightarrow> st_tcb_at' runnable' x s\<rbrace>
@@ -898,9 +862,10 @@ lemma tcbSchedEnqueue_valid_action:
   done
 
 abbreviation (input) "all_invs_but_sch_extra \<equiv>
-    \<lambda>s. valid_pspace' s \<and> Invariants_H.valid_queues s \<and>
+    \<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>
@@ -913,35 +878,27 @@ abbreviation (input) "all_invs_but_sch_extra \<equiv>
     valid_machine_state' s \<and>
     cur_tcb' s \<and>
     untyped_ranges_zero' s \<and>
-    valid_queues' s \<and> pspace_domain_valid 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>"
+  "\<lbrace>all_invs_but_sch_extra\<rbrace> rescheduleRequired \<lbrace>\<lambda>_. invs'\<rbrace>"
   apply (simp add: invs'_def valid_state'_def)
-  apply (rule hoare_pre)
-  apply (wp add:rescheduleRequired_ct_not_inQ
-    rescheduleRequired_sch_act'
-    rescheduleRequired_valid_queues_but_ct_domain
-    rescheduleRequired_valid_queues'_but_ct_domain
-    valid_irq_node_lift valid_irq_handlers_lift'' valid_ioports_lift''
-    irqs_masked_lift cur_tcb_lift)
+  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 (\<lambda>s. (\<forall>p. t \<notin> set (ksReadyQueues s p))) and
-                all_invs_but_sch_extra and sch_act_simple and
+  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 (wp threadSet_valid_pspace'T_P[where P = False and Q = \<top> and Q' = \<top>])
-  apply (simp add:tcb_cte_cases_def)+
+            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>]
@@ -954,18 +911,14 @@ lemma threadSet_all_invs_but_sch_extra:
      valid_ioports_lift''
      threadSet_ctes_ofT
      threadSet_not_inQ
-     threadSet_valid_queues'_no_state
      threadSet_tcbDomain_update_ct_idle_or_in_cur_domain'
-     threadSet_valid_queues
      threadSet_valid_dom_schedule'
      threadSet_iflive'T
      threadSet_ifunsafe'T
-     untyped_ranges_zero_lift
+     untyped_ranges_zero_lift threadSet_sched_pointers threadSet_valid_sched_pointers
      | simp add:tcb_cte_cases_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+
+  apply (fastforce simp: sch_act_simple_def o_def cteCaps_of_def)
   done
 
 lemma threadSet_not_curthread_ct_domain:
@@ -988,9 +941,7 @@ lemma setDomain_invs':
       \<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 (erule st_tcb_ex_cap'')
        apply simp
-      apply (case_tac st,simp_all)[1]
      apply (rule hoare_strengthen_post[OF hoare_vcg_conj_lift])
        apply (rule threadSet_all_invs_but_sch_extra)
       prefer 2
@@ -1008,17 +959,14 @@ lemma setDomain_invs':
   done
 
 lemma performInv_invs'[wp]:
-  "\<lbrace>invs' and sch_act_simple
-          and (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))
-          and ct_active' and valid_invocation' i\<rbrace>
-     RetypeDecls_H.performInvocation block call i \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  "\<lbrace>invs' and sch_act_simple and ct_active' and valid_invocation' i\<rbrace>
+   RetypeDecls_H.performInvocation block call i
+   \<lbrace>\<lambda>_. invs'\<rbrace>"
   unfolding performInvocation_def
   apply (cases i)
-  apply ((clarsimp simp: simple_sane_strg sch_act_simple_def
-                         ct_not_ksQ sch_act_sane_def
-                  | wp tcbinv_invs' arch_performInvocation_invs'
-                       setDomain_invs'
-                  | rule conjI | erule active_ex_cap')+)
+  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]:
@@ -1182,7 +1130,10 @@ done
 lemmas set_thread_state_active_valid_sched =
   set_thread_state_runnable_valid_sched[simplified runnable_eq_active]
 
-(*FIXME: move to Nondet_VCG.valid_validE_R *)
+crunches reply_from_kernel
+  for pspace_aligned[wp]: pspace_aligned
+  and pspace_distinct[wp]: pspace_distinct
+
 lemma handleInvocation_corres:
   "c \<longrightarrow> b \<Longrightarrow>
    corres (dc \<oplus> dc)
@@ -1229,13 +1180,14 @@ lemma handleInvocation_corres:
                       apply simp
                      apply (simp add: when_def)
                      apply (rule conjI, rule impI)
-                      apply (rule reply_from_kernel_tcb_at)
-                     apply (rule impI, wp+)
-                 apply simp+
-                 apply (wp hoare_drop_imps)+
-                apply simp
-                apply wp
-               apply simp
+                      apply (wp reply_from_kernel_tcb_at)
+                     apply wpsimp
+                    apply wp+
+                 apply simp
+                 apply (strengthen invs_psp_aligned invs_distinct)
+                 apply (simp cong: conj_cong)
+                 apply (simp cong: rev_conj_cong)
+                 apply (wpsimp wp: hoare_drop_imps)+
                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"
@@ -1250,7 +1202,6 @@ lemma handleInvocation_corres:
                                       and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)"
                          in hoare_post_imp)
                apply (clarsimp simp: ct_in_state'_def)
-               apply (frule(1) ct_not_ksQ)
                apply (clarsimp)
               apply (wp setThreadState_nonqueued_state_update
                         setThreadState_st_tcb setThreadState_rct)[1]
@@ -1261,14 +1212,14 @@ lemma handleInvocation_corres:
    apply (clarsimp simp: tcb_at_invs invs_valid_objs
                          valid_tcb_state_def ct_in_state_def
                          simple_from_active invs_mdb)
-   apply (clarsimp simp: msg_max_length_def word_bits_def)
+   apply (clarsimp simp: msg_max_length_def word_bits_def schact_is_rct_def
+                         invs_psp_aligned invs_distinct)
    apply (erule st_tcb_ex_cap, clarsimp+)
    apply fastforce
   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(1) valid_queues_not_tcbQueued_not_ksQ)
   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)
@@ -1278,7 +1229,7 @@ lemma handleInvocation_corres:
 
 lemma ts_Restart_case_helper':
   "(case ts of Structures_H.Restart \<Rightarrow> A | _ \<Rightarrow> B)
- = (if ts = Structures_H.Restart then A else B)"
+    = (if ts = Structures_H.Restart then A else B)"
   by (cases ts, simp_all)
 
 lemma gts_imp':
@@ -1328,11 +1279,8 @@ lemma hinv_invs'[wp]:
                                 and st_tcb_at' active' thread"
                   in hoare_post_imp)
         apply (clarsimp simp: ct_in_state'_def)
-        apply (frule(1) ct_not_ksQ)
-        apply (clarsimp)
        apply (wp sts_invs_minor' setThreadState_st_tcb setThreadState_rct | simp)+
     apply (clarsimp)
-    apply (frule(1) ct_not_ksQ)
     apply (fastforce simp add: tcb_at_invs' ct_in_state'_def
                               simple_sane_strg
                               sch_act_simple_def
@@ -1476,7 +1424,6 @@ lemma handleRecv_isBlocking_corres':
                     and (\<lambda>s. ex_nonz_cap_to (cur_thread s) s))
               (invs' and ct_in_state' simple'
                      and sch_act_sane
-                     and (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))
                      and (\<lambda>s. ex_nonz_cap_to' (ksCurThread s) s))
                     (handle_recv isBlocking) (handleRecv isBlocking)"
   (is "corres dc (?pre1) (?pre2) (handle_recv _) (handleRecv _)")
@@ -1539,8 +1486,7 @@ lemma handleRecv_isBlocking_corres':
 
 lemma handleRecv_isBlocking_corres:
   "corres dc (einvs and ct_active)
-             (invs' and ct_active' and sch_act_sane and
-                    (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)))
+             (invs' and ct_active' and sch_act_sane)
             (handle_recv isBlocking) (handleRecv isBlocking)"
   apply (rule corres_guard_imp)
     apply (rule handleRecv_isBlocking_corres')
@@ -1555,42 +1501,27 @@ lemma lookupCap_refs[wp]:
   "\<lbrace>invs'\<rbrace> lookupCap t ref \<lbrace>\<lambda>rv s. \<forall>r\<in>zobj_refs' rv. ex_nonz_cap_to' r s\<rbrace>,-"
   by (simp add: lookupCap_def split_def | wp | simp add: o_def)+
 
-lemma deleteCallerCap_ksQ_ct':
-  "\<lbrace>invs' and ct_in_state' simple' and sch_act_sane and
-     (\<lambda>s. ksCurThread s \<notin> set (ksReadyQueues s p) \<and> thread = ksCurThread s)\<rbrace>
-      deleteCallerCap thread
-   \<lbrace>\<lambda>rv s. thread \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (rule_tac Q="\<lambda>rv s. thread = ksCurThread s \<and> ksCurThread s \<notin> set (ksReadyQueues s p)"
-            in hoare_strengthen_post)
-   apply (wp deleteCallerCap_ct_not_ksQ)
-    apply auto
-  done
-
 lemma hw_invs'[wp]:
   "\<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)
-          and (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))\<rbrace>
+          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
-                           deleteCallerCap_ksQ_ct'
                            hoare_lift_Pf2[OF deleteCallerCap_simple
                            deleteCallerCap_ct']
                       | wpc | simp)+)[1]
                apply simp
                apply (wp deleteCallerCap_nonz_cap hoare_vcg_all_lift
-                         deleteCallerCap_ksQ_ct'
                          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> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))
                              \<and> thread = ksCurThread s
                              \<and> ct_in_state' simple' s
                              \<and> ex_nonz_cap_to' thread s
@@ -1614,34 +1545,45 @@ lemma setSchedulerAction_obj_at'[wp]:
   by (wp, clarsimp elim!: obj_at'_pspaceI)
 
 lemma handleYield_corres:
-  "corres dc einvs (invs' and ct_active' and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)) handle_yield handleYield"
+  "corres dc
+     (einvs and ct_active)
+     (invs' and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread))
+     handle_yield handleYield"
   apply (clarsimp simp: handle_yield_def handleYield_def)
   apply (rule corres_guard_imp)
     apply (rule corres_split[OF getCurThread_corres])
       apply simp
-      apply (rule corres_split[OF tcbSchedDequeue_corres])
-        apply (rule corres_split[OF tcbSchedAppend_corres])
+      apply (rule corres_split[OF tcbSchedDequeue_corres], simp)
+        apply (rule corres_split[OF tcbSchedAppend_corres], simp)
           apply (rule rescheduleRequired_corres)
-         apply (wp weak_sch_act_wf_lift_linear tcbSchedDequeue_valid_queues | simp add: )+
-   apply (simp add: invs_def valid_sched_def valid_sched_action_def
-                cur_tcb_def tcb_at_is_etcb_at)
-  apply clarsimp
-  apply (frule ct_active_runnable')
-  apply (clarsimp 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)
-  apply (erule(1) valid_objs_valid_tcbE[OF valid_pspace_valid_objs'])
-  apply (simp add:valid_tcb'_def)
+         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 (fastforce simp: invs_def valid_sched_def valid_sched_action_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 hy_invs':
   "\<lbrace>invs' and ct_active'\<rbrace> handleYield \<lbrace>\<lambda>r. invs' and ct_active'\<rbrace>"
   apply (simp add: handleYield_def)
-  apply (wp ct_in_state_thread_state_lift'
-            rescheduleRequired_all_invs_but_ct_not_inQ
-            tcbSchedAppend_invs_but_ct_not_inQ' | simp)+
-  apply (clarsimp simp add: 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
-                   )
+  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
 
@@ -1836,7 +1778,7 @@ 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 haskell_assert_wp doReplyTransfer_sane getCTE_wp'| wpc)+
+   apply (wp doReplyTransfer_sane getCTE_wp'| wpc)+
   apply (clarsimp simp: cte_wp_at_ctes_of)
   done
 
@@ -1852,75 +1794,6 @@ lemma handleReply_nonz_cap_to_ct:
 
 crunch ksQ[wp]: handleFaultReply "\<lambda>s. P (ksReadyQueues s p)"
 
-lemma doReplyTransfer_ct_not_ksQ:
-  "\<lbrace> invs' and sch_act_simple
-           and tcb_at' thread and tcb_at' word
-           and ct_in_state' simple'
-           and (\<lambda>s. ksCurThread s \<noteq> word)
-           and (\<lambda>s. \<forall>p. ksCurThread s \<notin> set(ksReadyQueues s p))\<rbrace>
-   doReplyTransfer thread word callerSlot g
-   \<lbrace>\<lambda>rv s. \<forall>p. ksCurThread s \<notin> set(ksReadyQueues s p)\<rbrace>"
-proof -
-  have astct: "\<And>t p.
-       \<lbrace>(\<lambda>s. ksCurThread s \<notin> set(ksReadyQueues s p) \<and> sch_act_sane s)
-             and (\<lambda>s. ksCurThread s \<noteq> t)\<rbrace>
-       possibleSwitchTo t \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set(ksReadyQueues s p)\<rbrace>"
-    apply (rule hoare_weaken_pre)
-     apply (wps possibleSwitchTo_ct')
-     apply (wp possibleSwitchTo_ksQ')
-    apply (clarsimp simp: sch_act_sane_def)
-    done
-  have stsct: "\<And>t st p.
-       \<lbrace>(\<lambda>s. ksCurThread s \<notin> set(ksReadyQueues s p)) and sch_act_simple\<rbrace>
-       setThreadState st t
-       \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set(ksReadyQueues s p)\<rbrace>"
-    apply (rule hoare_weaken_pre)
-     apply (wps setThreadState_ct')
-     apply (wp hoare_vcg_all_lift sts_ksQ)
-    apply (clarsimp)
-    done
-  show ?thesis
-    apply (simp add: doReplyTransfer_def)
-    apply (wp, wpc)
-            apply (wp astct stsct hoare_vcg_all_lift
-                      cteDeleteOne_ct_not_ksQ hoare_drop_imp
-                      hoare_lift_Pf2 [OF cteDeleteOne_sch_act_not cteDeleteOne_ct']
-                      hoare_lift_Pf2 [OF doIPCTransfer_pred_tcb_at' doIPCTransfer_ct']
-                      hoare_lift_Pf2 [OF doIPCTransfer_ksQ doIPCTransfer_ct']
-                      hoare_lift_Pf2 [OF threadSet_ksQ threadSet_ct]
-                      hoare_lift_Pf2 [OF handleFaultReply_ksQ handleFaultReply_ct']
-                   | simp add: ct_in_state'_def)+
-     apply (fastforce simp: sch_act_simple_def sch_act_sane_def ct_in_state'_def)+
-    done
-qed
-
-lemma handleReply_ct_not_ksQ:
-  "\<lbrace>invs' and sch_act_simple
-           and ct_in_state' simple'
-           and (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p))\<rbrace>
-   handleReply
-   \<lbrace>\<lambda>rv s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: handleReply_def del: split_paired_All)
-  apply (subst haskell_assert_def)
-  apply (wp | wpc)+
-  apply (wp doReplyTransfer_ct_not_ksQ getThreadCallerSlot_inv)+
-    apply (rule_tac Q="\<lambda>cap.
-                              (\<lambda>s. \<forall>p. ksCurThread s \<notin> set(ksReadyQueues s p))
-                          and invs'
-                          and sch_act_simple
-                          and (\<lambda>s. thread = ksCurThread s)
-                          and tcb_at' thread
-                          and ct_in_state' simple'
-                          and cte_wp_at' (\<lambda>c. cteCap c = cap) callerSlot"
-             in hoare_post_imp)
-     apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def
-                           cte_wp_at_ctes_of valid_cap'_def
-                    dest!: ctes_of_valid')
-    apply (wp getSlotCap_cte_wp_at getThreadCallerSlot_inv)+
-  apply (clarsimp)
-  done
-
-crunch valid_etcbs[wp]: possible_switch_to  "valid_etcbs"
 crunch valid_etcbs[wp]: handle_recv "valid_etcbs"
   (wp: crunch_wps simp: crunch_simps)
 
@@ -1933,11 +1806,10 @@ lemma handleReply_handleRecv_corres:
     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 handleReply_ct_not_ksQ handle_reply_valid_sched)+
+               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 (frule(1) ct_not_ksQ)
   apply (fastforce elim: pred_tcb'_weakenE)
   done
 
@@ -1945,7 +1817,6 @@ lemma handleHypervisorFault_corres:
   "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 (\<lambda>s. \<forall>p. thread \<notin> set(ksReadyQueues s p))
                     and st_tcb_at' simple' thread and ex_nonz_cap_to' thread)
           (handle_hypervisor_fault w fault) (handleHypervisorFault w fault)"
   apply (cases fault; clarsimp simp add: handleHypervisorFault_def returnOk_def2)
@@ -1961,14 +1832,13 @@ lemma handleEvent_corres:
   (is "?handleEvent_corres")
 proof -
   have hw:
-    "\<And>isBlocking. corres dc (einvs and ct_running and (\<lambda>s. scheduler_action s = resume_cur_thread))
+    "\<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
-                     dest!: ct_not_ksQ)+
+                     elim!: st_tcb_weakenE pred_tcb'_weakenE)+
     done
     show ?thesis
       apply (case_tac event)
@@ -1983,7 +1853,7 @@ proof -
                                      corres_guard_imp[OF handleCall_corres]
                                      corres_guard_imp[OF handleYield_corres]
                                      active_from_running active_from_running'
-                              simp: simple_sane_strg)[8]
+                              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)
@@ -1994,7 +1864,6 @@ proof -
                             simp: ct_in_state_def)
           apply wp
           apply (clarsimp)
-          apply (frule(1) ct_not_ksQ)
           apply (auto simp: ct_in_state'_def sch_act_simple_def
                             sch_act_sane_def
                       elim: pred_tcb'_weakenE st_tcb_ex_cap'')[1]
@@ -2007,12 +1876,11 @@ proof -
                            simp: ct_in_state_def valid_fault_def)
          apply wp
          apply clarsimp
-         apply (frule(1) ct_not_ksQ)
          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>rv. einvs"
+          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)
@@ -2022,7 +1890,6 @@ proof -
             apply (rule handleInterrupt_corres)
            apply (wp hoare_vcg_all_lift
                      doMachineOp_getActiveIRQ_IRQ_active'
-                    | simp
                     | simp add: imp_conjR | wp (once) hoare_drop_imps)+
         apply (simp add: invs'_def valid_state'_def)
        apply (rule_tac corres_underlying_split)
@@ -2039,7 +1906,6 @@ proof -
         apply (fastforce elim!: st_tcb_ex_cap st_tcb_weakenE simp: ct_in_state_def)
        apply wp
        apply (clarsimp)
-       apply (frule(1) ct_not_ksQ)
        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)
@@ -2051,7 +1917,6 @@ proof -
                         simp: ct_in_state_def)
       apply wp
       apply (clarsimp)
-      apply (frule(1) ct_not_ksQ)
       apply (auto simp: ct_in_state'_def sch_act_simple_def
                         sch_act_sane_def
                   elim: pred_tcb'_weakenE st_tcb_ex_cap'')[1]
@@ -2139,10 +2004,8 @@ proof -
         apply (rename_tac syscall)
         apply (case_tac syscall,
                (wp handleReply_sane handleReply_nonz_cap_to_ct handleReply_ksCurThread
-                   handleReply_ct_not_ksQ
                 | clarsimp simp: active_from_running' simple_from_running' simple_sane_strg simp del: split_paired_All
                 | rule conjI active_ex_cap'
-                | drule ct_not_ksQ[rotated]
                 | strengthen nidle)+)
         apply (rule hoare_strengthen_post,
                rule hoare_weaken_pre,
@@ -2154,7 +2017,6 @@ proof -
                  | 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'
-                 | drule ct_not_ksQ[rotated]
                  | wpc | wp (once) hoare_drop_imps)+
   done
 qed
diff --git a/proof/refine/X64/TcbAcc_R.thy b/proof/refine/X64/TcbAcc_R.thy
index d34682ed73..53f21c2a29 100644
--- a/proof/refine/X64/TcbAcc_R.thy
+++ b/proof/refine/X64/TcbAcc_R.thy
@@ -58,10 +58,8 @@ lemma getHighestPrio_inv[wp]:
   unfolding bitmap_fun_defs by simp
 
 lemma valid_bitmapQ_bitmapQ_simp:
-  "\<lbrakk> valid_bitmapQ s \<rbrakk> \<Longrightarrow>
-   bitmapQ d p s = (ksReadyQueues s (d, p) \<noteq> [])"
-   unfolding valid_bitmapQ_def
-   by simp
+  "valid_bitmapQ s \<Longrightarrow> bitmapQ d p s = (\<not> tcbQueueEmpty (ksReadyQueues s (d, p)))"
+  by (simp add: valid_bitmapQ_def)
 
 lemma prioToL1Index_l1IndexToPrio_or_id:
   "\<lbrakk> unat (w'::priority) < 2 ^ wordRadix ; w < 2^(size w' - wordRadix) \<rbrakk>
@@ -84,35 +82,18 @@ 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 :: "machine_word \<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 and runnable' \<circ> tcbState) t s)
-    \<and>  distinct (ksReadyQueues s (d, p))
-    \<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
-
 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 objBits_simps)
-  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
-                        X64_A.arch_kernel_obj.split_asm)+
-  apply fastforce
-  done
+                        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"
@@ -128,39 +109,13 @@ lemma st_tcb_at_runnable_coerce_concrete:
   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 projectKOs)
-  apply (drule(1) pspace_relation_absD)
-  apply (clarsimp simp: is_tcb other_obj_relation_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 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"
+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)
   done
 
-lemma valid_objs'_maxDomain:
-  "\<And>s t. \<lbrakk> valid_objs' s; tcb_at' t s \<rbrakk> \<Longrightarrow> obj_at' (\<lambda>tcb. tcbDomain tcb \<le> maxDomain) t s"
-  apply (erule (1) valid_objs_valid_tcbE)
-  apply (clarsimp simp: valid_tcb'_def)
-  done
-
-lemma valid_objs'_maxPriority:
-  "\<And>s t. \<lbrakk> valid_objs' s; tcb_at' t s \<rbrakk> \<Longrightarrow> obj_at' (\<lambda>tcb. tcbPriority tcb \<le> maxPriority) t s"
-  apply (erule (1) valid_objs_valid_tcbE)
-  apply (clarsimp simp: valid_tcb'_def)
-  done
-
 lemma doMachineOp_irq_states':
   assumes masks: "\<And>P. \<lbrace>\<lambda>s. P (irq_masks s)\<rbrace> f \<lbrace>\<lambda>_ s. P (irq_masks s)\<rbrace>"
   shows "\<lbrace>valid_irq_states'\<rbrace> doMachineOp f \<lbrace>\<lambda>rv. valid_irq_states'\<rbrace>"
@@ -257,67 +212,217 @@ 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 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':
+  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"
+  using assms
+  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)
+  done
+
+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
+  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 objBits_simps')
+  done
+
+definition valid_tcbs' :: "kernel_state \<Rightarrow> bool" where
+  "valid_tcbs' s' \<equiv> \<forall>ptr tcb. ksPSpace s' ptr = Some (KOTCB tcb) \<longrightarrow> valid_tcb' tcb s'"
+
+lemma valid_objs'_valid_tcbs'[elim!]:
+  "valid_objs' s \<Longrightarrow> valid_tcbs' s"
+  by (auto simp: valid_objs'_def valid_tcbs'_def valid_obj'_def split: kernel_object.splits)
+
+lemma invs'_valid_tcbs'[elim!]:
+  "invs' s \<Longrightarrow> valid_tcbs' s"
+  by (fastforce del: valid_objs'_valid_tcbs' intro: valid_objs'_valid_tcbs')
+
+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"
+  by (clarsimp simp: valid_tcbs'_def obj_at'_def valid_tcb'_def projectKOs)
+
+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"
+  by (clarsimp simp: valid_tcbs'_def obj_at'_def valid_tcb'_def projectKOs)
+
+lemmas valid_objs'_maxPriority = valid_tcbs'_maxPriority[OF valid_objs'_valid_tcbs']
+
+lemma valid_tcbs'_obj_at':
+  assumes "valid_tcbs' 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"
+  using assms
+  apply (clarsimp simp add: valid_tcbs'_def ran_def typ_at'_def projectKOs
+                            ko_wp_at'_def valid_obj'_def valid_tcb'_def obj_at'_def)
+  done
+
+lemma update_valid_tcb'[simp]:
+  "\<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"
+  "\<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_valid_tcbs'[simp]:
+  "\<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 setObject_update_TCB_corres':
-  assumes tcbs: "tcb_relation tcb tcb' \<Longrightarrow> tcb_relation tcbu tcbu'"
-  assumes tables: "\<forall>(getF, v) \<in> ran tcb_cap_cases. getF tcbu = getF tcb"
-  assumes tables': "\<forall>(getF, v) \<in> ran tcb_cte_cases. getF tcbu' = getF tcb'"
+  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"
+  assumes tables': "\<forall>(getF, v) \<in> ran tcb_cte_cases. getF new_tcb' = getF tcb'"
+  assumes sched_pointers: "tcbSchedPrev new_tcb' = tcbSchedPrev tcb'"
+                          "tcbSchedNext new_tcb' = tcbSchedNext tcb'"
+  assumes flag: "tcbQueued new_tcb' = tcbQueued tcb'"
   assumes r: "r () ()"
-  assumes exst: "exst_same tcb' tcbu'"
-  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' \<and> exst_same tcb' tcbu'" 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 exst)
-  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)
+   apply (clarsimp simp: projectKOs tcb_relation_cut_def exst)
+  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
+                  split: option.splits)
+   apply (metis (no_types, lifting) tcb_of'_TCB)
+  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 () (); exst_same tcb' tcbu'\<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 fastforce
-  apply (clarsimp simp: getObject_def in_monad split_def obj_at'_def
-                        loadObject_default_def projectKOs objBits_simps'
-                        in_magnitude_check)
+    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:
-  "corres tcb_relation (tcb_at t) (tcb_at' t)
+  "corres tcb_relation (tcb_at t and pspace_aligned and pspace_distinct) \<top>
           (gets_the (get_tcb t)) (getObject t)"
+  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 (rule corres_gets_the)
     apply (rule corres_get_tcb)
    apply (simp add: tcb_at_def)
-  apply assumption
+  apply simp
   done
 
 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)"
+  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
@@ -339,7 +444,8 @@ lemma ball_tcb_cte_casesI:
   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. P (Thread a b c d e f g h i j k l m n p q) \<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:
@@ -348,18 +454,23 @@ 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"
+  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)
-                        (tcb_at' t)
-                    (thread_set f t) (threadSet f' t)"
+  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 (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+
@@ -372,26 +483,19 @@ 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
-                        X64_A.arch_kernel_obj.split_asm)+
-  done
+lemmas pspace_relation_tcb_at = tcb_at'_cross
 
 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"
+  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 \<top> (tcb_at' t)
-                           (return v) (threadSet fn t)"
+  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)
@@ -407,19 +511,15 @@ proof -
        defer
        apply (subst bind_return [symmetric],
               rule corres_underlying_split [OF threadset_corresT])
-             apply (simp add: x)
-            apply simp
-           apply (rule y)
+                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 wp+
-      apply simp
-      apply (erule pspace_relation_tcb_at[rotated])
-      apply clarsimp
-     apply simp
-    apply simp
+          apply wpsimp+
     done
 qed
 
@@ -433,14 +533,20 @@ 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>"
+  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 P (tcb_at' t and P')
-                           m (threadSet fn t >>= (\<lambda>rv. m'))"
+  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)+
@@ -674,16 +780,23 @@ lemma threadSet_valid_pspace'T_P:
   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 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)\<rbrace>
-     threadSet F t
-   \<lbrace>\<lambda>rv. valid_pspace'\<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>_. valid_pspace'\<rbrace>"
   apply (simp add: valid_pspace'_def threadSet_def)
   apply (rule hoare_pre,
          wp setObject_tcb_valid_objs getObject_tcb_wp)
@@ -691,7 +804,7 @@ lemma threadSet_valid_pspace'T_P:
   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 v w')
+                            split_paired_Ball y u w v w' p n)
   done
 
 lemmas threadSet_valid_pspace'T =
@@ -765,6 +878,10 @@ lemma threadSet_iflive'T:
               \<and> tcbState (F tcb) \<noteq> Inactive
               \<and> tcbState (F tcb) \<noteq> IdleThreadState
               \<and> ko_at' tcb t s) \<longrightarrow> ex_nonz_cap_to' t s)
+      \<and> ((\<exists>tcb. tcbSchedNext tcb = None \<and> tcbSchedNext (F tcb) \<noteq> None
+              \<and> ko_at' tcb t s) \<longrightarrow> ex_nonz_cap_to' t s)
+      \<and> ((\<exists>tcb. tcbSchedPrev tcb = None \<and> tcbSchedPrev (F tcb) \<noteq> None
+              \<and> ko_at' tcb t s) \<longrightarrow> ex_nonz_cap_to' t s)
       \<and> ((\<exists>tcb. \<not> tcbQueued tcb \<and> tcbQueued (F tcb)
               \<and> ko_at' tcb t s) \<longrightarrow> ex_nonz_cap_to' t s)\<rbrace>
      threadSet F t
@@ -772,8 +889,7 @@ lemma threadSet_iflive'T:
   apply (simp add: threadSet_def)
   apply (wp setObject_tcb_iflive' getObject_tcb_wp)
   apply (clarsimp simp: obj_at'_def projectKOs)
-  apply (subst conj_assoc[symmetric], subst imp_disjL[symmetric])
-  apply (subst conj_assoc[symmetric], subst imp_disjL[symmetric])
+  apply (subst conj_assoc[symmetric], subst imp_disjL[symmetric])+
   apply (rule conjI)
    apply (rule impI, clarsimp)
    apply (erule if_live_then_nonz_capE')
@@ -819,6 +935,12 @@ lemmas threadSet_ctes_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)
+  \<Longrightarrow> threadSet f tptr \<lbrace>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 objBits_simps')
+
 lemma threadSet_idle'T:
   assumes x: "\<forall>tcb. \<forall>(getF, setF) \<in> ran tcb_cte_cases. getF (F tcb) = getF tcb"
   shows
@@ -857,30 +979,6 @@ lemma set_tcb_bitmapQ_no_L2_orphans[wp]:
   apply (wp hoare_Ball_helper hoare_vcg_all_lift updateObject_default_inv | simp add: bitmapQ_def)+
   done
 
-lemma threadSet_valid_queues_no_bitmap:
-  "\<lbrace> valid_queues_no_bitmap and
-    (\<lambda>s. \<forall>d p. (\<exists>tcb. (inQ d p tcb \<and> runnable' (tcbState tcb)) \<and>
-                     \<not>(inQ d p (f tcb) \<and> runnable' (tcbState (f tcb))))
-                \<longrightarrow> obj_at' (\<lambda>tcb. (inQ d p tcb \<and> runnable' (tcbState tcb)) \<and>
-                                 \<not>(inQ d p (f tcb) \<and> runnable' (tcbState (f tcb)))) t s
-                \<longrightarrow> t \<notin> set (ksReadyQueues s (d, p))
-    )\<rbrace>
-     threadSet f t
-   \<lbrace>\<lambda>rv. valid_queues_no_bitmap \<rbrace>"
-  apply (simp add: threadSet_def)
-  apply wp
-   apply (simp add: Invariants_H.valid_queues_no_bitmap_def' pred_tcb_at'_def)
-
-   apply (wp setObject_queues_unchanged_tcb
-             hoare_Ball_helper
-             hoare_vcg_all_lift
-             setObject_tcb_strongest)[1]
-  apply (wp getObject_tcb_wp)
-  apply (clarsimp simp: valid_queues_no_bitmap_def' pred_tcb_at'_def)
-  apply (clarsimp simp: obj_at'_def projectKOs)
-  apply (fastforce)
-  done
-
 lemma threadSet_valid_bitmapQ[wp]:
   "\<lbrace> valid_bitmapQ \<rbrace> threadSet f t \<lbrace> \<lambda>rv. valid_bitmapQ \<rbrace>"
   unfolding bitmapQ_defs threadSet_def
@@ -899,73 +997,6 @@ lemma threadSet_valid_bitmapQ_no_L2_orphans[wp]:
   by (clarsimp simp: setObject_def split_def)
      (wp | simp add: updateObject_default_def)+
 
-lemma threadSet_valid_queues:
-  "\<lbrace>Invariants_H.valid_queues and
-    (\<lambda>s. \<forall>d p. (\<exists>tcb. (inQ d p tcb \<and> runnable' (tcbState tcb)) \<and>
-                     \<not>(inQ d p (f tcb) \<and> runnable' (tcbState (f tcb))))
-                \<longrightarrow> obj_at' (\<lambda>tcb. (inQ d p tcb \<and> runnable' (tcbState tcb)) \<and>
-                                 \<not>(inQ d p (f tcb) \<and> runnable' (tcbState (f tcb)))) t s
-                \<longrightarrow> t \<notin> set (ksReadyQueues s (d, p))
-    )\<rbrace>
-     threadSet f t
-   \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  unfolding valid_queues_def
-  by (wp threadSet_valid_queues_no_bitmap;simp)
-
-definition
-  addToQs :: "(Structures_H.tcb \<Rightarrow> Structures_H.tcb)
-                       \<Rightarrow> machine_word \<Rightarrow> (domain \<times> priority \<Rightarrow> machine_word list)
-                       \<Rightarrow> (domain \<times> priority \<Rightarrow> machine_word list)"
-where
- "addToQs F t \<equiv> \<lambda>qs (qdom, prio). if (\<forall>ko. \<not> inQ qdom prio (F ko))
-                             then t # qs (qdom, prio)
-                             else qs (qdom, prio)"
-
-lemma addToQs_set_def:
-  "(t' \<in> set (addToQs F t qs (qdom, prio))) = (t' \<in> set (qs (qdom, prio))
-      \<or> (t' = t \<and> (\<forall>ko. \<not> inQ qdom prio (F ko))))"
-  by (auto simp add: addToQs_def)
-
-lemma threadSet_valid_queues_addToQs:
-  "\<lbrace>\<lambda>s. (\<forall>ko qdom prio. ko_at' ko t s \<and> inQ qdom prio (F ko) \<and> \<not> inQ qdom prio ko
-            \<longrightarrow> t \<in> set (ksReadyQueues s (qdom, prio)))
-             \<and> valid_queues' (ksReadyQueues_update (addToQs F t) s)\<rbrace>
-     threadSet F t
-   \<lbrace>\<lambda>rv. 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_set_def
-             split del: if_split cong: if_cong)
-  apply (fastforce simp: projectKOs split: if_split_asm)
-  done
-
-lemma threadSet_valid_queues_Qf:
-  "\<lbrace>\<lambda>s. (\<forall>ko qdom prio. ko_at' ko t s \<and> inQ qdom prio (F ko) \<and> \<not> inQ qdom prio ko
-            \<longrightarrow> t \<in> set (ksReadyQueues s (qdom, prio)))
-             \<and> valid_queues' (ksReadyQueues_update Qf s)
-             \<and> (\<forall>prio. set (Qf (ksReadyQueues s) prio)
-                        \<subseteq> set (addToQs F t (ksReadyQueues s) prio))\<rbrace>
-     threadSet F t
-   \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (wp threadSet_valid_queues_addToQs)
-  apply (clarsimp simp: valid_queues'_def subset_iff)
-  done
-
-lemma addToQs_subset:
-  "set (qs p) \<subseteq> set (addToQs F t qs p)"
-by (clarsimp simp: addToQs_def split_def)
-
-lemmas threadSet_valid_queues'
-  = threadSet_valid_queues_Qf
-       [where Qf=id, simplified ksReadyQueues_update_id
-                                id_apply addToQs_subset simp_thms]
-
 lemma threadSet_cur:
   "\<lbrace>\<lambda>s. cur_tcb' s\<rbrace> threadSet f t \<lbrace>\<lambda>rv s. cur_tcb' s\<rbrace>"
   apply (simp add: threadSet_def cur_tcb'_def)
@@ -981,7 +1012,7 @@ lemma modifyReadyQueuesL1Bitmap_obj_at[wp]:
 
 crunches setThreadState, setBoundNotification
   for valid_arch' [wp]: valid_arch_state'
-  (simp: unless_def crunch_simps)
+  (simp: unless_def crunch_simps wp: crunch_wps)
 
 crunch ksInterrupt'[wp]: threadSet "\<lambda>s. P (ksInterruptState s)"
   (wp: setObject_ksInterrupt updateObject_default_inv)
@@ -1237,57 +1268,103 @@ lemma threadSet_valid_dom_schedule':
   unfolding threadSet_def
   by (wp setObject_ksDomSchedule_inv hoare_Ball_helper)
 
+lemma threadSet_wp:
+  "\<lbrace>\<lambda>s. \<forall>tcb. ko_at' tcb t s \<longrightarrow> P (s\<lparr>ksPSpace := (ksPSpace s)(t \<mapsto> injectKO (f tcb))\<rparr>)\<rbrace>
+   threadSet f t
+   \<lbrace>\<lambda>_. P\<rbrace>"
+  unfolding threadSet_def setObject_def
+  apply (wpsimp wp: getObject_tcb_wp simp: updateObject_default_def)
+  apply (auto simp: obj_at'_def split: if_splits)
+  apply (erule rsubst[where P=P])
+  apply (clarsimp simp: fun_upd_def)
+  apply (prop_tac "\<forall>ptr. psMap (ksPSpace s) ptr = ksPSpace s ptr")
+   apply fastforce
+  apply metis
+  done
+
+lemma threadSet_sched_pointers:
+  "\<lbrakk>\<And>tcb. tcbSchedNext (F tcb) = tcbSchedNext tcb; \<And>tcb. tcbSchedPrev (F tcb) = tcbSchedPrev tcb\<rbrakk>
+   \<Longrightarrow> threadSet F tcbPtr \<lbrace>\<lambda>s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)\<rbrace>"
+  apply (wpsimp wp: threadSet_wp getObject_tcb_wp)
+  apply (erule rsubst2[where P=P])
+   apply (fastforce simp: opt_map_def obj_at'_def projectKOs)
+  apply (fastforce simp: opt_map_def obj_at'_def projectKOs)
+  done
+
+lemma threadSet_valid_sched_pointers:
+  "\<lbrakk>\<And>tcb. tcbSchedNext (F tcb) = tcbSchedNext tcb; \<And>tcb. tcbSchedPrev (F tcb) = tcbSchedPrev tcb;
+    \<And>tcb. tcbQueued (F tcb) = tcbQueued tcb\<rbrakk>
+   \<Longrightarrow> threadSet F tcbPtr \<lbrace>valid_sched_pointers\<rbrace>"
+  unfolding valid_sched_pointers_def
+  apply (wpsimp wp: threadSet_wp getObject_tcb_wp)
+  by (fastforce simp: opt_pred_def opt_map_def obj_at'_def projectKOs split: option.splits if_splits)
+
+lemma threadSet_tcbSchedNexts_of:
+  "(\<And>tcb. tcbSchedNext (F tcb) = tcbSchedNext tcb) \<Longrightarrow>
+   threadSet F t \<lbrace>\<lambda>s. P (tcbSchedNexts_of s)\<rbrace>"
+  apply (wpsimp wp: threadSet_wp getObject_tcb_wp)
+  apply (erule rsubst[where P=P])
+  apply (fastforce simp: opt_map_def obj_at'_def projectKOs)
+  done
+
+lemma threadSet_tcbSchedPrevs_of:
+  "(\<And>tcb. tcbSchedPrev (F tcb) = tcbSchedPrev tcb) \<Longrightarrow>
+   threadSet F t \<lbrace>\<lambda>s. P (tcbSchedPrevs_of s)\<rbrace>"
+  apply (wpsimp wp: threadSet_wp getObject_tcb_wp)
+  apply (erule rsubst[where P=P])
+  apply (fastforce simp: opt_map_def obj_at'_def projectKOs)
+  done
+
+lemma threadSet_tcbQueued:
+  "(\<And>tcb. tcbQueued (F tcb) = tcbQueued tcb) \<Longrightarrow>
+   threadSet F t \<lbrace>\<lambda>s. P (tcbQueued |< tcbs_of' s)\<rbrace>"
+  apply (wpsimp wp: threadSet_wp getObject_tcb_wp)
+  apply (erule rsubst[where P=P])
+  apply (fastforce simp: opt_pred_def opt_map_def obj_at'_def projectKOs)
+  done
+
+crunches threadSet
+  for ksReadyQueues[wp]: "\<lambda>s. P (ksReadyQueues s)"
+  and ksReadyQueuesL1Bitmap[wp]: "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
+  and ksReadyQueuesL2Bitmap[wp]: "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
+
 lemma threadSet_invs_trivialT:
-  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 \<and> tcbDomain (F tcb) = tcbDomain tcb"
-  assumes w: "\<forall>tcb. is_aligned (tcbIPCBuffer tcb) msg_align_bits \<longrightarrow> is_aligned (tcbIPCBuffer (F tcb)) msg_align_bits"
-  assumes a: "\<forall>tcb. tcbBoundNotification (F tcb) = tcbBoundNotification tcb"
-  assumes w: "\<forall>tcb. is_aligned (tcbIPCBuffer tcb) msg_align_bits \<longrightarrow> is_aligned (tcbIPCBuffer (F tcb)) msg_align_bits"
-  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"
-  shows
-  "\<lbrace>\<lambda>s. invs' s \<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. \<not> tcbQueued tcb \<and> tcbQueued (F tcb)) \<longrightarrow> ex_nonz_cap_to' t s \<and> t \<noteq> ksCurThread s) \<and>
-       (\<forall>tcb. tcbQueued (F tcb) \<and> ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> tcbQueued tcb \<or> t \<noteq> ksCurThread s)\<rbrace>
-   threadSet F t
-   \<lbrace>\<lambda>rv. invs'\<rbrace>"
-proof -
-  from z have domains: "\<And>tcb. tcbDomain (F tcb) = tcbDomain tcb" by blast
-  note threadSet_sch_actT_P[where P=False, simplified]
-  have y: "\<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 valid_state'_def split del: if_split)
-    apply (rule hoare_pre)
-     apply (wp x w v u b
-              threadSet_valid_pspace'T
-              threadSet_sch_actT_P[where P=False, simplified]
-              threadSet_valid_queues
-              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'' valid_ioports_lift''
-              threadSet_ctes_ofT
-              threadSet_not_inQ
-              threadSet_ct_idle_or_in_cur_domain'
-              threadSet_valid_dom_schedule'
-              threadSet_valid_queues'
-              threadSet_cur
-              untyped_ranges_zero_lift
-           |clarsimp simp: y z a domains cteCaps_of_def |rule refl)+
-   apply (clarsimp simp: obj_at'_def projectKOs pred_tcb_at'_def)
-   apply (clarsimp simp: cur_tcb'_def valid_irq_node'_def valid_queues'_def o_def)
-   by (fastforce simp: domains ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def z a)
-qed
+  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. is_aligned (tcbIPCBuffer tcb) msg_align_bits
+           \<longrightarrow> is_aligned (tcbIPCBuffer (F tcb)) msg_align_bits"
+    "\<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. tcbMCP tcb \<le> maxPriority \<longrightarrow> tcbMCP (F tcb) \<le> maxPriority"
+  shows "threadSet F t \<lbrace>invs'\<rbrace>"
+  apply (simp add: invs'_def valid_state'_def split del: if_split)
+  apply (wp threadSet_valid_pspace'T
+            threadSet_sch_actT_P[where P=False, simplified]
+            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'' valid_ioports_lift''
+            threadSet_ctes_ofT
+            threadSet_not_inQ
+            threadSet_ct_idle_or_in_cur_domain'
+            threadSet_valid_dom_schedule'
+            threadSet_cur
+            untyped_ranges_zero_lift
+            sym_heap_sched_pointers_lift threadSet_valid_sched_pointers
+            threadSet_tcbQueued
+            threadSet_tcbSchedPrevs_of threadSet_tcbSchedNexts_of valid_bitmaps_lift
+         | clarsimp simp: assms cteCaps_of_def | rule refl)+
+  apply (clarsimp simp: o_def)
+  by (auto simp: assms obj_at'_def)
 
 lemmas threadSet_invs_trivial =
     threadSet_invs_trivialT [OF all_tcbI all_tcbI all_tcbI all_tcbI, OF ball_tcb_cte_casesI]
@@ -1327,10 +1404,73 @@ lemma threadSet_valid_objs':
   apply (clarsimp elim!: obj_at'_weakenE)
   done
 
+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']
+
+lemma setObject_valid_tcbs':
+  assumes preserve_valid_tcb': "\<And>s s' ko ko' x n tcb tcb'.
+            \<lbrakk> (ko', s') \<in> fst (updateObject val ko ptr x n s); P s;
+              lookupAround2 ptr (ksPSpace s) = (Some (x, ko), n);
+              projectKO_opt ko = Some tcb; projectKO_opt ko' = Some tcb';
+              valid_tcb' tcb s \<rbrakk> \<Longrightarrow> valid_tcb' tcb' s"
+  shows "\<lbrace>valid_tcbs' and P\<rbrace> setObject ptr val \<lbrace>\<lambda>rv. valid_tcbs'\<rbrace>"
+  unfolding valid_tcbs'_def
+  apply (clarsimp simp: valid_def)
+  apply (rename_tac s s' ptr' tcb)
+  apply (prop_tac "\<forall>tcb'. valid_tcb' tcb s \<longrightarrow> valid_tcb' tcb s'")
+   apply clarsimp
+   apply (erule (1) use_valid[OF _ setObject_valid_tcb'])
+  apply (drule spec, erule mp)
+  apply (clarsimp simp: setObject_def in_monad split_def lookupAround2_char1)
+  apply (rename_tac s ptr' new_tcb' ptr'' old_tcb_ko' s' f)
+  apply (case_tac "ptr'' = ptr'"; clarsimp)
+  apply (prop_tac "\<exists>old_tcb' :: tcb. projectKO_opt old_tcb_ko' = Some old_tcb'")
+   apply (frule updateObject_type)
+   apply (case_tac old_tcb_ko'; clarsimp simp: project_inject)
+  apply (erule exE)
+  apply (rule preserve_valid_tcb', assumption+)
+     apply (simp add: prod_eqI lookupAround2_char1)
+    apply force
+   apply (clarsimp simp: project_inject)
+  apply (clarsimp simp: project_inject)
+  done
+
+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 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>_. valid_tcb' tcb\<rbrace>"
+  apply (simp add: threadSet_def)
+  apply (wpsimp wp: setObject_valid_tcb')
+  done
+
+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>_. valid_tcbs'\<rbrace>"
+  apply (simp add: threadSet_def)
+  apply (rule hoare_seq_ext[OF _ getObject_tcb_sp])
+  apply (wpsimp wp: setObject_tcb_valid_tcbs')
+  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 objBits_simps')
+  done
+
 lemma asUser_corres':
   assumes y: "corres_underlying Id False True r \<top> \<top> f g"
-  shows      "corres r (tcb_at t)
-                       (tcb_at' t)
+  shows      "corres r (tcb_at t and pspace_aligned and pspace_distinct) \<top>
                        (as_user t f) (asUser t g)"
   proof -
   note arch_tcb_context_get_def[simp]
@@ -1338,7 +1478,7 @@ lemma asUser_corres':
   note arch_tcb_context_set_def[simp]
   note atcbContextSet_def[simp]
   have L1: "corres (\<lambda>tcb con. (arch_tcb_context_get o tcb_arch) tcb = con)
-             (tcb_at t) (tcb_at' t)
+             (tcb_at t and pspace_aligned and pspace_distinct) \<top>
              (gets_the (get_tcb t)) (threadGet (atcbContextGet o tcbArch) t)"
     apply (rule corres_guard_imp)
       apply (rule corres_gets_the)
@@ -1364,6 +1504,8 @@ lemma asUser_corres':
     using y
     by (fastforce simp: corres_underlying_def select_f_def split_def Id_def)
   show ?thesis
+  apply (rule corres_cross_over_guard[where Q="tcb_at' t"])
+   apply (fastforce elim: tcb_at_cross)
   apply (simp add: as_user_def asUser_def)
   apply (rule corres_guard_imp)
     apply (rule_tac r'="\<lambda>tcb con. (arch_tcb_context_get o tcb_arch) tcb = con"
@@ -1387,7 +1529,7 @@ qed
 
 lemma asUser_corres:
   assumes y: "corres_underlying Id False True r \<top> \<top> f g"
-  shows      "corres r (tcb_at t and invs) (tcb_at' t and invs') (as_user t f) (asUser t g)"
+  shows      "corres r (tcb_at t and invs) invs' (as_user t f) (asUser t g)"
   apply (rule corres_guard_imp)
     apply (rule asUser_corres' [OF y])
    apply (simp add: invs_def valid_state_def valid_pspace_def)
@@ -1415,17 +1557,15 @@ proof -
 qed
 
 lemma asUser_getRegister_corres:
- "corres (=) (tcb_at t) (tcb_at' t)
-        (as_user t (getRegister r)) (asUser t (getRegister r))"
+  "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+          (as_user t (getRegister r)) (asUser t (getRegister r))"
   apply (rule asUser_corres')
   apply (clarsimp simp: getRegister_def)
   done
 
 lemma user_getreg_inv'[wp]:
   "\<lbrace>P\<rbrace> asUser t (getRegister r) \<lbrace>\<lambda>x. P\<rbrace>"
-  apply (rule asUser_inv)
-   apply (simp_all add: getRegister_def)
-  done
+  by (wp asUser_inv)
 
 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>"
@@ -1437,7 +1577,6 @@ 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 (wp hoare_drop_imps | simp)+
-
   apply (wp threadSet_invs_trivial hoare_drop_imps | simp)+
   done
 
@@ -1465,14 +1604,6 @@ lemma asUser_valid_pspace'[wp]:
   apply (wp threadSet_valid_pspace' hoare_drop_imps | simp)+
   done
 
-lemma asUser_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> asUser t m \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: asUser_def split_def)
-  apply (wp hoare_drop_imps | simp)+
-
-  apply (wp threadSet_valid_queues hoare_drop_imps | simp)+
-  done
-
 lemma asUser_ifunsafe'[wp]:
   "\<lbrace>if_unsafe_then_cap'\<rbrace> asUser t m \<lbrace>\<lambda>rv. if_unsafe_then_cap'\<rbrace>"
   apply (simp add: asUser_def split_def)
@@ -1564,8 +1695,8 @@ lemma no_fail_asUser [wp]:
   done
 
 lemma asUser_setRegister_corres:
-  "corres dc (tcb_at t)
-             (tcb_at' t)
+  "corres dc (tcb_at t and pspace_aligned and pspace_distinct)
+             \<top>
              (as_user t (setRegister r v))
              (asUser t (setRegister r v))"
   apply (simp add: setRegister_def)
@@ -1574,7 +1705,7 @@ lemma asUser_setRegister_corres:
   done
 
 lemma getThreadState_corres:
-  "corres thread_state_relation (tcb_at t) (tcb_at' t)
+  "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)
@@ -1605,7 +1736,7 @@ lemma gts_inv'[wp]: "\<lbrace>P\<rbrace> getThreadState t \<lbrace>\<lambda>rv.
   by (simp add: getThreadState_def) wp
 
 lemma getBoundNotification_corres:
-  "corres (=) (tcb_at t) (tcb_at' t)
+  "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
           (get_bound_notification t) (getBoundNotification t)"
   apply (simp add: get_bound_notification_def getBoundNotification_def)
   apply (rule threadGet_corres)
@@ -1750,19 +1881,22 @@ lemma ethreadget_corres:
   apply (simp add: x)
   done
 
-lemma setQueue_corres:
-  "corres dc \<top> \<top> (set_tcb_queue d p q) (setQueue d p q)"
-  apply (rule corres_no_failI)
-   apply wp
-  apply (clarsimp simp: setQueue_def in_monad set_tcb_queue_def return_def simpler_modify_def)
-  apply (fastforce simp: state_relation_def ready_queues_relation_def)
-  done
-
-
-lemma getQueue_corres: "corres (=) \<top> \<top> (get_tcb_queue qdom prio) (getQueue qdom prio)"
-  apply (clarsimp simp add: getQueue_def state_relation_def ready_queues_relation_def get_tcb_queue_def gets_def)
-  apply (fold gets_def)
-  apply simp
+lemma getQueue_corres:
+  "corres (\<lambda>ls q. (ls = [] \<longleftrightarrow> tcbQueueEmpty q) \<and> (ls \<noteq> [] \<longrightarrow> tcbQueueHead q = Some (hd ls))
+                  \<and> queue_end_valid ls q)
+     \<top> \<top> (get_tcb_queue qdom prio) (getQueue qdom prio)"
+  apply (clarsimp simp: get_tcb_queue_def getQueue_def tcbQueueEmpty_def)
+  apply (rule corres_bind_return2)
+  apply (rule corres_symb_exec_l[OF _ _ gets_sp])
+    apply (rule corres_symb_exec_r[OF _ gets_sp])
+      apply clarsimp
+      apply (drule state_relation_ready_queues_relation)
+      apply (clarsimp simp: ready_queues_relation_def ready_queue_relation_def Let_def
+                            list_queue_relation_def)
+      apply (drule_tac x=qdom in spec)
+      apply (drule_tac x=prio in spec)
+      apply (fastforce dest: heap_path_head)
+     apply wpsimp+
   done
 
 lemma no_fail_return:
@@ -1777,8 +1911,8 @@ lemma addToBitmap_noop_corres:
      (wp | simp add: state_relation_def | rule no_fail_pre)+
 
 lemma addToBitmap_if_null_noop_corres: (* used this way in Haskell code *)
-  "corres dc \<top> \<top> (return ()) (if null queue then addToBitmap d p else return ())"
-  by (cases "null queue", simp_all add: addToBitmap_noop_corres)
+  "corres dc \<top> \<top> (return ()) (if tcbQueueEmpty queue then addToBitmap d p else return ())"
+  by (cases "tcbQueueHead queue", simp_all add: addToBitmap_noop_corres)
 
 lemma removeFromBitmap_corres_noop:
   "corres dc \<top> \<top> (return ()) (removeFromBitmap tdom prioa)"
@@ -1795,54 +1929,701 @@ crunch typ_at'[wp]: removeFromBitmap "\<lambda>s. P (typ_at' T p s)"
 lemmas addToBitmap_typ_ats [wp] = typ_at_lifts [OF addToBitmap_typ_at']
 lemmas removeFromBitmap_typ_ats [wp] = typ_at_lifts [OF removeFromBitmap_typ_at']
 
+lemma ekheap_relation_tcb_domain_priority:
+  "\<lbrakk>ekheap_relation (ekheap s) (ksPSpace s'); ekheap s t = Some (tcb);
+    ksPSpace s' t = Some (KOTCB tcb')\<rbrakk>
+   \<Longrightarrow> tcbDomain tcb' = tcb_domain tcb \<and> tcbPriority tcb' = tcb_priority tcb"
+  apply (clarsimp simp: ekheap_relation_def)
+  apply (drule_tac x=t in bspec, blast)
+  apply (clarsimp simp: other_obj_relation_def etcb_relation_def)
+  done
+
+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
+
+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
+
+lemma tcbQueued_update_pspace_relation[wp]:
+  fixes s :: det_state
+  shows "threadSet (tcbQueued_update f) tcbPtr \<lbrace>\<lambda>s'. pspace_relation (kheap s) (ksPSpace s')\<rbrace>"
+  by (wpsimp wp: threadSet_pspace_relation simp: tcb_relation_def)
+
+lemma tcbQueued_update_ekheap_relation[wp]:
+  fixes s :: det_state
+  shows
+    "\<lbrace>\<lambda>s'. ekheap_relation (ekheap s) (ksPSpace s') \<and> pspace_relation (kheap s) (ksPSpace s')
+           \<and> valid_etcbs s\<rbrace>
+     threadSet (tcbQueued_update f) tcbPtr
+     \<lbrace>\<lambda>_ s'. ekheap_relation (ekheap s) (ksPSpace s')\<rbrace>"
+  by (wpsimp wp: threadSet_ekheap_relation simp: etcb_relation_def)
+
+lemma tcbQueueRemove_pspace_relation[wp]:
+  fixes s :: det_state
+  shows "tcbQueueRemove queue tcbPtr \<lbrace>\<lambda>s'. pspace_relation (kheap s) (ksPSpace s')\<rbrace>"
+  unfolding tcbQueueRemove_def
+  by (wpsimp wp: threadSet_pspace_relation hoare_drop_imps simp: tcb_relation_def)
+
+lemma tcbQueueRemove_ekheap_relation[wp]:
+  fixes s :: det_state
+  shows
+    "\<lbrace>\<lambda>s'. ekheap_relation (ekheap s) (ksPSpace s') \<and> pspace_relation (kheap s) (ksPSpace s')
+           \<and> valid_etcbs s\<rbrace>
+     tcbQueueRemove queue tcbPtr
+     \<lbrace>\<lambda>_ s'. ekheap_relation (ekheap s) (ksPSpace s')\<rbrace>"
+  unfolding tcbQueueRemove_def
+  by (wpsimp wp: threadSet_ekheap_relation threadSet_pspace_relation hoare_drop_imps
+           simp: tcb_relation_def etcb_relation_def)
+
+lemma threadSet_ghost_relation[wp]:
+  "threadSet f tcbPtr \<lbrace>\<lambda>s'. ghost_relation (kheap s) (gsUserPages s') (gsCNodes s')\<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 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)
+
+crunches 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)
+
+crunches 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
+
+crunches 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)
+
+crunches 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 pspace_canonical'[wp]: pspace_canonical'
+  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 pspace_in_kernel_mappings'[wp]: pspace_in_kernel_mappings'
+  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 ready_queue_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: 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
+
+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>
+   isRunnable tcb_ptr
+   \<lbrace>\<lambda>rv s. \<exists>tcb'. ko_at' tcb' tcb_ptr s
+                  \<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_def)
+  apply (fastforce simp: obj_at'_def split: Structures_H.thread_state.splits)
+  done
+
+crunch (no_fail) no_fail[wp]: isRunnable
+
+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)
+
+crunches 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 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 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_queues_relation_def ready_queue_relation_def Let_def)
+
+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_queues_relation_def ready_queue_relation_def Let_def inQ_def
+                         opt_pred_def
+                  split: option.splits)
+  done
+
 lemma tcbSchedEnqueue_corres:
-  "corres dc (is_etcb_at t) (tcb_at' t and Invariants_H.valid_queues and valid_queues')
-             (tcb_sched_action (tcb_sched_enqueue) t) (tcbSchedEnqueue t)"
-proof -
-  have ready_queues_helper:
-    "\<And>t tcb a b. \<lbrakk> ekheap a t = Some tcb;  obj_at' tcbQueued t b  ;  valid_queues' b  ;
-                   ekheap_relation (ekheap a) (ksPSpace b) \<rbrakk>
-                 \<Longrightarrow> t \<in> set (ksReadyQueues b (tcb_domain tcb, tcb_priority tcb))"
-  unfolding valid_queues'_def
-  by (fastforce dest: ekheap_relation_absD simp: obj_at'_def inQ_def etcb_relation_def projectKO_eq projectKO_tcb)
-
-  show ?thesis unfolding tcbSchedEnqueue_def tcb_sched_action_def
-    apply (rule corres_symb_exec_r [OF _ _ threadGet_inv,
-             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 (rule no_fail_pre, wp, blast)
-    apply (case_tac queued; simp_all)
-     apply (rule corres_no_failI; simp add: no_fail_return)
-     apply (clarsimp simp: in_monad ethread_get_def gets_the_def bind_assoc
-                           assert_opt_def exec_gets is_etcb_at_def get_etcb_def get_tcb_queue_def
-                           set_tcb_queue_def simpler_modify_def ready_queues_relation_def
-                           state_relation_def tcb_sched_enqueue_def)
-     apply (rule ready_queues_helper; auto)
-    apply (clarsimp simp: when_def)
-    apply (rule stronger_corres_guard_imp)
-      apply (rule corres_split[where r'="(=)"])
-         apply (rule ethreadget_corres)
-         apply (simp add: etcb_relation_def)
-        apply (rule corres_split[where r'="(=)"])
-           apply (rule ethreadget_corres)
-           apply (simp add: etcb_relation_def)
-          apply (rule corres_split[where r'="(=)"])
-             apply simp
-             apply (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
-               apply (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 exst_same_def)
-               apply (wp getObject_tcb_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
+  "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)?)
+
+  \<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)
+
+  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)
+    apply (metis inQ_def option.simps(5) tcb_of'_TCB projectKO_eq)
+   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 fun_upd_apply projectKOs
+                     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 projectKOs)
+   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
+               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 fun_upd_apply split: if_splits)
+   apply (clarsimp simp: fun_upd_apply 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 projectKOs
+           split: if_splits option.splits)
 
 definition
   weak_sch_act_wf :: "scheduler_action \<Rightarrow> kernel_state \<Rightarrow> bool"
@@ -1869,7 +2650,11 @@ lemma getSchedulerAction_corres:
   done
 
 lemma rescheduleRequired_corres:
-  "corres dc (weak_valid_sched_action and valid_etcbs) (Invariants_H.valid_queues and valid_queues' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s))
+  "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'
+      and pspace_aligned' and pspace_distinct')
      (reschedule_required) rescheduleRequired"
   apply (simp add: rescheduleRequired_def reschedule_required_def)
   apply (rule corres_guard_imp)
@@ -1880,7 +2665,7 @@ lemma rescheduleRequired_corres:
          apply (case_tac action)
            apply simp
           apply simp
-          apply (rule tcbSchedEnqueue_corres)
+          apply (rule tcbSchedEnqueue_corres, simp)
          apply simp
         apply (rule setSchedulerAction_corres)
         apply simp
@@ -1956,20 +2741,13 @@ lemmas addToBitmap_weak_sch_act_wf[wp]
   = weak_sch_act_wf_lift[OF addToBitmap_nosch]
 
 crunch st_tcb_at'[wp]: removeFromBitmap "st_tcb_at' P t"
-crunch pred_tcb_at'[wp]: removeFromBitmap "pred_tcb_at' proj P t"
+crunch pred_tcb_at'[wp]: removeFromBitmap "\<lambda>s. Q (pred_tcb_at' proj P t s)"
 
-crunch not_st_tcb_at'[wp]: removeFromBitmap "\<lambda>s. \<not> (st_tcb_at' P' t) s"
-crunch not_pred_tcb_at'[wp]: removeFromBitmap "\<lambda>s. \<not> (pred_tcb_at' proj P' t) s"
+crunch pred_tcb_at'[wp]: addToBitmap "\<lambda>s. Q (pred_tcb_at' proj P t s)"
 
-crunch st_tcb_at'[wp]: addToBitmap "st_tcb_at' P' t"
-crunch pred_tcb_at'[wp]: addToBitmap "pred_tcb_at' proj P' t"
+crunch obj_at'[wp]: removeFromBitmap "\<lambda>s. Q (obj_at' P t s)"
 
-crunch not_st_tcb_at'[wp]: addToBitmap "\<lambda>s. \<not> (st_tcb_at' P' t) s"
-crunch not_pred_tcb_at'[wp]: addToBitmap "\<lambda>s. \<not> (pred_tcb_at' proj P' t) s"
-
-crunch obj_at'[wp]: removeFromBitmap "obj_at' P t"
-
-crunch obj_at'[wp]: addToBitmap "obj_at' P t"
+crunch obj_at'[wp]: addToBitmap "\<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>"
@@ -1986,9 +2764,11 @@ lemma addToBitmap_tcb_in_cur_domain'[wp]:
   done
 
 lemma tcbSchedDequeue_weak_sch_act_wf[wp]:
-  "\<lbrace> \<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s \<rbrace> tcbSchedDequeue a \<lbrace> \<lambda>_ s. weak_sch_act_wf (ksSchedulerAction s) s \<rbrace>"
-  apply (simp add: tcbSchedDequeue_def)
-  apply (wp threadSet_weak_sch_act_wf removeFromBitmap_weak_sch_act_wf | simp add: crunch_simps)+
+  "tcbSchedDequeue tcbPtr \<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
+  apply (simp add: tcbSchedDequeue_def tcbQueueRemove_def)
+  apply (wp threadSet_weak_sch_act_wf getObject_tcb_wp removeFromBitmap_weak_sch_act_wf
+         | simp add: crunch_simps threadGet_def)+
+  apply (clarsimp simp: obj_at'_def)
   done
 
 lemma dequeue_nothing_eq[simp]:
@@ -2004,44 +2784,343 @@ lemma gets_the_exec: "f s \<noteq> None \<Longrightarrow>  (do x \<leftarrow> ge
                    return_def assert_opt_def)
   done
 
-lemma tcbSchedDequeue_corres:
-  "corres dc (is_etcb_at t) (tcb_at' t and Invariants_H.valid_queues)
-             (tcb_sched_action tcb_sched_dequeue t) (tcbSchedDequeue t)"
-  apply (simp only: tcbSchedDequeue_def tcb_sched_action_def)
-  apply (rule corres_symb_exec_r[OF _ _ threadGet_inv, where Q'="\<lambda>rv. tcb_at' t and Invariants_H.valid_queues and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"])
-    defer
-    apply (wp threadGet_obj_at', simp, simp)
-   apply (rule no_fail_pre, wp, simp)
-  apply (case_tac queued)
-   defer
-   apply (simp add: when_def)
-   apply (rule corres_no_failI)
-    apply (wp)
-   apply (clarsimp simp: in_monad ethread_get_def set_tcb_queue_def is_etcb_at_def state_relation_def)
-   apply (subgoal_tac "t \<notin> set (ready_queues a (tcb_domain y) (tcb_priority y))")
-    prefer 2
-    subgoal by (force simp: tcb_sched_dequeue_def Invariants_H.valid_queues_def valid_queues_no_bitmap_def
-                            ready_queues_relation_def obj_at'_def inQ_def projectKO_eq project_inject)
-   apply (subst gets_the_exec)
-    apply (simp add: get_etcb_def)
-   apply (subst gets_the_exec)
-    apply (simp add: get_etcb_def)
-   apply (simp add: exec_gets simpler_modify_def get_etcb_def ready_queues_relation_def cong: if_cong get_tcb_queue_def)
-  apply (simp add: when_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[where r'="(=)"])
-       apply (rule ethreadget_corres, simp add: etcb_relation_def)
-      apply (rule corres_split[where r'="(=)"])
-         apply (rule ethreadget_corres, simp add: etcb_relation_def)
-        apply (rule corres_split[where r'="(=)"])
-           apply (simp, rule getQueue_corres)
-          apply (rule corres_split_noop_rhs2)
-             apply (simp add: tcb_sched_dequeue_def)
-             apply (rule setQueue_corres)
-            apply (rule corres_split_noop_rhs)
-              apply (clarsimp, rule removeFromBitmap_corres_noop)
-             apply (rule threadSet_corres_noop; simp_all add: tcb_relation_def exst_same_def)
-            apply (wp | simp)+
+lemma tcbQueueRemove_no_fail:
+  "no_fail (\<lambda>s. tcb_at' tcbPtr s
+                \<and> (\<exists>ts. list_queue_relation ts queue (tcbSchedNexts_of s) (tcbSchedPrevs_of s)
+                        \<and> tcbPtr \<in> set ts)
+                \<and> sym_heap_sched_pointers s \<and> valid_objs' s)
+           (tcbQueueRemove queue tcbPtr)"
+  unfolding tcbQueueRemove_def
+  apply (wpsimp wp: getObject_tcb_wp)
+  apply normalise_obj_at'
+  apply (frule (1) ko_at_valid_objs')
+   apply (fastforce simp: projectKOs)
+  apply (clarsimp simp: list_queue_relation_def)
+  apply (prop_tac "tcbQueueHead queue \<noteq> Some tcbPtr \<longrightarrow> tcbSchedPrevs_of s tcbPtr \<noteq> None")
+   apply (rule impI)
+   apply (frule not_head_prev_not_None[where p=tcbPtr])
+      apply (fastforce simp: inQ_def opt_pred_def opt_map_def obj_at'_def)
+     apply (fastforce dest: heap_path_head)
+    apply fastforce
+   apply (fastforce simp: opt_map_def obj_at'_def valid_tcb'_def valid_bound_tcb'_def)
+  by (fastforce dest!: not_last_next_not_None[where p=tcbPtr]
+                 simp: queue_end_valid_def opt_map_def obj_at'_def valid_obj'_def valid_tcb'_def
+                       projectKOs)
+
+crunch (no_fail) no_fail[wp]: removeFromBitmap
+
+crunches removeFromBitmap
+  for ready_queues_relation[wp]: "ready_queues_relation s"
+  and list_queue_relation[wp]:
+   "\<lambda>s'. list_queue_relation ts (P (ksReadyQueues s'))
+                             (tcbSchedNexts_of s') (tcbSchedPrevs_of s')"
+  (simp: bitmap_fun_defs ready_queues_relation_def)
+
+\<comment> \<open>
+  A direct analogue of tcbQueueRemove, used in tcb_sched_dequeue' below, so that within the proof of
+  tcbQueueRemove_corres, we may reason in terms of the list operations used within this function
+  rather than @{term filter}.\<close>
+definition tcb_queue_remove :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
+  "tcb_queue_remove a ls \<equiv>
+     if ls = [a]
+     then []
+     else if a = hd ls
+          then tl ls
+          else if a = last ls
+               then butlast ls
+               else list_remove ls a"
+
+definition tcb_sched_dequeue' :: "obj_ref \<Rightarrow> unit det_ext_monad" where
+  "tcb_sched_dequeue' tcb_ptr \<equiv> do
+     d \<leftarrow> ethread_get tcb_domain tcb_ptr;
+     prio \<leftarrow> ethread_get tcb_priority tcb_ptr;
+     queue \<leftarrow> get_tcb_queue d prio;
+     when (tcb_ptr \<in> set queue) $ set_tcb_queue d prio (tcb_queue_remove tcb_ptr queue)
+   od"
+
+lemma filter_tcb_queue_remove:
+  "\<lbrakk>a \<in> set ls; distinct ls \<rbrakk> \<Longrightarrow> filter ((\<noteq>) a) ls = tcb_queue_remove a ls"
+  apply (clarsimp simp: tcb_queue_remove_def)
+  apply (intro conjI impI)
+     apply (fastforce elim: filter_hd_equals_tl)
+    apply (fastforce elim: filter_last_equals_butlast)
+   apply (fastforce elim: filter_hd_equals_tl)
+  apply (frule split_list)
+  apply (clarsimp simp: list_remove_middle_distinct)
+  apply (subst filter_True | clarsimp simp: list_remove_none)+
+  done
+
+lemma tcb_sched_dequeue_monadic_rewrite:
+  "monadic_rewrite False True (is_etcb_at t and (\<lambda>s. \<forall>d p. distinct (ready_queues s d p)))
+     (tcb_sched_action tcb_sched_dequeue t) (tcb_sched_dequeue' t)"
+  supply if_split[split del]
+  apply (clarsimp simp: tcb_sched_dequeue'_def tcb_sched_dequeue_def tcb_sched_action_def
+                        set_tcb_queue_def)
+  apply (rule monadic_rewrite_bind_tail)+
+     apply (clarsimp simp: when_def)
+     apply (rule monadic_rewrite_if_r)
+      apply (rule_tac P="\<lambda>_. distinct queue" in monadic_rewrite_guard_arg_cong)
+      apply (frule (1) filter_tcb_queue_remove)
+      apply (metis (mono_tags, lifting) filter_cong)
+     apply (rule monadic_rewrite_modify_noop)
+    apply (wpsimp wp: thread_get_wp)+
+  apply (clarsimp simp: etcb_at_def split: option.splits)
+  apply (prop_tac "(\<lambda>d' p. if d' = tcb_domain x2 \<and> p = tcb_priority x2
+                           then filter (\<lambda>x. x \<noteq> t) (ready_queues s (tcb_domain x2) (tcb_priority x2))
+                           else ready_queues s d' p)
+                   = ready_queues s")
+   apply (subst filter_True)
+    apply fastforce
+   apply (fastforce split: if_splits)
+  apply fastforce
+  done
+
+crunches removeFromBitmap
+  for ksReadyQueues[wp]: "\<lambda>s. P (ksReadyQueues s)"
+
+lemma list_queue_relation_neighbour_in_set:
+  "\<lbrakk>list_queue_relation ls q hp hp'; sym_heap hp hp'; p \<in> set ls\<rbrakk>
+   \<Longrightarrow> \<forall>nbr. (hp p = Some nbr \<longrightarrow> nbr \<in> set ls) \<and> (hp' p = Some nbr \<longrightarrow> nbr \<in> set ls)"
+  apply (rule heap_ls_neighbour_in_set)
+     apply (fastforce simp: list_queue_relation_def)
+    apply fastforce
+   apply (clarsimp simp: list_queue_relation_def prev_queue_head_def)
+  apply fastforce
+  done
+
+lemma in_queue_not_head_or_not_tail_length_gt_1:
+  "\<lbrakk>tcbPtr \<in> set ls; tcbQueueHead q \<noteq> Some tcbPtr \<or> tcbQueueEnd q \<noteq> Some tcbPtr;
+    list_queue_relation ls q nexts prevs\<rbrakk>
+   \<Longrightarrow> Suc 0 < length ls"
+  apply (clarsimp simp: list_queue_relation_def)
+  apply (cases ls; fastforce simp: queue_end_valid_def)
+  done
+
+lemma tcbSchedDequeue_corres:
+  "tcb_ptr = tcbPtr \<Longrightarrow>
+   corres dc
+     (in_correct_ready_q and ready_qs_distinct and valid_etcbs and tcb_at tcb_ptr
+      and pspace_aligned and pspace_distinct)
+     (sym_heap_sched_pointers and valid_objs')
+     (tcb_sched_action tcb_sched_dequeue tcb_ptr) (tcbSchedDequeue tcbPtr)"
+  supply heap_path_append[simp del] fun_upd_apply[simp del] distinct_append[simp del]
+         list_remove_append[simp del] projectKOs[simp]
+  apply (rule_tac Q'="tcb_at' tcbPtr" in corres_cross_add_guard)
+   apply (fastforce intro!: tcb_at_cross simp: obj_at_def is_tcb_def)
+  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 monadic_rewrite_corres_l[where P=P and Q=P for P, simplified])
+   apply (rule monadic_rewrite_guard_imp[OF tcb_sched_dequeue_monadic_rewrite])
+   apply (fastforce dest: tcb_at_is_etcb_at simp: in_correct_ready_q_def ready_qs_distinct_def)
+  apply (clarsimp simp: tcb_sched_dequeue'_def get_tcb_queue_def tcbSchedDequeue_def  getQueue_def
+                        unless_def when_def)
+  apply (rule corres_symb_exec_l[OF _ _ ethread_get_sp]; wpsimp?)
+  apply (rename_tac dom)
+  apply (rule corres_symb_exec_l[OF _ _ ethread_get_sp]; wpsimp?)
+  apply (rename_tac prio)
+  apply (rule corres_symb_exec_l[OF _ _ gets_sp]; (solves wpsimp)?)
+  apply (rule corres_stateAssert_ignore)
+   apply (fastforce intro: ksReadyQueues_asrt_cross)
+  apply (rule corres_symb_exec_r[OF _ threadGet_sp]; (solves wpsimp)?)
+  apply (rule corres_if_strong'; fastforce?)
+    apply (frule state_relation_ready_queues_relation)
+    apply (frule in_ready_q_tcbQueued_eq[where t=tcbPtr])
+    apply (fastforce simp: obj_at'_def opt_pred_def opt_map_def obj_at_def is_tcb_def
+                           in_correct_ready_q_def etcb_at_def is_etcb_at_def)
+  apply (rule corres_symb_exec_r[OF _ threadGet_sp]; wpsimp?)
+  apply (rule corres_symb_exec_r[OF _ threadGet_sp]; wpsimp?)
+  apply (rule corres_symb_exec_r[OF _ gets_sp]; wpsimp?)
+  apply (rule corres_from_valid_det)
+    apply (fastforce intro: det_wp_modify det_wp_pre simp: set_tcb_queue_def)
+   apply (wpsimp wp: tcbQueueRemove_no_fail)
+   apply (fastforce dest: state_relation_ready_queues_relation
+                    simp: ex_abs_underlying_def ready_queues_relation_def ready_queue_relation_def
+                          Let_def inQ_def opt_pred_def opt_map_def obj_at'_def)
+  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 tcbQueueRemove_def
+         split_del: if_split)
+  apply (frule (1) tcb_at_is_etcb_at)
+  apply (clarsimp simp: obj_at_def is_etcb_at_def etcb_at_def)
+  apply normalise_obj_at'
+  apply (rename_tac s d p s' tcb' tcb etcb)
+  apply (frule_tac t=tcbPtr in ekheap_relation_tcb_domain_priority)
+    apply (force simp: obj_at_def)
+   apply (force simp: obj_at'_def)
+
+  apply (case_tac "d \<noteq> tcb_domain etcb \<or> p \<noteq> tcb_priority etcb")
+   apply clarsimp
+   apply (cut_tac p=tcbPtr and ls="ready_queues s (tcb_domain etcb) (tcb_priority etcb)"
+               in list_queue_relation_neighbour_in_set)
+      apply (fastforce dest!: spec)
+     apply fastforce
+    apply fastforce
+   apply (cut_tac xs="ready_queues s d p" in heap_path_head')
+    apply (force dest!: spec simp: ready_queues_relation_def Let_def list_queue_relation_def)
+   apply (cut_tac d=d and d'="tcb_domain etcb" and p=p and p'="tcb_priority etcb"
+               in ready_queues_disjoint)
+      apply force
+     apply fastforce
+    apply fastforce
+   apply (cut_tac ts="ready_queues s d p" in list_queue_relation_nil)
+    apply fast
+   apply (clarsimp simp: tcbQueueEmpty_def)
+   apply (prop_tac "Some tcbPtr \<noteq> tcbQueueHead (ksReadyQueues s' (d, p))")
+    apply (metis hd_in_set not_emptyI option.sel option.simps(2))
+   apply (prop_tac "tcbPtr \<notin> set (ready_queues s d p)")
+    apply blast
+   apply (clarsimp simp: list_queue_relation_def)
+   apply (intro conjI; clarsimp)
+
+    \<comment> \<open>the ready queue is the singleton consisting of tcbPtr\<close>
+    apply (intro conjI)
+         apply (force intro!: heap_path_heap_upd_not_in simp: fun_upd_apply)
+        apply (clarsimp simp: queue_end_valid_def fun_upd_apply)
+       apply (force simp: prev_queue_head_heap_upd fun_upd_apply)
+      apply (clarsimp simp: inQ_def in_opt_pred fun_upd_apply)
+     apply (clarsimp simp: fun_upd_apply)
+    apply (clarsimp simp: fun_upd_apply)
+
+   apply (clarsimp simp: etcb_at_def obj_at'_def)
+   apply (intro conjI; clarsimp)
+
+    \<comment> \<open>tcbPtr is the head of the ready queue\<close>
+    apply (intro conjI)
+         apply (intro heap_path_heap_upd_not_in)
+           apply (force simp: fun_upd_apply)
+          apply (force simp: not_emptyI opt_map_red)
+         apply assumption
+        apply (clarsimp simp: queue_end_valid_def fun_upd_apply)
+       apply (clarsimp simp: prev_queue_head_def fun_upd_apply)
+      apply (clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply split: option.splits)
+     apply (clarsimp simp: fun_upd_apply)
+    apply (clarsimp simp: fun_upd_apply)
+   apply (intro conjI; clarsimp)
+
+    \<comment> \<open>tcbPtr is the end of the ready queue\<close>
+    apply (intro conjI)
+         apply (intro heap_path_heap_upd_not_in)
+           apply (simp add: fun_upd_apply split: if_splits)
+          apply (force simp: not_emptyI opt_map_red)
+         apply (clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply split: option.splits)
+        apply (clarsimp simp: queue_end_valid_def fun_upd_apply)
+       apply (force simp: prev_queue_head_def fun_upd_apply opt_map_red opt_map_upd_triv)
+      apply (clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply split: option.splits)
+     apply (clarsimp simp: fun_upd_apply)
+    apply (clarsimp simp: fun_upd_apply)
+
+   \<comment> \<open>tcbPtr is in the middle of the ready queue\<close>
+   apply (intro conjI)
+     apply (intro heap_path_heap_upd_not_in)
+        apply (simp add: fun_upd_apply)
+       apply (force simp: not_emptyI opt_map_red)
+      apply (force simp: not_emptyI opt_map_red)
+     apply fastforce
+    apply (clarsimp simp: opt_map_red opt_map_upd_triv)
+    apply (intro prev_queue_head_heap_upd)
+      apply (force dest!: spec)
+     apply (metis hd_in_set not_emptyI option.sel option.simps(2))
+    apply fastforce
+   subgoal
+     by (clarsimp simp: inQ_def opt_map_def opt_pred_def fun_upd_apply
+                 split: if_splits option.splits)
+
+  \<comment> \<open>d = tcb_domain tcb \<and> p = tcb_priority tcb\<close>
+  apply clarsimp
+  apply (drule_tac x="tcb_domain etcb" in spec)
+  apply (drule_tac x="tcb_priority etcb" in spec)
+  apply (clarsimp simp: list_queue_relation_def)
+  apply (frule heap_path_head')
+  apply (frule heap_ls_distinct)
+  apply (intro conjI; clarsimp simp: tcbQueueEmpty_def)
+
+   \<comment> \<open>the ready queue is the singleton consisting of tcbPtr\<close>
+   apply (intro conjI)
+      apply (simp add: fun_upd_apply tcb_queue_remove_def queue_end_valid_def heap_ls_unique
+                       heap_path_last_end)
+     apply (simp add: fun_upd_apply tcb_queue_remove_def queue_end_valid_def heap_ls_unique
+                      heap_path_last_end)
+    apply (simp add: fun_upd_apply prev_queue_head_def)
+   apply (case_tac "ready_queues s (tcb_domain etcb) (tcb_priority etcb)";
+          clarsimp simp: tcb_queue_remove_def inQ_def opt_pred_def fun_upd_apply)
+  apply (intro conjI; clarsimp)
+
+   \<comment> \<open>tcbPtr is the head of the ready queue\<close>
+   apply (frule set_list_mem_nonempty)
+   apply (frule in_queue_not_head_or_not_tail_length_gt_1)
+     apply fastforce
+    apply (fastforce simp: list_queue_relation_def)
+   apply (frule list_not_head)
+   apply (clarsimp simp: tcb_queue_remove_def)
+   apply (frule length_tail_nonempty)
+   apply (frule (2) heap_ls_next_of_hd)
+   apply (clarsimp simp: obj_at'_def)
+   apply (intro conjI impI allI)
+      apply (drule (1) heap_ls_remove_head_not_singleton)
+      apply (clarsimp simp: opt_map_red opt_map_upd_triv fun_upd_apply)
+     apply (clarsimp simp: queue_end_valid_def fun_upd_apply last_tl)
+    apply (clarsimp simp: prev_queue_head_def fun_upd_apply)
+   apply (case_tac "ready_queues s (tcb_domain etcb) (tcb_priority etcb)";
+          clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply split: option.splits)
+  apply (intro conjI; clarsimp)
+
+   \<comment> \<open>tcbPtr is the end of the ready queue\<close>
+   apply (frule set_list_mem_nonempty)
+   apply (frule in_queue_not_head_or_not_tail_length_gt_1)
+     apply fast
+    apply (force dest!: spec simp: list_queue_relation_def)
+   apply (clarsimp simp: queue_end_valid_def)
+   apply (frule list_not_last)
+   apply (clarsimp simp: tcb_queue_remove_def)
+   apply (frule length_gt_1_imp_butlast_nonempty)
+   apply (frule (3) heap_ls_prev_of_last)
+   apply (clarsimp simp: obj_at'_def)
+   apply (intro conjI impI; clarsimp?)
+      apply (drule (1) heap_ls_remove_last_not_singleton)
+      apply (force elim!: rsubst3[where P=heap_ls] simp: opt_map_def fun_upd_apply)
+     apply (clarsimp simp: opt_map_def fun_upd_apply)
+    apply (clarsimp simp: prev_queue_head_def fun_upd_apply opt_map_def)
+   apply (clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply split: option.splits)
+   apply (meson distinct_in_butlast_not_last in_set_butlastD last_in_set not_last_in_set_butlast)
+
+  \<comment> \<open>tcbPtr is in the middle of the ready queue\<close>
+  apply (clarsimp simp: obj_at'_def)
+  apply (frule set_list_mem_nonempty)
+  apply (frule split_list)
+  apply clarsimp
+  apply (rename_tac xs ys)
+  apply (prop_tac "xs \<noteq> [] \<and> ys \<noteq> []", fastforce simp: queue_end_valid_def)
+  apply clarsimp
+  apply (frule (2) ptr_in_middle_prev_next)
+   apply fastforce
+  apply (clarsimp simp: tcb_queue_remove_def)
+  apply (prop_tac "tcbPtr \<noteq> last xs")
+   apply (clarsimp simp: distinct_append)
+  apply (prop_tac "tcbPtr \<noteq> hd ys")
+   apply (fastforce dest: hd_in_set simp: distinct_append)
+  apply (prop_tac "last xs \<noteq> hd ys")
+   apply (metis distinct_decompose2 hd_Cons_tl last_in_set)
+  apply (prop_tac "list_remove (xs @ tcbPtr # ys) tcbPtr = xs @ ys")
+   apply (simp add: list_remove_middle_distinct)
+  apply (intro conjI impI allI; (solves \<open>clarsimp simp: distinct_append\<close>)?)
+     apply (fastforce elim!: rsubst3[where P=heap_ls]
+                      dest!: heap_ls_remove_middle hd_in_set last_in_set
+                       simp: distinct_append not_emptyI opt_map_def fun_upd_apply)
+    apply (clarsimp simp: queue_end_valid_def fun_upd_apply)
+   apply (case_tac xs;
+          fastforce simp: prev_queue_head_def opt_map_def fun_upd_apply distinct_append)
+  apply (clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply distinct_append
+                 split: option.splits)
   done
 
 lemma thread_get_test: "do cur_ts \<leftarrow> get_thread_state cur; g (test cur_ts) od =
@@ -2049,7 +3128,9 @@ lemma thread_get_test: "do cur_ts \<leftarrow> get_thread_state cur; g (test cur
   apply (simp add: get_thread_state_def thread_get_def)
   done
 
-lemma thread_get_isRunnable_corres: "corres (=) (tcb_at t) (tcb_at' t) (thread_get (\<lambda>tcb. runnable (tcb_state tcb)) t) (isRunnable t)"
+lemma thread_get_isRunnable_corres:
+  "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+          (thread_get (\<lambda>tcb. runnable (tcb_state tcb)) t) (isRunnable t)"
   apply (simp add:  isRunnable_def getThreadState_def threadGet_def
                    thread_get_def)
   apply (fold liftM_def)
@@ -2063,8 +3144,8 @@ lemma thread_get_isRunnable_corres: "corres (=) (tcb_at t) (tcb_at' t) (thread_g
 lemma setThreadState_corres:
   "thread_state_relation ts ts' \<Longrightarrow>
    corres dc
-          (tcb_at t)
-          (tcb_at' t)
+          (tcb_at t and pspace_aligned and pspace_distinct)
+          \<top>
           (set_thread_state t ts) (setThreadState ts' t)"
   (is "?tsr \<Longrightarrow> corres dc ?Pre ?Pre' ?sts ?sts'")
   apply (simp add: set_thread_state_def setThreadState_def)
@@ -2088,8 +3169,8 @@ lemma setThreadState_corres:
 
 lemma setBoundNotification_corres:
   "corres dc
-          (tcb_at t)
-          (tcb_at' t)
+          (tcb_at t and pspace_aligned and pspace_distinct)
+          \<top>
           (set_bound_notification t ntfn) (setBoundNotification ntfn t)"
   apply (simp add: set_bound_notification_def setBoundNotification_def)
   apply (subst thread_set_def[simplified, symmetric])
@@ -2098,31 +3179,85 @@ lemma setBoundNotification_corres:
 
 crunches rescheduleRequired, tcbSchedDequeue, setThreadState, setBoundNotification
   for tcb'[wp]: "tcb_at' addr"
-  (simp: unless_def)
+
+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
+
+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
+
+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)
+
+crunches addToBitmap
+  for valid_objs'[wp]: valid_objs'
+  (simp: unless_def crunch_simps wp: crunch_wps)
+
+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
 
 crunches rescheduleRequired, removeFromBitmap
   for valid_objs'[wp]: valid_objs'
   (simp: crunch_simps)
 
-lemma tcbSchedDequeue_valid_objs' [wp]: "\<lbrace> valid_objs' \<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>_. valid_objs' \<rbrace>"
-  unfolding tcbSchedDequeue_def
-  apply (wp threadSet_valid_objs')
-        apply (clarsimp simp add: valid_tcb'_def tcb_cte_cases_def)
-        apply wp
-       apply (simp add: if_apply_def2)
-       apply (wp hoare_drop_imps)
-       apply (wp | simp cong: if_cong add: valid_tcb'_def tcb_cte_cases_def if_apply_def2)+
+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]
+
+lemma tcbQueueRemove_valid_objs'[wp]:
+  "tcbQueueRemove queue tcbPtr \<lbrace>valid_objs'\<rbrace>"
+  unfolding tcbQueueRemove_def
+  apply (wpsimp wp: getObject_tcb_wp)
+  apply normalise_obj_at'
+  apply (fastforce dest!: tcb_ko_at_valid_objs_valid_tcb'
+                    simp: valid_tcb'_def valid_bound_tcb'_def obj_at'_def)
   done
 
+lemma tcbSchedDequeue_valid_objs'[wp]:
+  "tcbSchedDequeue t \<lbrace>valid_objs'\<rbrace>"
+  unfolding tcbSchedDequeue_def setQueue_def
+  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>"
-  apply (simp add: setThreadState_def setQueue_def isRunnable_def isStopped_def)
-  apply (wp threadSet_valid_objs')
-     apply (simp add: valid_tcb'_def tcb_cte_cases_def)
-     apply (wp threadSet_valid_objs' | simp)+
-  apply (clarsimp simp: valid_tcb'_def tcb_cte_cases_def)
+  "\<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')
+   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':
@@ -2165,19 +3300,12 @@ lemma sts'_valid_pspace'_inv[wp]:
   apply (simp add: tcb_cte_cases_def)
   done
 
-crunch ct[wp]: setQueue "\<lambda>s. P (ksCurThread s)"
-
-crunch cur_domain[wp]: setQueue "\<lambda>s. P (ksCurDomain s)"
-
-crunch ct'[wp]: addToBitmap "\<lambda>s. P (ksCurThread s)"
-crunch ct'[wp]: removeFromBitmap "\<lambda>s. P (ksCurThread s)"
-
 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>
@@ -2210,18 +3338,6 @@ lemma setQueue_valid_bitmapQ_except[wp]:
   unfolding setQueue_def bitmapQ_defs
   by (wp, clarsimp simp: bitmapQ_def)
 
-lemma setQueue_valid_bitmapQ: (* enqueue only *)
-  "\<lbrace> valid_bitmapQ and (\<lambda>s. (ksReadyQueues s (d, p) = []) = (ts = [])) \<rbrace>
-  setQueue d p ts
-  \<lbrace>\<lambda>_. valid_bitmapQ \<rbrace>"
-  unfolding setQueue_def bitmapQ_defs
-  by (wp, clarsimp simp: bitmapQ_def)
-
-lemma setQueue_valid_queues':
-  "\<lbrace>valid_queues' and (\<lambda>s. \<forall>t. obj_at' (inQ d p) t s \<longrightarrow> t \<in> set ts)\<rbrace>
-    setQueue d p ts \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  by (wp | simp add: valid_queues'_def setQueue_def)+
-
 lemma setQueue_cur:
   "\<lbrace>\<lambda>s. cur_tcb' s\<rbrace> setQueue d p ts \<lbrace>\<lambda>rv s. cur_tcb' s\<rbrace>"
   unfolding setQueue_def cur_tcb'_def
@@ -2359,9 +3475,17 @@ lemma threadSet_queued_sch_act_wf[wp]:
   apply (wp tcb_in_cur_domain'_lift | simp add: obj_at'_def)+
   done
 
+lemma tcbSchedNext_update_pred_tcb_at'[wp]:
+  "threadSet (tcbSchedNext_update f) t \<lbrace>\<lambda>s. P (pred_tcb_at' proj P' t' s)\<rbrace>"
+  by (wp threadSet_pred_tcb_no_state crunch_wps | clarsimp simp: tcb_to_itcb'_def)+
+
+lemma tcbSchedPrev_update_pred_tcb_at'[wp]:
+  "threadSet (tcbSchedPrev_update f) t \<lbrace>\<lambda>s. P (pred_tcb_at' proj P' t' s)\<rbrace>"
+  by (wp threadSet_pred_tcb_no_state crunch_wps | clarsimp simp: tcb_to_itcb'_def)+
+
 lemma tcbSchedEnqueue_pred_tcb_at'[wp]:
   "\<lbrace>\<lambda>s. pred_tcb_at' proj P' t' s \<rbrace> tcbSchedEnqueue t \<lbrace>\<lambda>_ s. pred_tcb_at' proj P' t' s\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def when_def unless_def)
+  apply (simp add: tcbSchedEnqueue_def tcbQueuePrepend_def when_def unless_def)
   apply (wp threadSet_pred_tcb_no_state crunch_wps | clarsimp simp: tcb_to_itcb'_def)+
   done
 
@@ -2369,8 +3493,9 @@ lemma tcbSchedDequeue_sch_act_wf[wp]:
   "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>
     tcbSchedDequeue t
    \<lbrace>\<lambda>_ s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  unfolding tcbSchedDequeue_def
-  by (wp setQueue_sch_act | wp sch_act_wf_lift | simp add: if_apply_def2)+
+  unfolding tcbSchedDequeue_def tcbQueueRemove_def
+  by (wp setQueue_sch_act threadSet_tcbDomain_triv hoare_drop_imps
+      | wp sch_act_wf_lift | simp add: if_apply_def2)+
 
 crunch nosch: tcbSchedDequeue "\<lambda>s. P (ksSchedulerAction s)"
 
@@ -2466,21 +3591,22 @@ lemma tcbSchedEnqueue_sch_act[wp]:
   "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>
     tcbSchedEnqueue t
    \<lbrace>\<lambda>_ s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  by (simp add: tcbSchedEnqueue_def unless_def)
-     (wp setQueue_sch_act | wp sch_act_wf_lift  | clarsimp)+
+  by (simp add: tcbSchedEnqueue_def tcbQueuePrepend_def unless_def)
+     (wp setQueue_sch_act threadSet_tcbDomain_triv | wp sch_act_wf_lift  | clarsimp)+
 
 lemma tcbSchedEnqueue_weak_sch_act[wp]:
   "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
     tcbSchedEnqueue t
    \<lbrace>\<lambda>_ s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
+  apply (simp add: tcbSchedEnqueue_def tcbQueuePrepend_def unless_def)
   apply (wp setQueue_sch_act threadSet_weak_sch_act_wf | clarsimp)+
   done
 
-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>"
+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
+  apply (clarsimp simp: obj_at'_def)
   done
 
 lemma threadGet_const:
@@ -2526,14 +3652,6 @@ lemma addToBitmap_bitmapQ:
   by (wpsimp simp: bitmap_fun_defs bitmapQ_def prioToL1Index_bit_set prioL2Index_bit_set
              simp_del: bit_exp_iff)
 
-lemma addToBitmap_valid_queues_no_bitmap_except:
-" \<lbrace> valid_queues_no_bitmap_except t \<rbrace>
-     addToBitmap d p
-  \<lbrace>\<lambda>_. valid_queues_no_bitmap_except t \<rbrace>"
-  unfolding addToBitmap_def modifyReadyQueuesL1Bitmap_def modifyReadyQueuesL2Bitmap_def
-             getReadyQueuesL1Bitmap_def getReadyQueuesL2Bitmap_def valid_queues_no_bitmap_except_def
-  by (wp, clarsimp)
-
 crunch norq[wp]: addToBitmap "\<lambda>s. P (ksReadyQueues s)"
   (wp: updateObject_cte_inv hoare_drop_imps)
 crunch norq[wp]: removeFromBitmap "\<lambda>s. P (ksReadyQueues s)"
@@ -2565,9 +3683,8 @@ lemma prioToL1Index_complement_nth_w2p:
 
 lemma valid_bitmapQ_exceptE:
   "\<lbrakk> valid_bitmapQ_except d' p' s ; d \<noteq> d' \<or> p \<noteq> p' \<rbrakk>
-   \<Longrightarrow> bitmapQ d p s = (ksReadyQueues s (d, p) \<noteq> [])"
-   unfolding valid_bitmapQ_except_def
-   by blast
+   \<Longrightarrow> bitmapQ d p s = (\<not> tcbQueueEmpty (ksReadyQueues s (d, p)))"
+  by (fastforce simp: valid_bitmapQ_except_def)
 
 lemma invertL1Index_eq_cancelD:
   "\<lbrakk>  invertL1Index i = invertL1Index j ; i < l2BitmapSize ; j < l2BitmapSize \<rbrakk>
@@ -2682,22 +3799,15 @@ lemma addToBitmap_valid_bitmapQ_except:
   done
 
 lemma addToBitmap_valid_bitmapQ:
-" \<lbrace> valid_bitmapQ_except d p and bitmapQ_no_L2_orphans and
-    (\<lambda>s. ksReadyQueues s (d,p) \<noteq> []) \<rbrace>
-     addToBitmap d p
-  \<lbrace>\<lambda>_. valid_bitmapQ \<rbrace>"
-proof -
-  have "\<lbrace> valid_bitmapQ_except d p and bitmapQ_no_L2_orphans and
-            (\<lambda>s. ksReadyQueues s (d,p) \<noteq> []) \<rbrace>
-         addToBitmap d p
-         \<lbrace>\<lambda>_. valid_bitmapQ_except d p and
-              bitmapQ_no_L2_orphans and (\<lambda>s. bitmapQ d p s \<and> ksReadyQueues s (d,p) \<noteq> []) \<rbrace>"
-  by (wp addToBitmap_valid_queues_no_bitmap_except addToBitmap_valid_bitmapQ_except
-            addToBitmap_bitmapQ_no_L2_orphans addToBitmap_bitmapQ; simp)
-
-  thus ?thesis
-    by - (erule hoare_strengthen_post; fastforce elim: valid_bitmap_valid_bitmapQ_exceptE)
-qed
+  "\<lbrace>valid_bitmapQ_except d p and bitmapQ_no_L2_orphans
+    and (\<lambda>s. \<not> tcbQueueEmpty (ksReadyQueues s (d,p)))\<rbrace>
+   addToBitmap d p
+   \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
+  (is "\<lbrace>?pre\<rbrace> _ \<lbrace>_\<rbrace>")
+  apply (rule_tac Q="\<lambda>_ s. ?pre s \<and> bitmapQ d p s" in hoare_strengthen_post)
+   apply (wpsimp wp: addToBitmap_valid_bitmapQ_except addToBitmap_bitmapQ)
+  apply (fastforce elim: valid_bitmap_valid_bitmapQ_exceptE)
+  done
 
 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>"
@@ -2715,12 +3825,6 @@ lemma threadGet_const_tcb_at_imp_lift:
   apply (clarsimp simp: obj_at'_def)
   done
 
-lemma valid_queues_no_bitmap_objD:
-  "\<lbrakk> valid_queues_no_bitmap s; t \<in> set (ksReadyQueues s (d, p))\<rbrakk>
-   \<Longrightarrow> obj_at' (inQ d p and runnable' \<circ> tcbState) t s"
-   unfolding valid_queues_no_bitmap_def
-   by metis
-
 lemma setQueue_bitmapQ_no_L1_orphans[wp]:
   "\<lbrace> bitmapQ_no_L1_orphans \<rbrace>
        setQueue d p ts
@@ -2740,126 +3844,6 @@ lemma setQueue_sets_queue[wp]:
   unfolding setQueue_def
   by (wp, simp)
 
-lemma tcbSchedEnqueueOrAppend_valid_queues:
-  (* f is either (t#ts) or (ts @ [t]), so we define its properties generally *)
-  assumes f_set[simp]: "\<And>ts. t \<in> set (f ts)"
-  assumes f_set_insert[simp]: "\<And>ts. set (f ts) = insert t (set ts)"
-  assumes f_not_empty[simp]: "\<And>ts. f ts \<noteq> []"
-  assumes f_distinct: "\<And>ts. \<lbrakk> distinct ts ; t \<notin> set ts \<rbrakk> \<Longrightarrow> distinct (f ts)"
-  shows "\<lbrace>Invariants_H.valid_queues and st_tcb_at' runnable' t and valid_objs' \<rbrace>
-    do queued \<leftarrow> threadGet tcbQueued t;
-       unless queued $
-       do tdom \<leftarrow> threadGet tcbDomain t;
-          prio \<leftarrow> threadGet tcbPriority t;
-          queue \<leftarrow> getQueue tdom prio;
-          setQueue tdom prio $ f queue;
-          when (null queue) $ addToBitmap tdom prio;
-          threadSet (tcbQueued_update (\<lambda>_. True)) t
-       od
-    od
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-proof -
-
-  define could_run where "could_run ==
-    \<lambda>d p t. obj_at' (\<lambda>tcb. inQ d p (tcbQueued_update (\<lambda>_. True) tcb) \<and> runnable' (tcbState tcb)) t"
-
-  have addToBitmap_could_run:
-  "\<And>d p. \<lbrace>\<lambda>s. \<forall>d p. t \<in> set (ksReadyQueues s (d, p)) \<longrightarrow> could_run d p t s\<rbrace>
-         addToBitmap d p
-         \<lbrace>\<lambda>_ s. \<forall>d p. t \<in> set (ksReadyQueues s (d, p)) \<longrightarrow> could_run d p t s\<rbrace>"
-    unfolding bitmap_fun_defs
-    by (wp, clarsimp simp: could_run_def)
-
-  have setQueue_valid_queues_no_bitmap_except:
-    "\<And>d p ts.
-     \<lbrace> valid_queues_no_bitmap_except t and
-       (\<lambda>s. ksReadyQueues s (d, p) = ts \<and> p \<le> maxPriority \<and> d \<le> maxDomain \<and> t \<notin> set ts) \<rbrace>
-         setQueue d p (f ts)
-     \<lbrace>\<lambda>rv. valid_queues_no_bitmap_except t\<rbrace>"
-    unfolding setQueue_def valid_queues_no_bitmap_except_def null_def
-    by (wp, auto intro: f_distinct)
-
-  have threadSet_valid_queues_could_run:
-   "\<And>f. \<lbrace> valid_queues_no_bitmap_except t and
-          (\<lambda>s. \<forall>d p. t \<in> set (ksReadyQueues s (d,p)) \<longrightarrow> could_run d p t s) and
-          valid_bitmapQ and bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans \<rbrace>
-            threadSet (tcbQueued_update (\<lambda>_. True)) t
-         \<lbrace>\<lambda>rv. Invariants_H.valid_queues \<rbrace>"
-    unfolding threadSet_def could_run_def
-    apply (rule hoare_seq_ext[OF _ getObject_tcb_sp])
-    apply (rule hoare_pre)
-     apply (simp add: valid_queues_def valid_queues_no_bitmap_def)
-     apply (wp setObject_queues_unchanged_tcb hoare_Ball_helper hoare_vcg_all_lift
-               setObject_tcb_strongest)
-    apply (clarsimp simp: valid_queues_no_bitmap_except_def obj_at'_def)
-    done
-
-  have setQueue_could_run: "\<And>d p ts.
-    \<lbrace> valid_queues and (\<lambda>_. t \<in> set ts) and
-      (\<lambda>s. could_run d p t s) \<rbrace>
-    setQueue d p ts
-    \<lbrace>\<lambda>rv s. (\<forall>d p. t \<in> set (ksReadyQueues s (d, p)) \<longrightarrow> could_run d p t s)\<rbrace>"
-    unfolding setQueue_def valid_queues_def could_run_def
-    by wp (fastforce dest: valid_queues_no_bitmap_objD simp: obj_at'_def inQ_def)
-
-  note hoare_vcg_if_lift[wp] hoare_vcg_conj_lift[wp] hoare_vcg_const_imp_lift[wp]
-
-  show ?thesis
-  unfolding tcbSchedEnqueue_def null_def
-  apply (rule hoare_pre)
-   apply (rule hoare_seq_ext)
-    apply (simp add: unless_def)
-    apply (wp threadSet_valid_queues_could_run)
-        apply (wp addToBitmap_could_run addToBitmap_valid_bitmapQ
-                  addToBitmap_valid_queues_no_bitmap_except addToBitmap_bitmapQ_no_L2_orphans)+
-       apply (wp setQueue_valid_queues_no_bitmap_except setQueue_could_run
-                 setQueue_valid_bitmapQ_except setQueue_sets_queue setQueue_valid_bitmapQ)+
-      apply (wp threadGet_const_tcb_at_imp_lift | simp add: if_apply_def2)+
-  apply clarsimp
-  apply (frule pred_tcb_at')
-  apply (frule (1) valid_objs'_maxDomain)
-  apply (frule (1) valid_objs'_maxPriority)
-  apply (clarsimp simp: valid_queues_def st_tcb_at'_def obj_at'_def valid_queues_no_bitmap_exceptI)
-  apply (fastforce dest!: valid_queues_no_bitmap_objD simp: obj_at'_def inQ_def could_run_def)
-  done
-qed
-
-lemma tcbSchedEnqueue_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues
-    and st_tcb_at' runnable' t
-    and valid_objs' \<rbrace>
-     tcbSchedEnqueue t
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-   unfolding tcbSchedEnqueue_def
-   by (fastforce intro:  tcbSchedEnqueueOrAppend_valid_queues)
-
-lemma tcbSchedAppend_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues
-    and st_tcb_at' runnable' t
-    and valid_objs' \<rbrace>
-     tcbSchedAppend t
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-   unfolding tcbSchedAppend_def
-   by (fastforce intro:  tcbSchedEnqueueOrAppend_valid_queues)
-
-lemma rescheduleRequired_valid_queues[wp]:
-  "\<lbrace>\<lambda>s. Invariants_H.valid_queues s \<and> valid_objs' s \<and>
-        weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | wpc | simp)+
-  apply (fastforce simp: weak_sch_act_wf_def elim: valid_objs'_maxDomain valid_objs'_maxPriority)
-  done
-
-lemma rescheduleRequired_valid_queues_sch_act_simple:
-  "\<lbrace>Invariants_H.valid_queues and sch_act_simple\<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | wpc | simp | fastforce simp: Invariants_H.valid_queues_def sch_act_simple_def)+
-  done
-
 lemma rescheduleRequired_valid_bitmapQ_sch_act_simple:
   "\<lbrace> valid_bitmapQ and sch_act_simple\<rbrace>
     rescheduleRequired
@@ -2901,138 +3885,32 @@ lemma rescheduleRequired_bitmapQ_no_L2_orphans_sch_act_simple:
 
 lemma sts_valid_bitmapQ_sch_act_simple:
   "\<lbrace>valid_bitmapQ and sch_act_simple\<rbrace>
-    setThreadState st t
+   setThreadState st t
    \<lbrace>\<lambda>_. valid_bitmapQ \<rbrace>"
   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 Invariants_H.valid_queues_def inQ_def)+
+   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
+   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 Invariants_H.valid_queues_def inQ_def)+
+   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
+   setThreadState st t
    \<lbrace>\<lambda>_. bitmapQ_no_L1_orphans \<rbrace>"
   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 Invariants_H.valid_queues_def inQ_def)+
-  done
-
-lemma sts_valid_queues:
-  "\<lbrace>\<lambda>s. Invariants_H.valid_queues s \<and>
-    ((\<exists>p. t \<in> set(ksReadyQueues s p)) \<longrightarrow> runnable' st)\<rbrace>
-   setThreadState st t \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: setThreadState_def)
-  apply (wp rescheduleRequired_valid_queues_sch_act_simple
-            threadSet_valid_queues [THEN hoare_strengthen_post])
-   apply (clarsimp simp: sch_act_simple_def Invariants_H.valid_queues_def inQ_def)+
-  done
-
-lemma sbn_valid_queues:
-  "\<lbrace>\<lambda>s. Invariants_H.valid_queues s\<rbrace>
-   setBoundNotification ntfn t \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: setBoundNotification_def)
-  apply (wp threadSet_valid_queues [THEN hoare_strengthen_post])
-   apply (clarsimp simp: sch_act_simple_def Invariants_H.valid_queues_def inQ_def)+
-  done
-
-
-
-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]:
-  "\<lbrace>valid_queues' and st_tcb_at' runnable' t \<rbrace>
-    tcbSchedEnqueue t
-   \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def)
-  apply (rule hoare_pre)
-   apply (rule_tac B="\<lambda>rv. valid_queues' and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"
-           in hoare_seq_ext)
-    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_def)+
-     apply (clarsimp simp: obj_at'_def inQ_def projectKOs valid_queues'_def)
-    apply (wp getObject_tcb_wp | simp add: threadGet_def)+
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-lemma rescheduleRequired_valid_queues'_weak[wp]:
-  "\<lbrace>\<lambda>s. valid_queues' s \<and> weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply wpsimp
-  apply (clarsimp simp: weak_sch_act_wf_def)
-  done
-
-lemma rescheduleRequired_valid_queues'_sch_act_simple:
-  "\<lbrace>valid_queues' and sch_act_simple\<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | wpc | simp | fastforce simp: valid_queues'_def sch_act_simple_def)+
-  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)
-  apply (wp rescheduleRequired_valid_queues'_sch_act_simple)
-  apply (rule_tac Q="\<lambda>_. valid_queues'" in hoare_post_imp)
-   apply (clarsimp simp: sch_act_simple_def)
-  apply (wp threadSet_valid_queues')
-  apply (fastforce simp: inQ_def obj_at'_def pred_tcb_at'_def)
-  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 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)
-  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)
-  apply (wp threadSet_valid_objs' | clarsimp simp: valid_tcb'_tcbState_update)+
+   apply (clarsimp simp: sch_act_simple_def inQ_def)+
   done
 
 lemma rescheduleRequired_ksQ:
@@ -3060,17 +3938,6 @@ lemma sbn_ksQ:
   "\<lbrace>\<lambda>s. P (ksReadyQueues s p)\<rbrace> setBoundNotification ntfn t \<lbrace>\<lambda>rv s. P (ksReadyQueues s p)\<rbrace>"
   by (simp add: setBoundNotification_def, wp)
 
-lemma sts_ksQ:
-  "\<lbrace>\<lambda>s. sch_act_simple s \<and> P (ksReadyQueues s p)\<rbrace>
-    setThreadState st t
-   \<lbrace>\<lambda>_ s. P (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: setThreadState_def)
-  apply (wp rescheduleRequired_ksQ)
-  apply (rule_tac Q="\<lambda>_ s. P (ksReadyQueues s p)" in hoare_post_imp)
-   apply (clarsimp simp: sch_act_simple_def)+
-  apply (wp, simp)
-  done
-
 lemma setQueue_ksQ[wp]:
   "\<lbrace>\<lambda>s. P ((ksReadyQueues s)((d, p) := q))\<rbrace>
      setQueue d p q
@@ -3078,22 +3945,6 @@ lemma setQueue_ksQ[wp]:
   by (simp add: setQueue_def fun_upd_def[symmetric]
            | wp)+
 
-lemma tcbSchedEnqueue_ksQ:
-  "\<lbrace>\<lambda>s. t' \<notin> set (ksReadyQueues s p) \<and> t' \<noteq> t \<rbrace>
-   tcbSchedEnqueue t \<lbrace>\<lambda>_ s. t' \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply (wpsimp wp: hoare_vcg_imp_lift threadGet_wp)
-  apply (drule obj_at_ko_at')
-  apply fastforce
-  done
-
-lemma rescheduleRequired_ksQ':
-  "\<lbrace>\<lambda>s. t \<notin> set (ksReadyQueues s p) \<and> sch_act_not t s \<rbrace>
-   rescheduleRequired \<lbrace>\<lambda>_ s. t \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wpsimp wp: tcbSchedEnqueue_ksQ)
-  done
-
 lemma threadSet_tcbState_st_tcb_at':
   "\<lbrace>\<lambda>s. P st \<rbrace> threadSet (tcbState_update (\<lambda>_. st)) t \<lbrace>\<lambda>_. st_tcb_at' P t\<rbrace>"
   apply (simp add: threadSet_def pred_tcb_at'_def)
@@ -3104,36 +3955,6 @@ lemma isRunnable_const:
   "\<lbrace>st_tcb_at' runnable' t\<rbrace> isRunnable t \<lbrace>\<lambda>runnable _. runnable \<rbrace>"
   by (rule isRunnable_wp)
 
-lemma sts_ksQ':
-  "\<lbrace>\<lambda>s. (runnable' st \<or> ksCurThread s \<noteq> t) \<and> P (ksReadyQueues s p)\<rbrace>
-   setThreadState st t
-   \<lbrace>\<lambda>_ s. P (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: setThreadState_def)
-  apply (rule hoare_pre_disj')
-   apply (rule hoare_seq_ext [OF _
-                 hoare_vcg_conj_lift
-                   [OF threadSet_tcbState_st_tcb_at' [where P=runnable']
-                       threadSet_ksQ]])
-   apply (rule hoare_seq_ext [OF _
-                 hoare_vcg_conj_lift [OF isRunnable_const isRunnable_inv]])
-   apply (clarsimp simp: when_def)
-   apply (case_tac x)
-    apply (clarsimp, wp)[1]
-   apply (clarsimp)
-  apply (rule hoare_seq_ext [OF _
-                hoare_vcg_conj_lift
-                  [OF threadSet_ct threadSet_ksQ]])
-  apply (rule hoare_seq_ext [OF _ isRunnable_inv])
-  apply (rule hoare_seq_ext [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 valid_ipc_buffer_ptr'D:
   assumes yv: "y < unat max_ipc_words"
   and    buf: "valid_ipc_buffer_ptr' a s"
@@ -3260,14 +4081,16 @@ lemma thread_get_registers:
   done
 
 lemma getMRs_corres:
-  "corres (=) (tcb_at t)
-              (tcb_at' t and case_option \<top> valid_ipc_buffer_ptr' buf)
+  "corres (=) (tcb_at t and pspace_aligned and pspace_distinct)
+              (case_option \<top> valid_ipc_buffer_ptr' buf)
               (get_mrs t buf mi) (getMRs t buf (message_info_map mi))"
   proof -
   have S: "get = gets id"
     by (simp add: gets_def)
-  have T: "corres (\<lambda>con regs. regs = map con msg_registers) (tcb_at t) (tcb_at' t)
-     (thread_get (arch_tcb_get_registers o tcb_arch) t) (asUser t (mapM getRegister X64_H.msgRegisters))"
+  have T: "corres (\<lambda>con regs. regs = map con msg_registers)
+                  (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+                  (thread_get (arch_tcb_get_registers o tcb_arch) t)
+                  (asUser t (mapM getRegister X64_H.msgRegisters))"
    apply (subst thread_get_registers)
     apply (rule asUser_corres')
     apply (subst mapM_gets)
@@ -3372,8 +4195,8 @@ lemma UserContext_fold:
 lemma setMRs_corres:
   assumes m: "mrs' = mrs"
   shows
-  "corres (=) (tcb_at t and case_option \<top> in_user_frame buf)
-              (tcb_at' t and case_option \<top> valid_ipc_buffer_ptr' buf)
+  "corres (=) (tcb_at t and case_option \<top> in_user_frame buf and pspace_aligned and pspace_distinct)
+              (case_option \<top> valid_ipc_buffer_ptr' buf)
               (set_mrs t buf mrs) (setMRs t buf mrs')"
 proof -
   have setRegister_def2:
@@ -3434,9 +4257,9 @@ lemma copyMRs_corres:
   "corres (=) (tcb_at s and tcb_at r
                and case_option \<top> in_user_frame sb
                and case_option \<top> in_user_frame rb
+               and pspace_aligned and pspace_distinct
                and K (unat n \<le> msg_max_length))
-              (tcb_at' s and tcb_at' r
-               and case_option \<top> valid_ipc_buffer_ptr' sb
+              (case_option \<top> valid_ipc_buffer_ptr' sb
                and case_option \<top> valid_ipc_buffer_ptr' rb)
               (copy_mrs s sb r rb n) (copyMRs s sb r rb n)"
 proof -
@@ -3447,7 +4270,7 @@ proof -
   note R=R'[simplified]
 
   have as_user_bit:
-    "\<And>v :: machine_word. corres dc (tcb_at s and tcb_at r) (tcb_at' s and tcb_at' r)
+    "\<And>v :: machine_word. corres dc (tcb_at s and tcb_at r and pspace_aligned and pspace_distinct) \<top>
            (mapM
              (\<lambda>ra. do v \<leftarrow> as_user s (getRegister ra);
                       as_user r (setRegister ra v)
@@ -3590,9 +4413,8 @@ qed
 lemmas valid_ipc_buffer_cap_simps = valid_ipc_buffer_cap_def [split_simps cap.split arch_cap.split]
 
 lemma lookupIPCBuffer_corres':
-  "corres (=) (tcb_at t and valid_objs and pspace_aligned)
-               (tcb_at' t and valid_objs' and pspace_aligned'
-                and pspace_distinct' and no_0_obj')
+  "corres (=) (tcb_at t and valid_objs and pspace_aligned and pspace_distinct)
+               (valid_objs' and pspace_aligned' and pspace_distinct' and no_0_obj')
                (lookup_ipc_buffer w t) (lookupIPCBuffer w t)"
   apply (simp add: lookup_ipc_buffer_def X64_H.lookupIPCBuffer_def)
   apply (rule corres_guard_imp)
@@ -3637,9 +4459,8 @@ lemma lookupIPCBuffer_corres':
   done
 
 lemma lookupIPCBuffer_corres:
-  "corres (=) (tcb_at t and invs)
-               (tcb_at' t and invs')
-               (lookup_ipc_buffer w t) (lookupIPCBuffer w t)"
+  "corres (=) (tcb_at t and invs) invs'
+          (lookup_ipc_buffer w t) (lookupIPCBuffer w t)"
   using lookupIPCBuffer_corres'
   by (rule corres_guard_imp, auto simp: invs'_def valid_state'_def)
 
@@ -3705,7 +4526,7 @@ lemma ct_in_state'_set:
 
 crunches setQueue, rescheduleRequired, tcbSchedDequeue
   for idle'[wp]: "valid_idle'"
-  (simp: crunch_simps)
+  (simp: crunch_simps wp: crunch_wps)
 
 lemma sts_valid_idle'[wp]:
   "\<lbrace>valid_idle' and valid_pspace' and
@@ -3745,8 +4566,9 @@ lemma gbn_sp':
 
 lemma tcbSchedDequeue_tcbState_obj_at'[wp]:
   "\<lbrace>obj_at' (P \<circ> tcbState) t'\<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>rv. obj_at' (P \<circ> tcbState) t'\<rbrace>"
-  apply (simp add: tcbSchedDequeue_def)
-  apply (wp | simp add: o_def split del: if_split cong: if_cong)+
+  apply (simp add: tcbSchedDequeue_def tcbQueueRemove_def)
+  apply (wpsimp wp: getObject_tcb_wp simp: o_def threadGet_def)
+  apply (clarsimp simp: obj_at'_def)
   done
 
 crunch typ_at'[wp]: setQueue "\<lambda>s. P' (typ_at' P t s)"
@@ -3765,10 +4587,14 @@ lemma setQueue_pred_tcb_at[wp]:
 lemma tcbSchedDequeue_pred_tcb_at'[wp]:
   "\<lbrace>\<lambda>s. P' (pred_tcb_at' proj P t' s)\<rbrace> tcbSchedDequeue t \<lbrace>\<lambda>_ s. P' (pred_tcb_at' proj P t' s)\<rbrace>"
   apply (rule_tac P=P' in P_bool_lift)
-   apply (simp add: tcbSchedDequeue_def)
-   apply (wp threadSet_pred_tcb_no_state | clarsimp simp: tcb_to_itcb'_def)+
-  apply (simp add: tcbSchedDequeue_def)
-  apply (wp threadSet_pred_tcb_no_state | clarsimp simp: tcb_to_itcb'_def)+
+   apply (simp add: tcbSchedDequeue_def tcbQueueRemove_def)
+   apply (wpsimp wp: threadSet_pred_tcb_no_state getObject_tcb_wp
+               simp: threadGet_def tcb_to_itcb'_def)
+   apply (clarsimp simp: obj_at'_def)
+  apply (simp add: tcbSchedDequeue_def tcbQueueRemove_def)
+  apply (wpsimp wp: threadSet_pred_tcb_no_state getObject_tcb_wp
+              simp: threadGet_def tcb_to_itcb'_def)
+  apply (clarsimp simp: obj_at'_def)
   done
 
 lemma sts_st_tcb':
@@ -3865,39 +4691,156 @@ crunch nonz_cap[wp]: addToBitmap "ex_nonz_cap_to' t"
 crunch iflive'[wp]: removeFromBitmap if_live_then_nonz_cap'
 crunch nonz_cap[wp]: removeFromBitmap "ex_nonz_cap_to' t"
 
-lemma tcbSchedEnqueue_iflive'[wp]:
-  "\<lbrace>if_live_then_nonz_cap' and ex_nonz_cap_to' tcb\<rbrace>
-    tcbSchedEnqueue tcb \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply (wp threadSet_iflive' hoare_drop_imps | simp add: crunch_simps)+
+crunches rescheduleRequired
+  for cap_to'[wp]: "ex_nonz_cap_to' p"
+
+lemma tcbQueued_update_tcb_cte_cases:
+  "(getF, setF) \<in> ran tcb_cte_cases \<Longrightarrow> getF (tcbQueued_update f tcb) = getF tcb"
+  unfolding tcb_cte_cases_def
+  by (case_tac tcb; fastforce simp: objBits_simps')
+
+lemma tcbSchedNext_update_tcb_cte_cases:
+  "(getF, setF) \<in> ran tcb_cte_cases \<Longrightarrow> getF (tcbSchedNext_update f tcb) = getF tcb"
+  unfolding tcb_cte_cases_def
+  by (case_tac tcb; fastforce simp: objBits_simps')
+
+lemma tcbSchedPrev_update_tcb_cte_cases:
+  "(getF, setF) \<in> ran tcb_cte_cases \<Longrightarrow> getF (tcbSchedPrev_update f tcb) = getF tcb"
+  unfolding tcb_cte_cases_def
+  by (case_tac tcb; fastforce simp: objBits_simps')
+
+lemma tcbSchedNext_update_ctes_of[wp]:
+  "threadSet (tcbSchedNext_update f) tptr \<lbrace>\<lambda>s. P (ctes_of s)\<rbrace>"
+  by (wpsimp wp: threadSet_ctes_ofT simp: tcbSchedNext_update_tcb_cte_cases)
+
+lemma tcbSchedPrev_update_ctes_of[wp]:
+  "threadSet (tcbSchedPrev_update f) tptr \<lbrace>\<lambda>s. P (ctes_of s)\<rbrace>"
+  by (wpsimp wp: threadSet_ctes_ofT simp: tcbSchedPrev_update_tcb_cte_cases)
+
+lemma tcbSchedNext_ex_nonz_cap_to'[wp]:
+  "threadSet (tcbSchedNext_update f) tptr \<lbrace>ex_nonz_cap_to' p\<rbrace>"
+  by (wpsimp wp: threadSet_cap_to simp: tcbSchedNext_update_tcb_cte_cases)
+
+lemma tcbSchedPrev_ex_nonz_cap_to'[wp]:
+  "threadSet (tcbSchedPrev_update f) tptr \<lbrace>ex_nonz_cap_to' p\<rbrace>"
+  by (wpsimp wp: threadSet_cap_to simp: tcbSchedPrev_update_tcb_cte_cases)
+
+lemma tcbSchedNext_update_iflive':
+  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s \<and> ex_nonz_cap_to' t s\<rbrace>
+   threadSet (tcbSchedNext_update f) t
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  by (wpsimp wp: threadSet_iflive'T simp: tcbSchedNext_update_tcb_cte_cases)
+
+lemma tcbSchedPrev_update_iflive':
+  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s \<and> ex_nonz_cap_to' t s\<rbrace>
+   threadSet (tcbSchedPrev_update f) t
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  by (wpsimp wp: threadSet_iflive'T simp: tcbSchedPrev_update_tcb_cte_cases)
+
+lemma tcbQueued_update_iflive'[wp]:
+  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s \<and> ex_nonz_cap_to' t s\<rbrace>
+   threadSet (tcbQueued_update f) t
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  by (wpsimp wp: threadSet_iflive'T simp: tcbQueued_update_tcb_cte_cases)
+
+lemma getTCB_wp:
+  "\<lbrace>\<lambda>s. \<forall>ko :: tcb. ko_at' ko p s \<longrightarrow> Q ko s\<rbrace> getObject p \<lbrace>Q\<rbrace>"
+  apply (wpsimp wp: getObject_tcb_wp)
+  apply (clarsimp simp: obj_at'_def)
   done
 
-lemma rescheduleRequired_iflive'[wp]:
-  "\<lbrace>if_live_then_nonz_cap'
-        and (\<lambda>s. \<forall>t. ksSchedulerAction s = SwitchToThread t
-                \<longrightarrow> st_tcb_at' runnable' t s)\<rbrace>
-      rescheduleRequired
-   \<lbrace>\<lambda>rv. if_live_then_nonz_cap'\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wp | wpc | simp)+
-  apply (clarsimp simp: pred_tcb_at'_def obj_at'_real_def)
-  apply (erule(1) if_live_then_nonz_capD')
-  apply (fastforce simp: projectKOs)
+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 ko_wp_at'_def projectKOs)
+  done
+
+lemma tcbQueueRemove_ex_nonz_cap_to'[wp]:
+  "tcbQueueRemove q tcbPtr \<lbrace>ex_nonz_cap_to' tcbPtr'\<rbrace>"
+  unfolding tcbQueueRemove_def
+  by (wpsimp wp: threadSet_cap_to' hoare_drop_imps getTCB_wp)
+
+(* We could write this one as "\<forall>t. tcbQueueHead t \<longrightarrow> ..." instead, but we can't do the same in
+   tcbQueueAppend_if_live_then_nonz_cap', and it's nicer if the two lemmas are symmetric *)
+lemma tcbQueuePrepend_if_live_then_nonz_cap':
+  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s \<and> ex_nonz_cap_to' tcbPtr s
+        \<and> (\<not> tcbQueueEmpty q \<longrightarrow> ex_nonz_cap_to' (the (tcbQueueHead q)) s)\<rbrace>
+   tcbQueuePrepend q tcbPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  unfolding tcbQueuePrepend_def
+  by (wpsimp wp: tcbSchedPrev_update_iflive' tcbSchedNext_update_iflive'
+                 hoare_vcg_if_lift2 hoare_vcg_imp_lift')
+
+lemma tcbQueueAppend_if_live_then_nonz_cap':
+  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s \<and> ex_nonz_cap_to' tcbPtr s
+        \<and> (\<not> tcbQueueEmpty q \<longrightarrow> ex_nonz_cap_to' (the (tcbQueueEnd q)) s)\<rbrace>
+   tcbQueueAppend q tcbPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  unfolding tcbQueueAppend_def
+  by (wpsimp wp: tcbSchedPrev_update_iflive' tcbSchedNext_update_iflive')
+
+lemma tcbQueueInsert_if_live_then_nonz_cap':
+  "\<lbrace>if_live_then_nonz_cap' and ex_nonz_cap_to' tcbPtr and valid_objs' and sym_heap_sched_pointers\<rbrace>
+   tcbQueueInsert tcbPtr afterPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  unfolding tcbQueueInsert_def
+  supply projectKOs[simp]
+  apply (wpsimp wp: tcbSchedPrev_update_iflive' tcbSchedNext_update_iflive' getTCB_wp)
+  apply (intro conjI)
+   apply (erule if_live_then_nonz_capE')
+   apply (clarsimp simp: ko_wp_at'_def obj_at'_def)
+  apply (erule if_live_then_nonz_capE')
+  apply (frule_tac p'=afterPtr in sym_heapD2)
+   apply (fastforce simp: opt_map_def obj_at'_def)
+  apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+  apply (clarsimp simp: valid_tcb'_def ko_wp_at'_def obj_at'_def opt_map_def)
+  done
+
+lemma tcbSchedEnqueue_iflive'[wp]:
+  "\<lbrace>if_live_then_nonz_cap' and pspace_aligned' and pspace_distinct'\<rbrace>
+   tcbSchedEnqueue tcbPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  unfolding tcbSchedEnqueue_def
+  supply projectKOs[simp]
+  apply (wpsimp wp: tcbQueuePrepend_if_live_then_nonz_cap' threadGet_wp)
+  apply normalise_obj_at'
+  apply (rename_tac tcb)
+  apply (frule_tac p=tcbPtr in if_live_then_nonz_capE')
+   apply (fastforce simp: ko_wp_at'_def obj_at'_def)
+  apply clarsimp
+  apply (erule if_live_then_nonz_capE')
+  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 (fastforce dest!: obj_at'_tcbQueueHead_ksReadyQueues
+                    simp: ko_wp_at'_def inQ_def opt_pred_def opt_map_def obj_at'_def
+                   split: option.splits)
   done
 
+crunches rescheduleRequired
+  for iflive'[wp]: if_live_then_nonz_cap'
+
 lemma sts_iflive'[wp]:
   "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s
-      \<and> (st \<noteq> Inactive \<and> \<not> idle' st \<longrightarrow> ex_nonz_cap_to' t s)\<rbrace>
-     setThreadState st t
+      \<and> (st \<noteq> Inactive \<and> \<not> idle' st \<longrightarrow> ex_nonz_cap_to' t s)
+      \<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 setQueue_def)
-  apply (rule hoare_pre)
-   apply (wp | simp)+
-      apply (rule_tac Q="\<lambda>rv. if_live_then_nonz_cap'" in hoare_post_imp)
-       apply clarsimp
-      apply (wp threadSet_iflive' | simp)+
-   apply auto
- done
+  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
+  done
 
 lemma sbn_iflive'[wp]:
   "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s
@@ -4016,6 +4959,19 @@ lemma setBoundNotification_vms'[wp]:
   apply (intro hoare_vcg_all_lift hoare_vcg_disj_lift; wp)
   done
 
+lemma threadSet_ct_not_inQ:
+  "(\<And>tcb. tcbQueued tcb = tcbQueued (F tcb))
+   \<Longrightarrow> threadSet F tcbPtr \<lbrace>\<lambda>s. P (ct_not_inQ s)\<rbrace>"
+  unfolding threadSet_def
+  supply projectKOs[simp]
+  apply (wpsimp wp: getTCB_wp simp: setObject_def updateObject_default_def)
+  apply (erule rsubst[where P=P])
+  by (fastforce simp: ct_not_inQ_def obj_at'_def objBits_simps ps_clear_def split: if_splits)
+
+crunches tcbQueuePrepend, tcbQueueAppend, tcbQueueInsert, tcbQueueRemove, addToBitmap
+  for ct_not_inQ[wp]: ct_not_inQ
+  (wp: threadSet_ct_not_inQ crunch_wps)
+
 lemma tcbSchedEnqueue_ct_not_inQ:
   "\<lbrace>ct_not_inQ and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t)\<rbrace>
     tcbSchedEnqueue t \<lbrace>\<lambda>_. ct_not_inQ\<rbrace>"
@@ -4039,12 +4995,7 @@ lemma tcbSchedEnqueue_ct_not_inQ:
       done
     show ?thesis
       apply (simp add: tcbSchedEnqueue_def unless_def null_def)
-      apply (wp ts sq hoare_convert_imp [OF addToBitmap_nosch addToBitmap_ct'])+
-           apply (rule_tac Q="\<lambda>_. ?PRE" in hoare_post_imp, clarsimp)
-           apply (wp sq hoare_convert_imp [OF setQueue_nosch setQueue_ct])+
-       apply (rule_tac Q="\<lambda>_. ?PRE" in hoare_post_imp, clarsimp)
-       apply wp
-      apply assumption
+      apply (wpsimp wp: ts sq hoare_vcg_imp_lift' getTCB_wp simp: threadGet_def)+
       done
   qed
 
@@ -4071,12 +5022,7 @@ lemma tcbSchedAppend_ct_not_inQ:
       done
     show ?thesis
       apply (simp add: tcbSchedAppend_def unless_def null_def)
-      apply (wp ts sq hoare_convert_imp [OF addToBitmap_nosch addToBitmap_ct'])+
-           apply (rule_tac Q="\<lambda>_. ?PRE" in hoare_post_imp, clarsimp)
-           apply (wp sq hoare_convert_imp [OF setQueue_nosch setQueue_ct])+
-       apply (rule_tac Q="\<lambda>_. ?PRE" in hoare_post_imp, clarsimp)
-       apply wp
-      apply assumption
+      apply (wpsimp wp: ts sq hoare_vcg_imp_lift' getTCB_wp simp: threadGet_def)+
       done
   qed
 
@@ -4092,11 +5038,6 @@ lemma rescheduleRequired_ct_not_inQ:
   apply (wp setSchedulerAction_direct)
   done
 
-crunch nosch[wp]: tcbSchedEnqueue "\<lambda>s. P (ksSchedulerAction s)"
-  (simp: unless_def)
-crunch nosch[wp]: tcbSchedAppend "\<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
@@ -4105,12 +5046,10 @@ lemma rescheduleRequired_sa_cnt[wp]:
 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>"
-  (is "\<lbrace>?PRE\<rbrace> _ \<lbrace>_\<rbrace>")
   apply (simp add: possibleSwitchTo_def curDomain_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)
+         | (rule hoare_post_imp[OF _ rescheduleRequired_sa_cnt], fastforce))+
   done
 
 lemma threadSet_tcbState_update_ct_not_inQ[wp]:
@@ -4190,29 +5129,6 @@ lemma tcbSchedDequeue_ct_not_inQ[wp]:
       done
   qed
 
-lemma tcbSchedEnqueue_not_st:
-  "(\<And>tcb st qd. P (tcb\<lparr>tcbState := st, tcbQueued := qd\<rparr>) \<longleftrightarrow> P tcb)
-     \<Longrightarrow> \<lbrace>obj_at' P t'\<rbrace> tcbSchedEnqueue t \<lbrace>\<lambda>_. obj_at' P t'\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply (wp threadGet_wp | simp)+
-  apply (clarsimp simp: obj_at'_def)
-  apply (case_tac obja)
-  apply fastforce
-  done
-
-lemma setThreadState_not_st:
-  "(\<And>tcb st qd. P (tcb\<lparr>tcbState := st, tcbQueued := qd\<rparr>) \<longleftrightarrow> P tcb)
-     \<Longrightarrow> \<lbrace>obj_at' P t'\<rbrace> setThreadState st t \<lbrace>\<lambda>_. obj_at' P t'\<rbrace>"
-  apply (simp add: setThreadState_def rescheduleRequired_def)
-  apply (wp hoare_vcg_conj_lift tcbSchedEnqueue_not_st
-          | wpc
-          | rule hoare_drop_imps
-          | simp)+
-  apply (clarsimp simp: obj_at'_def)
-  apply (case_tac obj)
-  apply fastforce
-  done
-
 crunch ct_idle_or_in_cur_domain'[wp]: setQueue ct_idle_or_in_cur_domain'
   (simp: ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def)
 
@@ -4241,17 +5157,8 @@ lemma removeFromBitmap_ct_idle_or_in_cur_domain'[wp]:
            | clarsimp simp: updateObject_default_def in_monad setNotification_def)+
   done
 
-lemma tcbSchedEnqueue_ksCurDomain[wp]:
-  "\<lbrace> \<lambda>s. P (ksCurDomain s)\<rbrace> tcbSchedEnqueue tptr \<lbrace>\<lambda>_ s. P (ksCurDomain s)\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply wpsimp
-  done
-
-lemma tcbSchedEnqueue_ksDomSchedule[wp]:
-  "\<lbrace> \<lambda>s. P (ksDomSchedule s)\<rbrace> tcbSchedEnqueue tptr \<lbrace>\<lambda>_ s. P (ksDomSchedule s)\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def unless_def)
-  apply wpsimp
-  done
+crunches tcbQueuePrepend
+  for ct_idle_or_in_cur_domain'[wp]: ct_idle_or_in_cur_domain'
 
 lemma tcbSchedEnqueue_ct_idle_or_in_cur_domain'[wp]:
   "\<lbrace>ct_idle_or_in_cur_domain'\<rbrace> tcbSchedEnqueue tptr \<lbrace>\<lambda>_. ct_idle_or_in_cur_domain'\<rbrace>"
@@ -4331,12 +5238,386 @@ lemma sts_utr[wp]:
   apply (wp untyped_ranges_zero_lift)
   done
 
+lemma removeFromBitmap_bitmapQ:
+  "\<lbrace>\<top>\<rbrace> removeFromBitmap d p \<lbrace>\<lambda>_ s. \<not> bitmapQ d p s \<rbrace>"
+  unfolding bitmapQ_defs bitmap_fun_defs
+  by (wpsimp simp: bitmap_fun_defs)
+
+lemma removeFromBitmap_valid_bitmapQ[wp]:
+  "\<lbrace>valid_bitmapQ_except d p and bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans
+    and (\<lambda>s. tcbQueueEmpty (ksReadyQueues s (d,p)))\<rbrace>
+   removeFromBitmap d p
+   \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
+  (is "\<lbrace>?pre\<rbrace> _ \<lbrace>_\<rbrace>")
+  apply (rule_tac Q="\<lambda>_ s. ?pre s \<and> \<not> bitmapQ d p s" in hoare_strengthen_post)
+   apply (wpsimp wp: removeFromBitmap_valid_bitmapQ_except removeFromBitmap_bitmapQ)
+  apply (fastforce elim: valid_bitmap_valid_bitmapQ_exceptE)
+  done
+
+crunches tcbSchedDequeue
+  for bitmapQ_no_L1_orphans[wp]: bitmapQ_no_L1_orphans
+  and bitmapQ_no_L2_orphans[wp]: bitmapQ_no_L2_orphans
+  (wp: crunch_wps simp: crunch_simps)
+
+lemma setQueue_nonempty_valid_bitmapQ':
+  "\<lbrace>\<lambda>s. valid_bitmapQ s \<and> \<not> tcbQueueEmpty (ksReadyQueues s (d, p))\<rbrace>
+   setQueue d p queue
+   \<lbrace>\<lambda>_ s. \<not> tcbQueueEmpty queue \<longrightarrow> valid_bitmapQ s\<rbrace>"
+  apply (wpsimp simp: setQueue_def)
+  apply (fastforce simp: valid_bitmapQ_def bitmapQ_def)
+  done
+
+lemma threadSet_valid_bitmapQ_except[wp]:
+  "threadSet f tcbPtr \<lbrace>valid_bitmapQ_except d p\<rbrace>"
+  unfolding threadSet_def
+  apply (wpsimp wp: getTCB_wp simp: setObject_def updateObject_default_def)
+  apply (clarsimp simp: valid_bitmapQ_except_def bitmapQ_def)
+  done
+
+lemma threadSet_bitmapQ:
+  "threadSet F t \<lbrace>bitmapQ domain priority\<rbrace>"
+  unfolding threadSet_def
+  apply (wpsimp wp: getTCB_wp simp: setObject_def updateObject_default_def)
+  by (clarsimp simp: bitmapQ_def)
+
+crunches tcbQueueRemove, tcbQueuePrepend, tcbQueueAppend
+  for valid_bitmapQ_except[wp]: "valid_bitmapQ_except d p"
+  and valid_bitmapQ[wp]: valid_bitmapQ
+  and bitmapQ[wp]: "bitmapQ tdom prio"
+  (wp: crunch_wps)
+
+lemma tcbQueued_imp_queue_nonempty:
+  "\<lbrakk>list_queue_relation ts (ksReadyQueues s (tcbDomain tcb, tcbPriority tcb)) nexts prevs;
+    \<forall>t. t \<in> set ts \<longleftrightarrow> (inQ (tcbDomain tcb) (tcbPriority tcb) |< tcbs_of' s) t;
+    ko_at' tcb tcbPtr s; tcbQueued tcb\<rbrakk>
+   \<Longrightarrow> \<not> tcbQueueEmpty (ksReadyQueues s (tcbDomain tcb, tcbPriority tcb))"
+  supply projectKOs[simp]
+  apply (clarsimp simp: list_queue_relation_def tcbQueueEmpty_def)
+  apply (drule_tac x=tcbPtr in spec)
+  apply (fastforce dest: heap_path_head simp: inQ_def opt_map_def opt_pred_def obj_at'_def)
+  done
+
+lemma tcbSchedDequeue_valid_bitmapQ[wp]:
+  "\<lbrace>valid_bitmaps\<rbrace> tcbSchedDequeue tcbPtr \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
+  unfolding tcbSchedDequeue_def tcbQueueRemove_def
+  apply (wpsimp wp: setQueue_nonempty_valid_bitmapQ' hoare_vcg_conj_lift
+                    hoare_vcg_if_lift2 hoare_vcg_const_imp_lift threadGet_wp
+         | wp (once) hoare_drop_imps)+
+  by (fastforce dest!: tcbQueued_imp_queue_nonempty
+                 simp: ready_queue_relation_def ksReadyQueues_asrt_def obj_at'_def)
+
+lemma tcbSchedDequeue_valid_bitmaps[wp]:
+  "tcbSchedDequeue tcbPtr \<lbrace>valid_bitmaps\<rbrace>"
+  by (wpsimp simp: valid_bitmaps_def)
+
+lemma setQueue_valid_bitmapQ': (* enqueue only *)
+  "\<lbrace>valid_bitmapQ_except d p and bitmapQ d p and K (\<not> tcbQueueEmpty q)\<rbrace>
+   setQueue d p q
+   \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
+  unfolding setQueue_def bitmapQ_defs
+  by (wpsimp simp: bitmapQ_def)
+
+lemma tcbSchedEnqueue_valid_bitmapQ[wp]:
+  "\<lbrace>valid_bitmaps\<rbrace> tcbSchedEnqueue tcbPtr \<lbrace>\<lambda>_. valid_bitmapQ\<rbrace>"
+  supply if_split[split del]
+  unfolding tcbSchedEnqueue_def
+  apply (wpsimp simp: tcbQueuePrepend_def
+                  wp: setQueue_valid_bitmapQ' addToBitmap_valid_bitmapQ_except addToBitmap_bitmapQ
+                      threadGet_wp)
+  apply (fastforce simp: valid_bitmaps_def valid_bitmapQ_def tcbQueueEmpty_def split: if_splits)
+  done
+
+crunches tcbSchedEnqueue, tcbSchedAppend
+  for bitmapQ_no_L1_orphans[wp]: bitmapQ_no_L1_orphans
+  and bitmapQ_no_L2_orphans[wp]: bitmapQ_no_L2_orphans
+
+lemma tcbSchedEnqueue_valid_bitmaps[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>valid_bitmaps\<rbrace>"
+  unfolding valid_bitmaps_def
+  apply wpsimp
+  apply (clarsimp simp: valid_bitmaps_def)
+  done
+
+crunches rescheduleRequired, threadSet, setThreadState
+  for valid_bitmaps[wp]: valid_bitmaps
+  (rule: valid_bitmaps_lift)
+
+lemma tcbSchedEnqueue_valid_sched_pointers[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>valid_sched_pointers\<rbrace>"
+  supply projectKOs[simp]
+  apply (clarsimp simp: tcbSchedEnqueue_def getQueue_def unless_def)
+  \<comment> \<open>we step forwards until we can step over the addToBitmap in order to avoid state blow-up\<close>
+  apply (intro hoare_seq_ext[OF _ stateAssert_sp] hoare_seq_ext[OF _ isRunnable_inv]
+               hoare_seq_ext[OF _ assert_sp] hoare_seq_ext[OF _ threadGet_sp]
+               hoare_seq_ext[OF _ gets_sp]
+         | rule hoare_when_cases, fastforce)+
+  apply (forward_inv_step wp: hoare_vcg_ex_lift)
+  supply if_split[split del]
+  apply (wpsimp wp: getTCB_wp
+              simp: threadSet_def setObject_def updateObject_default_def tcbQueuePrepend_def
+                    setQueue_def)
+  apply (clarsimp simp: valid_sched_pointers_def)
+  apply (intro conjI impI)
+   apply (fastforce simp: opt_pred_def opt_map_def split: if_splits)
+  apply normalise_obj_at'
+  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: valid_sched_pointers_def list_queue_relation_def)
+  apply (case_tac "ts = []", fastforce simp: tcbQueueEmpty_def)
+  by (intro conjI impI;
+      force dest!: hd_in_set heap_path_head
+             simp: inQ_def opt_pred_def opt_map_def obj_at'_def split: if_splits)
+
+lemma tcbSchedAppend_valid_sched_pointers[wp]:
+  "tcbSchedAppend tcbPtr \<lbrace>valid_sched_pointers\<rbrace>"
+  supply projectKOs[simp]
+  apply (clarsimp simp: tcbSchedAppend_def getQueue_def unless_def)
+  \<comment> \<open>we step forwards until we can step over the addToBitmap in order to avoid state blow-up\<close>
+  apply (intro hoare_seq_ext[OF _ stateAssert_sp] hoare_seq_ext[OF _ isRunnable_inv]
+               hoare_seq_ext[OF _ assert_sp] hoare_seq_ext[OF _ threadGet_sp]
+               hoare_seq_ext[OF _ gets_sp]
+         | rule hoare_when_cases, fastforce)+
+  apply (forward_inv_step wp: hoare_vcg_ex_lift)
+  supply if_split[split del]
+  apply (wpsimp wp: getTCB_wp
+              simp: threadSet_def setObject_def updateObject_default_def tcbQueueAppend_def
+                    setQueue_def)
+  apply (clarsimp simp: valid_sched_pointers_def)
+  apply (intro conjI impI)
+   apply (fastforce simp: opt_pred_def opt_map_def split: if_splits)
+  apply normalise_obj_at'
+  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)
+  by (intro conjI impI;
+      clarsimp dest: last_in_set
+               simp: valid_sched_pointers_def opt_map_def list_queue_relation_def tcbQueueEmpty_def
+                     queue_end_valid_def inQ_def opt_pred_def obj_at'_def
+              split: if_splits option.splits;
+      fastforce)
+
+lemma tcbSchedDequeue_valid_sched_pointers[wp]:
+  "\<lbrace>valid_sched_pointers and sym_heap_sched_pointers\<rbrace>
+   tcbSchedDequeue tcbPtr
+   \<lbrace>\<lambda>_. valid_sched_pointers\<rbrace>"
+  supply if_split[split del] fun_upd_apply[simp del]
+  supply projectKOs[simp]
+  apply (clarsimp simp: tcbSchedDequeue_def getQueue_def setQueue_def)
+  apply (wpsimp wp: threadSet_wp getTCB_wp threadGet_wp simp: tcbQueueRemove_def)
+  apply normalise_obj_at'
+  apply (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 split: if_splits)
+  apply (frule (1) list_queue_relation_neighbour_in_set[where p=tcbPtr])
+   apply (fastforce simp: inQ_def opt_pred_def opt_map_def obj_at'_def)
+  apply (clarsimp simp: list_queue_relation_def)
+  apply (intro conjI impI)
+     \<comment> \<open>the ready queue is the singleton consisting of tcbPtr\<close>
+     apply (clarsimp simp: valid_sched_pointers_def)
+     apply (case_tac "ptr = tcbPtr")
+      apply (force dest!: heap_ls_last_None
+                    simp: prev_queue_head_def queue_end_valid_def inQ_def opt_map_def obj_at'_def)
+     apply (simp add: fun_upd_def opt_pred_def)
+    \<comment> \<open>tcbPtr is the head of the ready queue\<close>
+    subgoal
+      by (auto dest!: heap_ls_last_None
+                simp: valid_sched_pointers_def fun_upd_apply prev_queue_head_def
+                      inQ_def opt_pred_def opt_map_def obj_at'_def
+               split: if_splits option.splits)
+   \<comment> \<open>tcbPtr is the end of the ready queue\<close>
+   subgoal
+     by (auto dest!: heap_ls_last_None
+               simp: valid_sched_pointers_def queue_end_valid_def inQ_def opt_pred_def
+                     opt_map_def fun_upd_apply obj_at'_def
+              split: if_splits option.splits)
+  \<comment> \<open>tcbPtr is in the middle of the ready queue\<close>
+  apply (intro conjI impI allI)
+  by (clarsimp simp: valid_sched_pointers_def inQ_def opt_pred_def opt_map_def fun_upd_apply obj_at'_def
+              split: if_splits option.splits;
+      auto)
+
+lemma tcbQueueRemove_sym_heap_sched_pointers:
+  "\<lbrace>\<lambda>s. sym_heap_sched_pointers s
+        \<and> (\<exists>ts. list_queue_relation ts q (tcbSchedNexts_of s) (tcbSchedPrevs_of s)
+                \<and> tcbPtr \<in> set ts)\<rbrace>
+   tcbQueueRemove q tcbPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  supply heap_path_append[simp del]
+  supply projectKOs[simp]
+  apply (clarsimp simp: tcbQueueRemove_def)
+  apply (wpsimp wp: threadSet_wp getTCB_wp)
+  apply (rename_tac tcb ts)
+
+  \<comment> \<open>tcbPtr is the head of q, which is not a singleton\<close>
+  apply (rule conjI)
+   apply clarsimp
+   apply (clarsimp simp: list_queue_relation_def Let_def)
+   apply (prop_tac "tcbSchedNext tcb \<noteq> Some tcbPtr")
+    apply (fastforce dest: heap_ls_no_loops[where p=tcbPtr] simp: opt_map_def obj_at'_def)
+   apply (fastforce intro: sym_heap_remove_only'
+                     simp: prev_queue_head_def opt_map_red opt_map_upd_triv obj_at'_def)
+
+  \<comment> \<open>tcbPtr is the end of q, which is not a singleton\<close>
+  apply (intro impI)
+  apply (rule conjI)
+   apply clarsimp
+   apply (prop_tac "tcbSchedPrev tcb \<noteq> Some tcbPtr")
+    apply (fastforce dest!: heap_ls_prev_no_loops[where p=tcbPtr]
+                      simp: list_queue_relation_def opt_map_def obj_at'_def)
+   apply (subst fun_upd_swap, fastforce)
+   apply (fastforce intro: sym_heap_remove_only simp: opt_map_red opt_map_upd_triv obj_at'_def)
+
+  \<comment> \<open>tcbPtr is in the middle of q\<close>
+  apply (intro conjI impI allI)
+  apply (frule (2) list_queue_relation_neighbour_in_set[where p=tcbPtr])
+  apply (frule split_list)
+  apply clarsimp
+  apply (rename_tac xs ys)
+  apply (prop_tac "xs \<noteq> [] \<and> ys \<noteq> []")
+   apply (fastforce simp: list_queue_relation_def queue_end_valid_def)
+  apply (clarsimp simp: list_queue_relation_def)
+  apply (frule (3) ptr_in_middle_prev_next)
+  apply (frule heap_ls_distinct)
+  apply (rename_tac afterPtr beforePtr xs ys)
+  apply (frule_tac before=beforePtr and middle=tcbPtr and after=afterPtr
+                in sym_heap_remove_middle_from_chain)
+      apply (fastforce dest: last_in_set simp: opt_map_def obj_at'_def)
+     apply (fastforce dest: hd_in_set simp: opt_map_def obj_at'_def)
+    apply (rule_tac hp="tcbSchedNexts_of s" in sym_heapD2)
+     apply fastforce
+    apply (fastforce simp: opt_map_def obj_at'_def)
+   apply (fastforce simp: opt_map_def obj_at'_def)
+  apply (fastforce simp: fun_upd_swap opt_map_red opt_map_upd_triv obj_at'_def split: if_splits)
+  done
+
+lemma tcbQueuePrepend_sym_heap_sched_pointers:
+  "\<lbrace>\<lambda>s. sym_heap_sched_pointers s
+        \<and> (\<exists>ts. list_queue_relation ts q (tcbSchedNexts_of s) (tcbSchedPrevs_of s)
+                \<and> tcbPtr \<notin> set ts)
+        \<and> tcbSchedNexts_of s tcbPtr = None \<and> tcbSchedPrevs_of s tcbPtr = None\<rbrace>
+   tcbQueuePrepend q tcbPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  supply if_split[split del]
+  supply projectKOs[simp]
+  apply (clarsimp simp: tcbQueuePrepend_def)
+  apply (wpsimp wp: threadSet_wp)
+  apply (prop_tac "tcbPtr \<noteq> the (tcbQueueHead q)")
+   apply (case_tac "ts = []";
+          fastforce dest: heap_path_head simp: list_queue_relation_def tcbQueueEmpty_def)
+  apply (drule_tac a=tcbPtr and b="the (tcbQueueHead q)" in sym_heap_connect)
+    apply assumption
+   apply (clarsimp simp: list_queue_relation_def prev_queue_head_def tcbQueueEmpty_def)
+  apply (fastforce simp: fun_upd_swap opt_map_red opt_map_upd_triv obj_at'_def tcbQueueEmpty_def)
+  done
+
+lemma tcbQueueInsert_sym_heap_sched_pointers:
+  "\<lbrace>\<lambda>s. sym_heap_sched_pointers s
+        \<and> tcbSchedNexts_of s tcbPtr = None \<and> tcbSchedPrevs_of s tcbPtr = None\<rbrace>
+   tcbQueueInsert tcbPtr afterPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  supply projectKOs[simp]
+  apply (clarsimp simp: tcbQueueInsert_def)
+  \<comment> \<open>forwards step in order to name beforePtr below\<close>
+  apply (rule hoare_seq_ext[OF _ getObject_tcb_sp])
+  apply (rule hoare_seq_ext[OF _ assert_sp])
+  apply (rule hoare_ex_pre_conj[simplified conj_commute], rename_tac beforePtr)
+  apply (rule hoare_seq_ext[OF _ assert_sp])
+  apply (wpsimp wp: threadSet_wp)
+  apply normalise_obj_at'
+  apply (prop_tac "tcbPtr \<noteq> afterPtr")
+   apply (clarsimp simp: list_queue_relation_def opt_map_red obj_at'_def)
+  apply (prop_tac "tcbPtr \<noteq> beforePtr")
+   apply (fastforce dest: sym_heap_None simp: opt_map_def obj_at'_def split: option.splits)
+  apply (prop_tac "tcbSchedNexts_of s beforePtr = Some afterPtr")
+   apply (fastforce intro: sym_heapD2 simp: opt_map_def obj_at'_def)
+  apply (fastforce dest: sym_heap_insert_into_middle_of_chain
+                   simp: fun_upd_swap opt_map_red opt_map_upd_triv obj_at'_def)
+  done
+
+lemma tcbQueueAppend_sym_heap_sched_pointers:
+  "\<lbrace>\<lambda>s. sym_heap_sched_pointers s
+        \<and> (\<exists>ts. list_queue_relation ts q (tcbSchedNexts_of s) (tcbSchedPrevs_of s)
+                \<and> tcbPtr \<notin> set ts)
+        \<and> tcbSchedNexts_of s tcbPtr = None \<and> tcbSchedPrevs_of s tcbPtr = None\<rbrace>
+   tcbQueueAppend q tcbPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  supply if_split[split del]
+  supply projectKOs[simp]
+  apply (clarsimp simp: tcbQueueAppend_def)
+  apply (wpsimp wp: threadSet_wp)
+  apply (clarsimp simp: tcbQueueEmpty_def list_queue_relation_def queue_end_valid_def obj_at'_def
+                 split: if_splits)
+   apply fastforce
+  apply (drule_tac a="last ts" and b=tcbPtr in sym_heap_connect)
+    apply (fastforce dest: heap_ls_last_None)
+   apply assumption
+  apply (simp add: opt_map_red tcbQueueEmpty_def)
+  apply (subst fun_upd_swap, simp)
+  apply (fastforce simp: opt_map_red opt_map_upd_triv)
+  done
+
+lemma tcbQueued_update_sym_heap_sched_pointers[wp]:
+  "threadSet (tcbQueued_update f) tcbPtr \<lbrace>sym_heap_sched_pointers\<rbrace>"
+  by (rule sym_heap_sched_pointers_lift;
+      wpsimp wp: threadSet_tcbSchedPrevs_of threadSet_tcbSchedNexts_of)
+
+lemma tcbSchedEnqueue_sym_heap_sched_pointers[wp]:
+  "\<lbrace>sym_heap_sched_pointers and valid_sched_pointers\<rbrace>
+   tcbSchedEnqueue tcbPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  unfolding tcbSchedEnqueue_def
+  supply projectKOs[simp]
+  apply (wpsimp wp: tcbQueuePrepend_sym_heap_sched_pointers threadGet_wp
+              simp: addToBitmap_def 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 (fastforce dest!: spec[where x=tcbPtr] inQ_implies_tcbQueueds_of
+                    simp: valid_sched_pointers_def opt_pred_def opt_map_def obj_at'_def)
+  done
+
+lemma tcbSchedAppend_sym_heap_sched_pointers[wp]:
+  "\<lbrace>sym_heap_sched_pointers and valid_sched_pointers\<rbrace>
+   tcbSchedAppend tcbPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  unfolding tcbSchedAppend_def
+  supply projectKOs[simp]
+  apply (wpsimp wp: tcbQueueAppend_sym_heap_sched_pointers threadGet_wp
+              simp: addToBitmap_def 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 (fastforce dest!: spec[where x=tcbPtr] inQ_implies_tcbQueueds_of
+                    simp: valid_sched_pointers_def opt_pred_def opt_map_def obj_at'_def)
+  done
+
+lemma tcbSchedDequeue_sym_heap_sched_pointers[wp]:
+  "\<lbrace>sym_heap_sched_pointers and valid_sched_pointers\<rbrace>
+   tcbSchedDequeue tcbPtr
+   \<lbrace>\<lambda>_. sym_heap_sched_pointers\<rbrace>"
+  unfolding tcbSchedDequeue_def
+  supply projectKOs[simp]
+  apply (wpsimp wp: tcbQueueRemove_sym_heap_sched_pointers hoare_vcg_if_lift2 threadGet_wp
+              simp: bitmap_fun_defs)
+  apply (fastforce simp: ready_queue_relation_def ksReadyQueues_asrt_def inQ_def opt_pred_def
+                         opt_map_def obj_at'_def)
+  done
+
+crunches setThreadState
+  for valid_sched_pointers[wp]: valid_sched_pointers
+  and sym_heap_sched_pointers[wp]: sym_heap_sched_pointers
+  (simp: crunch_simps wp: crunch_wps threadSet_valid_sched_pointers threadSet_sched_pointers)
+
 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. (\<exists>p. t \<in> set(ksReadyQueues s p)) \<longrightarrow> runnable' st)
       and (\<lambda>s. runnable' st \<and> obj_at' tcbQueued t s \<longrightarrow> st_tcb_at' runnable' t s)
       and sch_act_simple
       and invs'\<rbrace>
@@ -4345,21 +5626,21 @@ lemma sts_invs_minor':
   including no_pre
   apply (simp add: invs'_def valid_state'_def)
   apply (rule hoare_pre)
-   apply (wp sts_valid_queues valid_irq_node_lift irqs_masked_lift
-              setThreadState_ct_not_inQ
+   apply (wp valid_irq_node_lift irqs_masked_lift
+             setThreadState_ct_not_inQ
             | simp add: cteCaps_of_def o_def)+
   apply (clarsimp simp: sch_act_simple_def)
   apply (intro conjI)
-     apply clarsimp
-    defer
-    apply (clarsimp dest!: st_tcb_at_state_refs_ofD'
-                    elim!: rsubst[where P=sym_refs]
-                   intro!: ext)
-   apply (clarsimp elim!: st_tcb_ex_cap'')
+       apply clarsimp
+      defer
+      apply (clarsimp dest!: st_tcb_at_state_refs_ofD'
+                      elim!: rsubst[where P=sym_refs]
+                     intro!: ext)
+      apply (clarsimp elim!: st_tcb_ex_cap'')
+    apply fastforce
+   apply fastforce
   apply (frule tcb_in_valid_state', clarsimp+)
-  apply (cases st, simp_all add: valid_tcb_state'_def
-                  split: Structures_H.thread_state.split_asm)
-  done
+  by (cases st; simp add: valid_tcb_state'_def split: Structures_H.thread_state.split_asm)
 
 lemma sts_cap_to'[wp]:
   "\<lbrace>ex_nonz_cap_to' p\<rbrace> setThreadState st t \<lbrace>\<lambda>rv. ex_nonz_cap_to' p\<rbrace>"
@@ -4404,12 +5685,59 @@ lemma threadSet_ct_running':
   apply wp
   done
 
+lemma tcbQueuePrepend_tcbPriority_obj_at'[wp]:
+  "tcbQueuePrepend queue tptr \<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
+  unfolding tcbQueuePrepend_def
+  supply projectKOs[simp]
+  apply (wpsimp wp: threadSet_wp)
+  by (auto simp: obj_at'_def objBits_simps ps_clear_def split: if_splits)
+
+lemma tcbQueuePrepend_tcbDomain_obj_at'[wp]:
+  "tcbQueuePrepend queue tptr \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  unfolding tcbQueuePrepend_def
+  supply projectKOs[simp]
+  apply (wpsimp wp: threadSet_wp)
+  by (auto simp: obj_at'_def objBits_simps ps_clear_def split: if_splits)
+
+lemma tcbSchedDequeue_tcbPriority[wp]:
+  "tcbSchedDequeue t \<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
+  unfolding tcbSchedDequeue_def tcbQueueRemove_def
+  by (wpsimp wp: hoare_when_weak_wp hoare_drop_imps)
+
+lemma tcbSchedDequeue_tcbDomain[wp]:
+  "tcbSchedDequeue t \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  unfolding tcbSchedDequeue_def tcbQueueRemove_def
+  by (wpsimp wp: hoare_when_weak_wp hoare_drop_imps)
+
+lemma tcbSchedEnqueue_tcbPriority_obj_at'[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
+  unfolding tcbSchedEnqueue_def setQueue_def
+  by wpsimp
+
+lemma tcbSchedEnqueue_tcbDomain_obj_at'[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  unfolding tcbSchedEnqueue_def setQueue_def
+  by wpsimp
+
+crunches rescheduleRequired
+  for tcbPriority_obj_at'[wp]: "obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'"
+  and tcbDomain_obj_at'[wp]: "obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'"
+
+lemma setThreadState_tcbPriority_obj_at'[wp]:
+  "setThreadState ts tptr \<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
+  unfolding setThreadState_def
+  supply projectKOs[simp]
+  apply (wpsimp wp: threadSet_wp)
+  apply (fastforce simp: obj_at'_def objBits_simps ps_clear_def)
+  done
+
 lemma setThreadState_tcb_in_cur_domain'[wp]:
   "\<lbrace>tcb_in_cur_domain' t'\<rbrace> setThreadState 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 setThreadState_not_st | simp)+
+  apply (simp add: setThreadState_def)
+  apply (wpsimp wp: threadSet_ct_idle_or_in_cur_domain' hoare_drop_imps)+
   done
 
 lemma asUser_global_refs':   "\<lbrace>valid_global_refs'\<rbrace> asUser t f \<lbrace>\<lambda>rv. valid_global_refs'\<rbrace>"
@@ -4555,10 +5883,13 @@ 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)
-            (set_eobject ptr etcb) (setObject ptr tcb')"
+  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
@@ -4579,21 +5910,35 @@ lemma set_eobject_corres':
    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 cte_relation_def tcb_relation_def projectKOs split: if_split_asm)+
+     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: X64_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 pdpte_relation_def pml4e_relation_def
                            is_tcb_def
                     split: if_split_asm)+
-  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 (clarsimp simp: projectKOs)
-  apply (insert e)
-  apply (clarsimp simp: other_obj_relation_def etcb_relation_def is_other_obj_relation_type split: Structures_A.kernel_object.splits Structures_H.kernel_object.splits X64_A.arch_kernel_obj.splits)
+  apply (extract_conjunct \<open>match conclusion in "ekheap_relation _ _" \<Rightarrow> -\<close>)
+   apply (simp only: ekheap_relation_def dom_fun_upd2 simp_thms)
+   apply (frule bspec, erule domI)
+   apply (rule ballI, drule(1) bspec)
+   apply (drule domD)
+   apply (clarsimp simp: obj_at'_def)
+   apply (insert e)
+   apply (clarsimp simp: other_obj_relation_def etcb_relation_def is_other_obj_relation_type
+                  split: Structures_A.kernel_object.splits kernel_object.splits arch_kernel_obj.splits)
+   apply (frule in_ready_q_tcbQueued_eq[where t=ptr])
+  apply (rename_tac s' conctcb' abstcb exttcb)
+  apply (clarsimp simp: ready_queues_relation_def Let_def)
+  apply (prop_tac "(tcbSchedNexts_of s')(ptr := tcbSchedNext tcb') = tcbSchedNexts_of s'")
+   apply (fastforce simp: opt_map_def obj_at'_def non_exst_same_def projectKOs split: option.splits)
+  apply (prop_tac "(tcbSchedPrevs_of s')(ptr := tcbSchedPrev tcb') = tcbSchedPrevs_of s'")
+   apply (fastforce simp: opt_map_def obj_at'_def non_exst_same_def projectKOs split: option.splits)
+  apply (clarsimp simp: ready_queue_relation_def opt_map_def opt_pred_def obj_at'_def inQ_def
+                        non_exst_same_def projectKOs
+                 split: option.splits)
+  apply metis
   done
 
 lemma set_eobject_corres:
@@ -4601,9 +5946,13 @@ lemma set_eobject_corres:
   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)
-                  (set_eobject add etcbu) (setObject add tcbu')"
+  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)
@@ -4630,24 +5979,27 @@ lemma set_eobject_corres:
 
 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)
-                    (ethread_set f t) (threadSet f' t)"
+  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+
+     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 simp
+  apply (clarsimp simp: obj_at'_def)
   done
 
 lemmas ethread_set_corres =
diff --git a/proof/refine/X64/Tcb_R.thy b/proof/refine/X64/Tcb_R.thy
index 9c02ebcce4..9e5297971a 100644
--- a/proof/refine/X64/Tcb_R.thy
+++ b/proof/refine/X64/Tcb_R.thy
@@ -11,7 +11,7 @@ begin
 context begin interpretation Arch . (*FIXME: arch_split*)
 
 lemma asUser_setNextPC_corres:
-  "corres dc (tcb_at t and invs) (tcb_at' t and invs')
+  "corres dc (tcb_at t and invs) invs'
              (as_user t (setNextPC v)) (asUser t (setNextPC v))"
   apply (rule asUser_corres)
   apply (rule corres_Id, simp, simp)
@@ -46,15 +46,15 @@ lemma activateThread_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)
+          apply (fastforce 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)+
-   apply (clarsimp simp: ct_in_state_def tcb_at_invs
-                  elim!: st_tcb_weakenE)
+   apply (fastforce simp: ct_in_state_def tcb_at_invs
+                   elim!: st_tcb_weakenE)
   apply (clarsimp simp: tcb_at_invs' ct_in_state'_def
                  elim!: pred_tcb'_weakenE)
   done
@@ -197,13 +197,12 @@ lemma setupReplyMaster_weak_sch_act_wf[wp]:
   apply assumption
   done
 
-crunches setupReplyMaster
-  for valid_queues[wp]: "Invariants_H.valid_queues"
-  and valid_queues'[wp]: "valid_queues'"
-  (wp: crunch_wps simp: crunch_simps)
+crunches setup_reply_master
+  for pspace_aligned[wp]: pspace_aligned
+  and pspace_distinct[wp]: pspace_distinct
 
 lemma restart_corres:
-  "corres dc (einvs  and tcb_at t) (invs' and tcb_at' t)
+  "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)
@@ -215,16 +214,19 @@ lemma restart_corres:
           apply (rule corres_split_nor[OF setThreadState_corres])
              apply clarsimp
             apply (rule corres_split[OF tcbSchedEnqueue_corres possibleSwitchTo_corres])
-             apply (wp set_thread_state_runnable_weak_valid_sched_action sts_st_tcb_at' sts_valid_queues sts_st_tcb'
-                    | clarsimp simp: valid_tcb_state'_def)+
-       apply (rule_tac Q="\<lambda>rv. valid_sched and cur_tcb" in hoare_strengthen_post)
-        apply wp
-       apply (simp add: valid_sched_def valid_sched_action_def)
-      apply (rule_tac Q="\<lambda>rv. invs' and tcb_at' t" in hoare_strengthen_post)
-       apply wp
-      apply (clarsimp simp: invs'_def valid_state'_def sch_act_wf_weak valid_pspace'_def)
-     apply wp+
-   apply (simp add: valid_sched_def invs_def tcb_at_is_etcb_at)
+              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 (fastforce simp: valid_sched_def invs_def tcb_at_is_etcb_at)
   apply (clarsimp simp add: invs'_def valid_state'_def sch_act_wf_weak)
   done
 
@@ -301,29 +303,30 @@ lemma invokeTCB_ReadRegisters_corres:
   apply (clarsimp simp: invs'_def valid_state'_def dest!: global'_no_ex_cap)
   done
 
-crunch sch_act_simple [wp]: asUser "sch_act_simple"
-  (rule: sch_act_simple_lift)
-
-lemma invs_valid_queues':
-  "invs' s \<longrightarrow> valid_queues' s"
-  by (clarsimp simp: invs'_def valid_state'_def)
-
-declare invs_valid_queues'[rule_format, elim!]
-
 lemma einvs_valid_etcbs: "einvs s \<longrightarrow> valid_etcbs s"
   by (clarsimp simp: valid_sched_def)
 
 lemma asUser_postModifyRegisters_corres:
-  "corres dc (tcb_at t) (tcb_at' t and tcb_at' ct)
+  "corres dc (tcb_at t and pspace_aligned and pspace_distinct) (tcb_at' ct)
      (arch_post_modify_registers ct t)
      (asUser t $ postModifyRegisters ct t)"
-  apply (rule corres_guard_imp)
-    apply (clarsimp simp: arch_post_modify_registers_def postModifyRegisters_def when_def)
-    apply safe
-     apply (rule asUser_setRegister_corres)
-    apply (subst submonad_asUser.return)
-    apply (rule corres_stateAssert_assume)
-     by simp+
+  apply (clarsimp simp: arch_post_modify_registers_def postModifyRegisters_def when_def)
+  apply (rule conjI; clarsimp)
+   apply (corres corres: asUser_setRegister_corres)
+  apply (subst submonad_asUser.return)
+  apply (rule corres_stateAssert_assume; simp)
+  done
+
+crunches Tcb_A.restart, IpcCancel_A.suspend
+  for pspace_aligned[wp]: pspace_aligned
+  and pspace_distinct[wp]: pspace_distinct
+
+crunches restart
+  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'
+  (simp: crunch_simps wp: crunch_wps threadSet_sched_pointers threadSet_valid_sched_pointers)
 
 lemma invokeTCB_WriteRegisters_corres:
   "corres (dc \<oplus> (=)) (einvs  and tcb_at dest and ex_nonz_cap_to dest)
@@ -354,20 +357,22 @@ lemma invokeTCB_WriteRegisters_corres:
               apply simp
              apply (wp+)[2]
            apply ((wp hoare_weak_lift_imp restart_invs'
-               | strengthen valid_sched_weak_strg einvs_valid_etcbs invs_valid_queues' invs_queues
-                            invs_weak_sch_act_wf
-               | 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]
+                   | 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_post_imp)
           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_post_imp)
           apply (fastforce simp: sch_act_wf_weak invs'_def valid_state'_def dest!: global'_no_ex_cap)
          apply wpsimp+
+   apply fastforce
+  apply fastforce
   done
 
-crunch it[wp]: suspend "\<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
@@ -388,6 +393,10 @@ lemma suspend_ResumeCurrentThread_imp_notct[wp]:
    \<lbrace>\<lambda>rv s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>"
   by (wpsimp simp: suspend_def)
 
+crunches restart, suspend
+  for cur_tcb'[wp]: cur_tcb'
+  (wp: crunch_wps threadSet_cur ignore: threadSet)
+
 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
@@ -416,6 +425,8 @@ proof -
          apply simp
         apply simp
        apply (simp | wp)+
+     apply fastforce
+    apply simp
     done
   have R: "\<And>src src' des des' xs ys. \<lbrakk> src = src'; des = des'; xs = ys \<rbrakk> \<Longrightarrow>
            corres dc (tcb_at src and tcb_at des and invs)
@@ -438,7 +449,7 @@ proof -
       apply (rule corres_split_eqr[OF asUser_getRestartPC_corres])
         apply (rule asUser_setNextPC_corres)
        apply wp+
-     apply simp+
+     apply fastforce+
     done
   show ?thesis
   apply (simp add: invokeTCB_def performTransfer_def)
@@ -462,17 +473,20 @@ proof -
                   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_post_imp)
-              apply (clarsimp simp: invs_def valid_sched_weak_strg valid_sched_def)
-             prefer 2
-             apply (rule_tac Q="\<lambda>_. invs' and tcb_at' dest" in hoare_post_imp)
-              apply (clarsimp simp: invs'_def valid_state'_def invs_weak_sch_act_wf cur_tcb'_def)
-             apply (wp mapM_x_wp' hoare_weak_lift_imp | simp)+
-         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 ((solves \<open>wpsimp wp: hoare_weak_lift_imp\<close>)+)
+                 apply (rule_tac Q="\<lambda>_. einvs and tcb_at dest" in hoare_post_imp)
+                  apply (fastforce simp: invs_def valid_sched_weak_strg valid_sched_def)
+                 prefer 2
+                 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 flip: cur_tcb'_def)+)[8]
+         apply ((wp hoare_weak_lift_imp restart_invs' | wpc |
+                 clarsimp simp: if_apply_def2 simp flip: cur_tcb'_def)+)[2]
+       apply (wp suspend_nonz_cap_to_tcb hoare_weak_lift_imp
+              | simp add: if_apply_def2 flip: cur_tcb'_def)+
      apply (fastforce simp: invs_def valid_state_def valid_pspace_def
                      dest!: idle_no_ex_cap)
+    apply clarsimp
     apply (fastforce simp: invs'_def valid_state'_def dest!: global'_no_ex_cap)
     done
 qed
@@ -515,41 +529,9 @@ lemma copyreg_invs':
    \<lbrace>\<lambda>rv. invs'\<rbrace>"
   by (rule hoare_strengthen_post, rule copyreg_invs'', simp)
 
-lemma threadSet_valid_queues_no_state:
-  "\<lbrace>Invariants_H.valid_queues and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))\<rbrace>
-     threadSet f t \<lbrace>\<lambda>_. Invariants_H.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 setObject_queues_unchanged_tcb
-             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 isRunnable_corres:
-  "corres (\<lambda>ts runn. runnable ts = runn) (tcb_at t) (tcb_at' t)
-     (get_thread_state t) (isRunnable t)"
+  "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)
@@ -570,16 +552,6 @@ lemma tcbSchedDequeue_not_queued:
   apply (wp tg_sp' [where P=\<top>, simplified] | simp)+
   done
 
-lemma tcbSchedDequeue_not_in_queue:
-  "\<And>p. \<lbrace>Invariants_H.valid_queues and tcb_at' t and valid_objs'\<rbrace> tcbSchedDequeue t
-   \<lbrace>\<lambda>rv s. t \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (rule_tac Q="\<lambda>rv. Invariants_H.valid_queues and obj_at' (Not \<circ> tcbQueued) t"
-               in hoare_post_imp)
-   apply (fastforce simp: valid_queues_def valid_queues_no_bitmap_def obj_at'_def projectKOs inQ_def )
-  apply (wp tcbSchedDequeue_not_queued tcbSchedDequeue_valid_queues |
-         simp add: valid_objs'_maxDomain valid_objs'_maxPriority)+
-  done
-
 lemma threadSet_ct_in_state':
   "(\<And>tcb. tcbState (f tcb) = tcbState tcb) \<Longrightarrow>
   \<lbrace>ct_in_state' test\<rbrace> threadSet f t \<lbrace>\<lambda>rv. ct_in_state' test\<rbrace>"
@@ -621,16 +593,17 @@ lemma tcbSchedDequeue_ct_in_state'[wp]:
   apply (rule hoare_lift_Pf [where f=ksCurThread]; wp)
   done
 
-crunch cur[wp]: tcbSchedDequeue cur_tcb'
-
 lemma sp_corres2:
-  "corres dc (valid_etcbs and weak_valid_sched_action and cur_tcb)
-             (Invariants_H.valid_queues and valid_queues' and cur_tcb' and tcb_at' t
-              and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and valid_objs' and (\<lambda>_. x \<le> maxPriority))
-                     (set_priority t x) (setPriority t x)"
+  "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 and pspace_aligned' and pspace_distinct')
+     (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])
+    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])
@@ -642,32 +615,35 @@ lemma sp_corres2:
            apply ((clarsimp
                    | wp hoare_weak_lift_imp hoare_vcg_if_lift hoare_wp_combs gts_wp
                         isRunnable_wp)+)[4]
-       apply (wp hoare_vcg_imp_lift' hoare_vcg_if_lift hoare_vcg_all_lift)
-      apply clarsimp
-      apply ((wp hoare_drop_imps hoare_vcg_if_lift hoare_vcg_all_lift
-                 isRunnable_wp threadSet_pred_tcb_no_state threadSet_valid_queues_no_state
-                 threadSet_valid_queues'_no_state threadSet_cur threadSet_valid_objs_tcbPriority_update
-                 threadSet_weak_sch_act_wf threadSet_ct_in_state'[simplified ct_in_state'_def]
-              | simp add: etcb_relation_def)+)[1]
-     apply ((wp hoare_vcg_imp_lift' hoare_vcg_if_lift hoare_vcg_all_lift hoare_vcg_disj_lift
-                tcbSchedDequeue_not_in_queue tcbSchedDequeue_valid_queues
-                tcbSchedDequeue_ct_in_state'[simplified ct_in_state'_def]
-             | simp add: etcb_relation_def)+)[2]
+       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 (force simp: state_relation_def elim: valid_objs'_maxDomain valid_objs'_maxPriority)
+  apply clarsimp
   done
 
-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)"
+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 (clarsimp simp: valid_sched_def valid_sched_action_def)
-  apply (clarsimp simp: invs'_def valid_state'_def sch_act_wf_weak)
+   apply (fastforce simp: valid_sched_def valid_sched_action_def)
+  apply (fastforce 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 x) (setMCPriority t x)"
+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)
@@ -684,26 +660,21 @@ 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)
-               (tcb_at' t)
+     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
-  apply (clarsimp simp add: threadset_corresT [OF _ x y e])
+  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]
 
-crunch sch_act[wp]: tcbSchedEnqueue "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
-  (simp: unless_def)
-
-crunch vq'[wp]: getCurThread valid_queues'
-
 crunch ioports'[wp]: tcbSchedEnqueue valid_ioports'
   (wp: crunch_wps valid_ioports_lift'' simp: crunch_simps)
 
@@ -711,37 +682,45 @@ lemma tcbSchedDequeue_sch_act_simple[wp]:
   "tcbSchedDequeue t \<lbrace>sch_act_simple\<rbrace>"
   by (wpsimp simp: sch_act_simple_def)
 
+lemma tcbSchedNext_update_tcb_cte_cases:
+  "(a, b) \<in> ran tcb_cte_cases \<Longrightarrow> a (tcbPriority_update f tcb) = a tcb"
+  unfolding tcb_cte_cases_def
+  by (case_tac tcb; fastforce simp: objBits_simps')
+
+lemma threadSet_priority_invs':
+  "\<lbrace>invs' and tcb_at' t and K (p \<le> maxPriority)\<rbrace>
+   threadSet (tcbPriority_update (\<lambda>_. p)) t
+   \<lbrace>\<lambda>_. invs'\<rbrace>"
+  apply (rule hoare_gen_asm)
+  apply (simp add: invs'_def valid_state'_def split del: if_split)
+  apply (wp threadSet_valid_pspace'
+            threadSet_sch_actT_P[where P=False, simplified]
+            threadSet_state_refs_of'T[where f'=id]
+            threadSet_iflive'T
+            threadSet_ifunsafe'T
+            threadSet_idle'T
+            valid_irq_node_lift
+            valid_irq_handlers_lift''
+            valid_ioports_lift'
+            threadSet_ctes_ofT
+            threadSet_not_inQ
+            threadSet_ct_idle_or_in_cur_domain'
+            threadSet_cur
+            untyped_ranges_zero_lift
+            sym_heap_sched_pointers_lift threadSet_valid_sched_pointers
+            threadSet_tcbSchedPrevs_of threadSet_tcbSchedNexts_of
+         | clarsimp simp: cteCaps_of_def tcbSchedNext_update_tcb_cte_cases o_def | rule refl)+
+  by (auto simp: obj_at'_def)
+
 lemma setP_invs':
   "\<lbrace>invs' and tcb_at' t and K (p \<le> maxPriority)\<rbrace> setPriority t p \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (rule hoare_gen_asm)
-  apply (simp add: setPriority_def)
-  apply (wp rescheduleRequired_all_invs_but_ct_not_inQ)
-    apply simp
-    apply (wp hoare_vcg_conj_lift hoare_vcg_imp_lift')
-      unfolding st_tcb_at'_def
-      apply (strengthen not_obj_at'_strengthen, wp)
-     apply (wp hoare_vcg_imp_lift')
-      apply (rule_tac Q="\<lambda>rv s. invs' s" in hoare_post_imp)
-       apply (clarsimp simp: invs_sch_act_wf' invs'_def invs_queues)
-       apply (clarsimp simp: valid_state'_def)
-      apply (wp hoare_drop_imps threadSet_invs_trivial,
-             simp_all add: inQ_def cong: conj_cong)[1]
-     apply (wp hoare_drop_imps threadSet_invs_trivial,
-            simp_all add: inQ_def cong: conj_cong)[1]
-    apply (wp hoare_drop_imps threadSet_invs_trivial,
-           simp_all add: inQ_def cong: conj_cong)[1]
-   apply (rule_tac Q="\<lambda>_. invs' and obj_at' (Not \<circ> tcbQueued) t
-                                  and (\<lambda>s. \<forall>d p. t \<notin> set (ksReadyQueues s (d,p)))"
-              in hoare_post_imp)
-    apply (clarsimp simp: obj_at'_def inQ_def)
-   apply (wp tcbSchedDequeue_not_queued)+
-  apply clarsimp
-  done
+  unfolding setPriority_def
+  by (wpsimp wp: rescheduleRequired_invs' threadSet_priority_invs')
 
 crunches setPriority, setMCPriority
   for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
   and valid_cap[wp]: "valid_cap' c"
-  (simp: crunch_simps)
+  (simp: crunch_simps wp: crunch_wps)
 
 lemmas setPriority_typ_ats [wp] = typ_at_lifts [OF setPriority_typ_at']
 
@@ -1026,11 +1005,6 @@ lemma setMCPriority_valid_objs'[wp]:
 crunch sch_act_simple[wp]: setMCPriority sch_act_simple
   (wp: ssa_sch_act_simple crunch_wps rule: sch_act_simple_lift simp: crunch_simps)
 
-(* For some reason, when this was embedded in a larger expression clarsimp wouldn't remove it. Adding it as a simp rule does *)
-lemma inQ_tc_corres_helper:
-  "(\<forall>d p. (\<exists>tcb. tcbQueued tcb \<and> tcbPriority tcb = p \<and> tcbDomain tcb = d \<and> (tcbQueued tcb \<longrightarrow> tcbDomain tcb \<noteq> d)) \<longrightarrow> a \<notin> set (ksReadyQueues s (d, p))) = True"
-  by clarsimp
-
 abbreviation "valid_option_prio \<equiv> case_option True (\<lambda>(p, auth). p \<le> maxPriority)"
 
 definition valid_tcb_invocation :: "tcbinvocation \<Rightarrow> bool" where
@@ -1039,9 +1013,9 @@ definition valid_tcb_invocation :: "tcbinvocation \<Rightarrow> bool" where
       | _                           \<Rightarrow> True"
 
 lemma threadcontrol_corres_helper1:
-  "\<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>"
+  "\<lbrace>einvs and simple_sched_action\<rbrace>
+   thread_set (tcb_ipc_buffer_update f) a
+   \<lbrace>\<lambda>_. weak_valid_sched_action and valid_etcbs\<rbrace>"
   apply (rule hoare_pre)
    apply (simp add: thread_set_def)
    apply (wp set_object_wp)
@@ -1054,107 +1028,75 @@ lemma threadcontrol_corres_helper1:
   apply (clarsimp simp: is_tcb_def)
   done
 
-lemma threadcontrol_corres_helper2:
-  "is_aligned a msg_align_bits \<Longrightarrow> \<lbrace>invs' and tcb_at' t\<rbrace>
-      threadSet (tcbIPCBuffer_update (\<lambda>_. a)) t
-           \<lbrace>\<lambda>x s. Invariants_H.valid_queues s \<and> valid_queues' s \<and> weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  by (wp threadSet_invs_trivial
-      | strengthen  invs_valid_queues' invs_queues invs_weak_sch_act_wf
-      | clarsimp simp: inQ_def )+
-
 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>x. weak_valid_sched_action and valid_etcbs \<rbrace>"
-  apply (rule hoare_pre)
-   apply (wp check_cap_inv | simp add:)+
-  by (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)
+  "\<lbrace>einvs and simple_sched_action\<rbrace>
+   check_cap_at cap p (check_cap_at (cap.ThreadCap cap') slot (cap_insert cap p tcb_slot))
+   \<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 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>x. Invariants_H.valid_queues and valid_queues' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)\<rbrace>"
-  apply (wp
-       | strengthen  invs_valid_queues' invs_queues invs_weak_sch_act_wf
-       | clarsimp simp: )+
+   \<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>_ s. sym_heap_sched_pointers s \<and> valid_sched_pointers s \<and> valid_tcbs' s \<and> pspace_aligned' s \<and>
+          pspace_distinct' s\<rbrace>"
+  apply (wpsimp wp:
+         | strengthen invs_sym_heap_sched_pointers invs_valid_sched_pointers
+                      invs_valid_objs' valid_objs'_valid_tcbs' invs_pspace_aligned'
+                      invs_pspace_distinct')+
   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 \<and> tcbDomain (F tcb) = tcbDomain tcb"
-  assumes a: "\<forall>tcb. tcbBoundNotification (F tcb) = tcbBoundNotification 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> tcb_at' t s \<and> (\<forall>tcb. is_aligned (tcbIPCBuffer (F tcb)) msg_align_bits)
-        \<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. \<not> tcbQueued tcb \<and> tcbQueued (F tcb)) \<longrightarrow> ex_nonz_cap_to' t s \<and> t \<noteq> ksCurThread s)
-        \<and> (\<forall>tcb. tcbQueued (F tcb) \<and> ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> tcbQueued tcb \<or> t \<noteq> ksCurThread s)\<rbrace>
-        threadSet F t
-   \<lbrace>\<lambda>rv. invs'\<rbrace>"
-proof -
-  from z have domains: "\<And>tcb. tcbDomain (F tcb) = tcbDomain tcb" by blast
-  note threadSet_sch_actT_P[where P=False, simplified]
-  have y: "\<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 valid_state'_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_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'' valid_ioports_lift''
-              threadSet_ctes_ofT
-              threadSet_not_inQ
-              threadSet_ct_idle_or_in_cur_domain'
-              threadSet_valid_dom_schedule'
-              threadSet_valid_queues'
-              threadSet_cur
-              untyped_ranges_zero_lift
-            |clarsimp simp: y z a domains cteCaps_of_def |rule refl)+
-    apply (clarsimp simp: obj_at'_def projectKOs pred_tcb_at'_def)
-    apply (clarsimp simp: cur_tcb'_def valid_irq_node'_def valid_queues'_def o_def)
-    by (fastforce simp: domains ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def z a)
-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'' valid_ioports_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>"
@@ -1165,10 +1107,6 @@ 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)
@@ -1177,6 +1115,14 @@ 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)+
 
+lemma cteDelete_pspace_aligned'[wp]:
+  "cteDelete slot e \<lbrace>pspace_aligned'\<rbrace>"
+  by (rule cteDelete_preservation; wpsimp)
+
+lemma cteDelete_pspace_distinct'[wp]:
+  "cteDelete slot e \<lbrace>pspace_distinct'\<rbrace>"
+  by (rule cteDelete_preservation; wpsimp)
+
 lemmas threadSet_invs_trivial2 =
   threadSet_invs_trivialT2 [OF all_tcbI all_tcbI all_tcbI all_tcbI, OF ball_tcb_cte_casesI]
 
@@ -1204,6 +1150,43 @@ lemma assertDerived_wp_weak:
   apply (wpsimp simp: assertDerived_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
+
+crunches cap_insert
+  for in_correct_ready_q[wp]: in_correct_ready_q
+  and ready_qs_distinct[wp]: ready_qs_distinct
+  (wp: crunch_wps ready_qs_distinct_lift)
+
+crunches cap_delete
+  for pspace_aligned[wp]: pspace_aligned
+  and pspace_distinct[wp]: pspace_distinct
+  (ignore_del: preemption_point
+   wp: crunch_wps
+   simp: crunch_simps OR_choiceE_def
+   ignore: wrap_ext_bool OR_choiceE)
+
+crunches option_update_thread
+  for aligned[wp]: "pspace_aligned"
+  and distinct[wp]: "pspace_distinct"
+
+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'"
   and y: "newroot_rel f f'"
@@ -1246,8 +1229,8 @@ lemma transferCaps_corres:
     (invokeTCB (tcbinvocation.ThreadControl a sl' b' mcp_auth p_auth e' f' g'))"
 proof -
   have P: "\<And>t v. corres dc
-               (tcb_at t)
-               (tcb_at' t)
+               (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 ()
@@ -1257,8 +1240,8 @@ proof -
     apply (safe, case_tac tcb', simp add: tcb_relation_def split: option.split)
     done
   have R: "\<And>t v. corres dc
-               (tcb_at t)
-               (tcb_at' t)
+               (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)"
@@ -1271,7 +1254,7 @@ proof -
                    (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) (tcb_at' t)
+  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)
@@ -1395,10 +1378,20 @@ proof -
              apply (rule corres_split[OF getCurThread_corres], clarsimp)
                apply (rule corres_when[OF refl rescheduleRequired_corres])
               apply (wpsimp wp: gct_wp)+
-            apply (wp hoare_drop_imp)
-            apply (rule threadcontrol_corres_helper1[unfolded pred_conj_def])
-           apply (wp hoare_drop_imp)
-           apply (wp threadcontrol_corres_helper2 | wpc | simp)+
+            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)+
+          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
@@ -1410,15 +1403,16 @@ proof -
           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_nor)
+                    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)
              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
+           apply (wp thread_set_tcb_ipc_buffer_cap_cleared_invs ready_qs_distinct_lift
                      thread_set_cte_wp_at_trivial thread_set_not_state_valid_sched
                        | simp add: ran_tcb_cap_cases)+
           apply (wp threadSet_invs_trivial
@@ -1427,15 +1421,14 @@ proof -
                    cap_delete_valid_cap cteDelete_deletes
                    cteDelete_invs'
                    | strengthen use_no_cap_to_obj_asid_strg
-                   | clarsimp simp: inQ_def inQ_tc_corres_helper)+
+                   | 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 (clarsimp simp: cte_map_def tcb_cnode_index_def obj_at'_def objBits_simps projectKOs)
     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))"
@@ -1511,36 +1504,16 @@ proof -
                                  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
-                                 cap_delete_deletes
+                                 check_cap_inv[where P=simple_sched_action]
+                                 cap_delete_deletes hoare_drop_imps
                                  cap_delete_valid_cap
-                           simp: ran_tcb_cap_cases)
+                           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_drop_imps)
-              apply ((wpsimp wp: hoare_vcg_const_imp_lift hoare_vcg_imp_lift' hoare_vcg_all_lift
-                                 threadSet_cte_wp_at' threadSet_invs_trivialT2 cteDelete_invs'
-                           simp: tcb_cte_cases_def), (fastforce+)[6])
-                  apply wpsimp
-                  apply (wpsimp wp: hoare_vcg_const_imp_lift hoare_drop_imps hoare_vcg_all_lift
-                                    threadSet_invs_trivialT2 threadSet_cte_wp_at'
-                              simp: tcb_cte_cases_def, (fastforce+)[6])
-                  apply wpsimp
-                  apply (wpsimp wp: hoare_vcg_const_imp_lift hoare_drop_imps hoare_vcg_all_lift
-                                    rescheduleRequired_invs' threadSet_cte_wp_at'
-                              simp: tcb_cte_cases_def)
-                 apply (wpsimp wp: hoare_vcg_const_imp_lift hoare_drop_imps hoare_vcg_all_lift
-                                   rescheduleRequired_invs' threadSet_invs_trivialT2 threadSet_cte_wp_at'
-                             simp: tcb_cte_cases_def, (fastforce+)[6])
-                 apply wpsimp
-                 apply (wpsimp wp: hoare_vcg_const_imp_lift hoare_drop_imps hoare_vcg_all_lift
-                                   rescheduleRequired_invs' threadSet_invs_trivialT2 threadSet_cte_wp_at'
-                             simp: tcb_cte_cases_def, (fastforce+)[6])
-                 apply wpsimp
-                 apply (wpsimp wp: hoare_vcg_const_imp_lift hoare_drop_imps hoare_vcg_all_lift
-                                   rescheduleRequired_invs' threadSet_cap_to' threadSet_invs_trivialT2
-                                   threadSet_cte_wp_at' hoare_drop_imps
-                               simp: tcb_cte_cases_def)
-                apply (clarsimp)
+               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_lift_R hoare_vcg_all_lift
                                    hoare_vcg_const_imp_lift_R hoare_vcg_const_imp_lift
                                    threadSet_valid_objs' thread_set_not_state_valid_sched
@@ -1553,9 +1526,9 @@ proof -
                         | strengthen tcb_cap_always_valid_strg
                                    tcb_at_invs
                                    use_no_cap_to_obj_asid_strg
-                        | (erule exE, clarsimp simp: word_bits_def))+)
+                        | (erule exE, clarsimp simp: word_bits_def) | wp (once) hoare_drop_imps)+)
                 apply (strengthen valid_tcb_ipc_buffer_update)
-                apply (strengthen invs_valid_objs')
+                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
@@ -1595,6 +1568,7 @@ proof -
                            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
+                           invs_psp_aligned invs_distinct
                      cong: conj_cong imp_cong
                     split: option.split_asm)
     by (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def objBits_defs
@@ -1679,7 +1653,7 @@ lemma setSchedulerAction_invs'[wp]:
   apply (simp add: setSchedulerAction_def)
   apply wp
   apply (clarsimp simp add: invs'_def valid_state'_def valid_irq_node'_def
-                valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs cur_tcb'_def
+                valid_queues_def bitmapQ_defs cur_tcb'_def
                 ct_not_inQ_def)
   apply (simp add: ct_idle_or_in_cur_domain'_def)
   done
@@ -1809,8 +1783,8 @@ lemma invokeTCB_corres:
            apply (rule TcbAcc_R.rescheduleRequired_corres)
           apply (rule corres_trivial, simp)
          apply (wpsimp wp: hoare_drop_imp)+
-   apply (clarsimp simp: valid_sched_weak_strg einvs_valid_etcbs)
-  apply (clarsimp simp: Tcb_R.invs_valid_queues' Invariants_H.invs_queues)
+   apply (fastforce dest: valid_sched_valid_queues simp: valid_sched_weak_strg einvs_valid_etcbs)
+  apply fastforce
   done
 
 lemma tcbBoundNotification_caps_safe[simp]:
@@ -1825,6 +1799,10 @@ lemma valid_bound_ntfn_lift:
   apply (wp typ_at_lifts[OF P])+
   done
 
+crunches 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
@@ -1837,7 +1815,7 @@ lemma bindNotification_invs':
   apply (simp add: bindNotification_def invs'_def valid_state'_def)
   apply (rule hoare_seq_ext[OF _ get_ntfn_sp'])
   apply (rule hoare_pre)
-   apply (wp set_ntfn_valid_pspace' sbn_sch_act' sbn_valid_queues valid_irq_node_lift
+   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)+
@@ -2008,8 +1986,8 @@ lemma eq_ucast_word8[simp]:
   done
 
 lemma checkPrio_corres:
-  "corres (ser \<oplus> dc) (tcb_at auth) (tcb_at' auth)
-     (check_prio p auth) (checkPrio p auth)"
+  "corres (ser \<oplus> dc) (tcb_at auth and pspace_aligned and pspace_distinct) \<top>
+          (check_prio p auth) (checkPrio p auth)"
   apply (simp add: check_prio_def checkPrio_def)
   apply (rule corres_guard_imp)
     apply (simp add: liftE_bindE)
@@ -2031,8 +2009,9 @@ lemma decodeSetPriority_corres:
   "\<lbrakk> cap_relation cap cap'; is_thread_cap cap;
      list_all2 (\<lambda>(c, sl) (c', sl'). cap_relation c c' \<and> sl' = cte_map sl) extras extras' \<rbrakk> \<Longrightarrow>
    corres (ser \<oplus> tcbinv_relation)
-       (cur_tcb and valid_etcbs and (\<lambda>s. \<forall>x \<in> set extras. s \<turnstile> (fst x)))
-       (invs' 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';
@@ -2050,8 +2029,9 @@ lemma decodeSetMCPriority_corres:
   "\<lbrakk> cap_relation cap cap'; is_thread_cap cap;
      list_all2 (\<lambda>(c, sl) (c', sl'). cap_relation c c' \<and> sl' = cte_map sl) extras extras' \<rbrakk> \<Longrightarrow>
    corres (ser \<oplus> tcbinv_relation)
-       (cur_tcb and valid_etcbs and (\<lambda>s. \<forall>x \<in> set extras. s \<turnstile> (fst x)))
-       (invs' 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_mcpriority args cap slot extras)
        (decodeSetMCPriority args cap' extras')"
   apply (cases args; cases extras; cases extras';
@@ -2065,12 +2045,6 @@ lemma decodeSetMCPriority_corres:
      apply (wpsimp simp: valid_cap_def valid_cap'_def)+
   done
 
-lemma valid_objs'_maxPriority':
-  "\<And>s t. \<lbrakk> valid_objs' s; tcb_at' t s \<rbrakk> \<Longrightarrow> obj_at' (\<lambda>tcb. tcbMCP tcb \<le> maxPriority) t s"
-  apply (erule (1) valid_objs_valid_tcbE)
-  apply (clarsimp simp: valid_tcb'_def)
-  done
-
 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_def)
@@ -2164,8 +2138,9 @@ lemma decodeSetSchedParams_corres:
   "\<lbrakk> cap_relation cap cap'; is_thread_cap cap;
      list_all2 (\<lambda>(c, sl) (c', sl'). cap_relation c c' \<and> sl' = cte_map sl) extras extras' \<rbrakk> \<Longrightarrow>
    corres (ser \<oplus> tcbinv_relation)
-       (cur_tcb and valid_etcbs and (\<lambda>s. \<forall>x \<in> set extras. s \<turnstile> (fst x)))
-       (invs' 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_sched_params args cap slot extras)
        (decodeSetSchedParams args cap' extras')"
   apply (simp add: decode_set_sched_params_def decodeSetSchedParams_def)
@@ -2588,10 +2563,9 @@ notes if_cong[cong] shows
 
 lemma decodeUnbindNotification_corres:
   "corres (ser \<oplus> tcbinv_relation)
-      (tcb_at t)
-      (tcb_at' t)
-     (decode_unbind_notification (cap.ThreadCap t))
-     (decodeUnbindNotification (capability.ThreadCap t))"
+          (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+          (decode_unbind_notification (cap.ThreadCap t))
+          (decodeUnbindNotification (capability.ThreadCap t))"
   apply (simp add: decode_unbind_notification_def decodeUnbindNotification_def)
   apply (rule corres_guard_imp)
     apply (rule corres_split_eqrE)
@@ -2640,7 +2614,7 @@ lemma decodeTCBInvocation_corres:
              corres_guard_imp[OF decodeUnbindNotification_corres]
              corres_guard_imp[OF decodeSetTLSBase_corres],
          simp_all add: valid_cap_simps valid_cap_simps' invs_def valid_sched_def)
-  apply (auto simp: list_all2_map1 list_all2_map2
+  apply (auto simp: list_all2_map1 list_all2_map2 valid_state_def
              elim!: list_all2_mono)
   done
 
diff --git a/proof/refine/X64/Untyped_R.thy b/proof/refine/X64/Untyped_R.thy
index 551b5e7c2b..77f9bdb329 100644
--- a/proof/refine/X64/Untyped_R.thy
+++ b/proof/refine/X64/Untyped_R.thy
@@ -291,9 +291,9 @@ next
                           toInteger_nat fromInteger_nat wordBits_def)
          apply (simp add: not_le)
         apply (rule whenE_throwError_corres, simp)
-         apply (clarsimp simp: fromAPIType_def X64_H.fromAPIType_def)
+         apply (clarsimp simp: fromAPIType_def)
         apply (rule whenE_throwError_corres, simp)
-         apply (clarsimp simp: fromAPIType_def X64_H.fromAPIType_def)
+         apply (clarsimp simp: fromAPIType_def)
         apply (rule_tac r' = "\<lambda>cap cap'. cap_relation cap cap'"
                 in corres_splitEE[OF corres_if])
              apply simp
@@ -1401,16 +1401,6 @@ crunch nosch[wp]: insertNewCaps "\<lambda>s. P (ksSchedulerAction s)"
 
 crunch exst[wp]: set_cdt "\<lambda>s. P (exst s)"
 
-(*FIXME: Move to StateRelation*)
-lemma state_relation_schact[elim!]:
-  "(s,s') \<in> state_relation \<Longrightarrow> sched_act_relation (scheduler_action s) (ksSchedulerAction s')"
-  apply (simp add: state_relation_def)
-  done
-
-lemma state_relation_queues[elim!]: "(s,s') \<in> state_relation \<Longrightarrow> ready_queues_relation (ready_queues s) (ksReadyQueues s')"
-  apply (simp add: state_relation_def)
-  done
-
 lemma set_original_symb_exec_l:
   "corres_underlying {(s, s'). f (kheap s) (exst s) s'} nf 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)
@@ -1441,6 +1431,10 @@ lemma updateNewFreeIndex_noop_psp_corres:
         | simp add: updateTrackedFreeIndex_def getSlotCap_def)+
   done
 
+crunches 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]
 shows
@@ -3718,8 +3712,8 @@ lemma updateFreeIndex_clear_invs':
        apply (simp add:updateCap_def)
        apply (wp setCTE_irq_handlers' getCTE_wp)
       apply (simp add:updateCap_def)
-      apply (wp irqs_masked_lift valid_queues_lift' cur_tcb_lift ct_idle_or_in_cur_domain'_lift
-                hoare_vcg_disj_lift untyped_ranges_zero_lift getCTE_wp setCTE_ioports'
+      apply (wp irqs_masked_lift cur_tcb_lift ct_idle_or_in_cur_domain'_lift setCTE_ioports'
+                hoare_vcg_disj_lift untyped_ranges_zero_lift getCTE_wp valid_bitmaps_lift
                | wp (once) hoare_use_eq[where f="gsUntypedZeroRanges"]
                | simp add: getSlotCap_def
                | simp add: cte_wp_at_ctes_of)+
@@ -4305,14 +4299,12 @@ context begin interpretation Arch . (*FIXME: arch_split*)
 lemma resetUntypedCap_corres:
   "untypinv_relation ui ui'
     \<Longrightarrow> corres (dc \<oplus> dc)
-    (invs 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)
@@ -5155,7 +5147,7 @@ lemma inv_untyped_corres':
       apply (clarsimp simp only: pred_conj_def invs ui)
       apply (strengthen vui)
       apply (cut_tac vui invs invs')
-      apply (clarsimp simp: cte_wp_at_caps_of_state valid_sched_etcbs)
+      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
@@ -5169,12 +5161,6 @@ crunch pred_tcb_at'[wp]: insertNewCap "pred_tcb_at' proj P t"
 crunch pred_tcb_at'[wp]: doMachineOp "pred_tcb_at' proj P t"
   (wp: crunch_wps)
 
-
-crunch irq_node[wp]: set_thread_state "\<lambda>s. P (interrupt_irq_node s)"
-crunch ctes_of [wp]: setQueue "\<lambda>s. P (ctes_of s)"
-crunch cte_wp_at [wp]: setQueue "cte_wp_at' P p"
-  (simp: cte_wp_at_ctes_of)
-
 lemma sts_valid_untyped_inv':
   "\<lbrace>valid_untyped_inv' ui\<rbrace> setThreadState st t \<lbrace>\<lambda>rv. valid_untyped_inv' ui\<rbrace>"
   apply (cases ui, simp add: ex_cte_cap_to'_def)
@@ -5211,11 +5197,8 @@ crunch norqL1[wp]: insertNewCap "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
   (wp: crunch_wps)
 crunch norqL2[wp]: insertNewCap "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
   (wp: crunch_wps)
-crunch ct[wp]: insertNewCap "\<lambda>s. P (ksCurThread s)"
-  (wp: crunch_wps)
 crunch state_refs_of'[wp]: insertNewCap "\<lambda>s. P (state_refs_of' s)"
   (wp: crunch_wps)
-crunch cteCaps[wp]: updateNewFreeIndex "\<lambda>s. P (cteCaps_of s)"
 crunch if_unsafe_then_cap'[wp]: updateNewFreeIndex "if_unsafe_then_cap'"
 
 lemma insertNewCap_ifunsafe'[wp]:
@@ -5320,39 +5303,29 @@ lemma insertNewCap_ioports':
   apply (wpsimp wp: setCTE_ioports' getCTE_wp)
   by (clarsimp simp: cte_wp_at_ctes_of)
 
-crunch irq_states' [wp]: insertNewCap valid_irq_states'
-  (wp: getCTE_wp')
-
-crunch vq'[wp]: insertNewCap valid_queues'
-  (wp: crunch_wps)
-
-crunch irqs_masked' [wp]: insertNewCap irqs_masked'
-  (wp: crunch_wps rule: irqs_masked_lift)
-
-crunch valid_machine_state'[wp]: insertNewCap valid_machine_state'
-  (wp: crunch_wps)
-
-crunch pspace_domain_valid[wp]: insertNewCap pspace_domain_valid
-  (wp: crunch_wps)
-
-crunch ct_not_inQ[wp]: insertNewCap "ct_not_inQ"
-  (wp: crunch_wps)
-
-crunch tcbState_inv[wp]: insertNewCap "obj_at' (\<lambda>tcb. P (tcbState tcb)) t"
-  (wp: crunch_simps hoare_drop_imps)
-crunch tcbDomain_inv[wp]: insertNewCap "obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t"
-  (wp: crunch_simps hoare_drop_imps)
-crunch tcbPriority_inv[wp]: insertNewCap "obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t"
+crunches insertNewCap
+  for irq_states'[wp]: valid_irq_states'
+  and irqs_masked' [wp]: irqs_masked'
+  and valid_machine_state'[wp]: valid_machine_state'
+  and pspace_domain_valid[wp]: pspace_domain_valid
+  and ct_not_inQ[wp]: "ct_not_inQ"
+  and tcbState_inv[wp]: "obj_at' (\<lambda>tcb. P (tcbState tcb)) 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 sched_queues_projs[wp]: "\<lambda>s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)"
+  and tcbQueueds_of[wp]: "\<lambda>s. P (tcbQueued |< tcbs_of' s)"
+  and valid_sched_pointers[wp]: valid_sched_pointers
   (wp: crunch_simps hoare_drop_imps)
 
 lemma insertNewCap_ct_idle_or_in_cur_domain'[wp]:
   "\<lbrace>ct_idle_or_in_cur_domain' and ct_active'\<rbrace> insertNewCap parent slot cap \<lbrace>\<lambda>_. ct_idle_or_in_cur_domain'\<rbrace>"
-apply (wp ct_idle_or_in_cur_domain'_lift_futz[where Q=\<top>])
-apply (rule_tac Q="\<lambda>_. obj_at' (\<lambda>tcb. tcbState tcb \<noteq> Structures_H.thread_state.Inactive) t and obj_at' (\<lambda>tcb. d = tcbDomain tcb) t"
-             in hoare_strengthen_post)
-apply (wp | clarsimp elim: obj_at'_weakenE)+
-apply (auto simp: obj_at'_def)
-done
+  apply (wp ct_idle_or_in_cur_domain'_lift_futz[where Q=\<top>])
+   apply (rule_tac Q="\<lambda>_. obj_at' (\<lambda>tcb. tcbState tcb \<noteq> Structures_H.thread_state.Inactive) t and
+                          obj_at' (\<lambda>tcb. d = tcbDomain tcb) t"
+                in hoare_strengthen_post)
+    apply (wp | clarsimp elim: obj_at'_weakenE)+
+    apply (auto simp: obj_at'_def)
+  done
 
 crunch ksDomScheduleIdx[wp]: insertNewCap "\<lambda>s. P (ksDomScheduleIdx s)"
   (wp: crunch_simps hoare_drop_imps)
@@ -5419,8 +5392,8 @@ lemma insertNewCap_invs':
   apply (simp add: invs'_def valid_state'_def)
   apply (rule hoare_pre)
    apply (wp insertNewCap_valid_pspace' sch_act_wf_lift
-             valid_queues_lift cur_tcb_lift tcb_in_cur_domain'_lift
-             insertNewCap_valid_global_refs'
+             cur_tcb_lift tcb_in_cur_domain'_lift sym_heap_sched_pointers_lift
+             insertNewCap_valid_global_refs' valid_bitmaps_lift
              valid_arch_state_lift' insertNewCap_ioports'
              valid_irq_node_lift insertNewCap_valid_irq_handlers)
   apply (clarsimp simp: cte_wp_at_ctes_of)
@@ -5502,9 +5475,6 @@ lemma createNewCaps_cap_to':
   apply fastforce
   done
 
-crunch it[wp]: copyGlobalMappings "\<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
@@ -5535,8 +5505,6 @@ lemma createNewCaps_IRQHandler[wp]:
    apply (wp | wpc | simp add: image_def | rule hoare_pre_cont)+
   done
 
-crunch ksIdleThread[wp]: updateCap "\<lambda>s. P (ksIdleThread s)"
-
 lemma createNewCaps_ct_active':
   "\<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
diff --git a/proof/refine/X64/VSpace_R.thy b/proof/refine/X64/VSpace_R.thy
index 51627c6037..89971ad2a9 100644
--- a/proof/refine/X64/VSpace_R.thy
+++ b/proof/refine/X64/VSpace_R.thy
@@ -111,7 +111,7 @@ lemma asidBits_asid_bits[simp]:
                 asidHighBits_def asid_low_bits_def)
 
 lemma handleVMFault_corres:
-  "corres (fr \<oplus> dc) (tcb_at thread) (tcb_at' thread)
+  "corres (fr \<oplus> dc) (tcb_at thread and pspace_aligned and pspace_distinct) \<top>
           (handle_vm_fault thread fault) (handleVMFault thread fault)"
   apply (simp add: X64_H.handleVMFault_def handle_vm_fault_def)
   apply (rule corres_guard_imp)
@@ -804,7 +804,7 @@ lemma message_info_from_data_eqv:
 
 lemma setMessageInfo_corres:
  "mi' = message_info_map mi \<Longrightarrow>
-  corres dc (tcb_at t) (tcb_at' t)
+  corres dc (tcb_at t and pspace_aligned and pspace_distinct) \<top>
          (set_message_info t mi) (setMessageInfo t mi')"
   apply (simp add: setMessageInfo_def set_message_info_def)
   apply (subgoal_tac "wordFromMessageInfo (message_info_map mi) =
@@ -1707,22 +1707,6 @@ crunches storePDE, storePDPTE, storePML4E
   and norqL2[wp]: "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
   (simp: updateObject_default_def)
 
-lemma storePDE_valid_queues [wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> storePDE p pde \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  by (wp valid_queues_lift | simp add: pred_tcb_at'_def)+
-
-lemma storePDPTE_valid_queues [wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> storePDPTE p pde \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  by (wp valid_queues_lift | simp add: pred_tcb_at'_def)+
-
-lemma storePML4E_valid_queues [wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> storePML4E p pde \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  by (wp valid_queues_lift | simp add: pred_tcb_at'_def)+
-
-lemma storePDE_valid_queues' [wp]:
-  "\<lbrace>valid_queues'\<rbrace> storePDE p pde \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  by (wp valid_queues_lift')
-
 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)
@@ -1747,10 +1731,6 @@ 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)+
 
-lemma storePDPTE_valid_queues' [wp]:
-  "\<lbrace>valid_queues'\<rbrace> storePDPTE p pdpte \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  by (wp valid_queues_lift')
-
 lemma storePDPTE_state_refs' [wp]:
   "\<lbrace>\<lambda>s. P (state_refs_of' s)\<rbrace> storePDPTE p pdpte \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
   apply (clarsimp simp: storePDPTE_def)
@@ -1775,10 +1755,6 @@ lemma setObject_pdpte_ksInt [wp]:
   "\<lbrace>\<lambda>s. P (ksInterruptState s)\<rbrace> setObject p (pdpte::pdpte) \<lbrace>\<lambda>_. \<lambda>s. P (ksInterruptState s)\<rbrace>"
   by (wp setObject_ksInterrupt updateObject_default_inv|simp)+
 
-lemma storePML4E_valid_queues' [wp]:
-  "\<lbrace>valid_queues'\<rbrace> storePML4E p pml4e \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  by (wp valid_queues_lift')
-
 lemma storePML4E_state_refs' [wp]:
   "\<lbrace>\<lambda>s. P (state_refs_of' s)\<rbrace> storePML4E p pml4e \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
   apply (clarsimp simp: storePML4E_def)
@@ -2067,6 +2043,26 @@ crunches storePTE, storePDE, storePDPTE, storePML4E
   and gsUntypedZeroRanges[wp]: "\<lambda>s. P (gsUntypedZeroRanges s)"
   (wp: setObject_ksPSpace_only updateObject_default_inv)
 
+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 storePDPTE_tcbs_of'[wp]:
+  "storePDPTE c (pdpte::pdpte) \<lbrace>\<lambda>s. P' (tcbs_of' s)\<rbrace>"
+  unfolding storePDPTE_def
+  by setObject_easy_cases
+
+lemma storePML4E_tcbs_of'[wp]:
+  "storePML4E c (pml4e::pml4e) \<lbrace>\<lambda>s. P' (tcbs_of' s)\<rbrace>"
+  unfolding storePML4E_def
+  by setObject_easy_cases
+
 lemma storePDE_invs[wp]:
   "\<lbrace>invs' and valid_pde' pde\<rbrace>
       storePDE p pde
@@ -2077,7 +2073,7 @@ lemma storePDE_invs[wp]:
              irqs_masked_lift
              valid_arch_state_lift' valid_irq_node_lift
              cur_tcb_lift valid_irq_handlers_lift'' valid_ioports_lift''
-             untyped_ranges_zero_lift
+             untyped_ranges_zero_lift valid_bitmaps_lift
            | simp add: cteCaps_of_def o_def)+
   apply clarsimp
   done
@@ -2092,7 +2088,7 @@ lemma storePDPTE_invs[wp]:
              irqs_masked_lift
              valid_arch_state_lift' valid_irq_node_lift
              cur_tcb_lift valid_irq_handlers_lift'' valid_ioports_lift''
-             untyped_ranges_zero_lift
+             untyped_ranges_zero_lift valid_bitmaps_lift
            | simp add: cteCaps_of_def o_def)+
   apply clarsimp
   done
@@ -2107,7 +2103,7 @@ lemma storePML4E_invs[wp]:
              irqs_masked_lift
              valid_arch_state_lift' valid_irq_node_lift
              cur_tcb_lift valid_irq_handlers_lift'' valid_ioports_lift''
-             untyped_ranges_zero_lift
+             untyped_ranges_zero_lift valid_bitmaps_lift
            | simp add: cteCaps_of_def o_def)+
   apply clarsimp
   done
@@ -2135,14 +2131,6 @@ crunch norqL1[wp]: storePTE "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
 crunch norqL2[wp]: storePTE "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
   (simp: updateObject_default_def)
 
-lemma storePTE_valid_queues [wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> storePTE p pde \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  by (wp valid_queues_lift | simp add: pred_tcb_at'_def)+
-
-lemma storePTE_valid_queues' [wp]:
-  "\<lbrace>valid_queues'\<rbrace> storePTE p pde \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  by (wp valid_queues_lift')
-
 lemma storePTE_iflive [wp]:
   "\<lbrace>if_live_then_nonz_cap'\<rbrace> storePTE p pte \<lbrace>\<lambda>rv. if_live_then_nonz_cap'\<rbrace>"
   apply (simp add: storePTE_def)
@@ -2194,8 +2182,6 @@ lemma storePTE_valid_objs [wp]:
   apply (clarsimp simp: valid_obj'_def)
   done
 
-crunch no_0_obj' [wp]: storePTE no_0_obj'
-
 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
@@ -2259,7 +2245,7 @@ lemma storePTE_invs [wp]:
    apply (wp sch_act_wf_lift valid_global_refs_lift' irqs_masked_lift
              valid_arch_state_lift' valid_irq_node_lift
              cur_tcb_lift valid_irq_handlers_lift'' valid_ioports_lift''
-             untyped_ranges_zero_lift
+             untyped_ranges_zero_lift valid_bitmaps_lift
            | simp add: cteCaps_of_def o_def)+
   apply clarsimp
   done
@@ -2305,14 +2291,6 @@ 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_valid_queues [wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  by (wp valid_queues_lift | simp add: pred_tcb_at'_def)+
-
-lemma setASIDPool_valid_queues' [wp]:
-  "\<lbrace>valid_queues'\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  by (wp valid_queues_lift')
-
 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
@@ -2418,6 +2396,10 @@ 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_state'_def valid_pspace'_def)
@@ -2426,7 +2408,7 @@ lemma setASIDPool_invs [wp]:
              valid_arch_state_lift' valid_irq_node_lift
              cur_tcb_lift valid_irq_handlers_lift'' valid_ioports_lift''
              untyped_ranges_zero_lift
-             updateObject_default_inv
+             updateObject_default_inv valid_bitmaps_lift
            | simp add: cteCaps_of_def
            | rule setObject_ksPSpace_only)+
   apply (clarsimp simp add: setObject_def o_def)
diff --git a/spec/design/skel/KernelInit_H.thy b/spec/design/skel/KernelInit_H.thy
index 490c64222a..063d5c90c3 100644
--- a/spec/design/skel/KernelInit_H.thy
+++ b/spec/design/skel/KernelInit_H.thy
@@ -65,7 +65,7 @@ newKernelState_def:
         ksDomSchedule = newKSDomSchedule,
         ksCurDomain = newKSCurDomain,
         ksDomainTime = newKSDomainTime,
-        ksReadyQueues = const [],
+        ksReadyQueues = const (TcbQueue None None),
         ksReadyQueuesL1Bitmap = const 0,
         ksReadyQueuesL2Bitmap = const 0,
         ksCurThread = error [],
diff --git a/spec/design/skel/KernelStateData_H.thy b/spec/design/skel/KernelStateData_H.thy
index 82a0ab755c..abb803e422 100644
--- a/spec/design/skel/KernelStateData_H.thy
+++ b/spec/design/skel/KernelStateData_H.thy
@@ -30,9 +30,7 @@ requalify_types (in Arch)
 
 subsection "The Kernel State"
 
-type_synonym ready_queue = "machine_word list"
-translations
-(type) "machine_word list" <= (type) "ready_queue"
+type_synonym ready_queue = tcb_queue
 
 text \<open>We pull a fast one on haskell here ... although Haskell expects
 a KernelMonad which is a StateT monad in KernelData that wraps a MachineMonad,
@@ -85,7 +83,7 @@ where
     return r
   od"
 
-#INCLUDE_HASKELL SEL4/Model/StateData.lhs NOT doMachineOp KernelState ReadyQueue Kernel assert stateAssert findM funArray newKernelState capHasProperty
-#INCLUDE_HASKELL SEL4/Model/StateData.lhs decls_only ONLY capHasProperty
+#INCLUDE_HASKELL SEL4/Model/StateData.lhs decls_only ONLY capHasProperty ksReadyQueues_asrt ready_qs_runnable idleThreadNotQueued
+#INCLUDE_HASKELL SEL4/Model/StateData.lhs NOT doMachineOp KernelState ReadyQueue Kernel assert stateAssert findM funArray newKernelState capHasProperty ksReadyQueues_asrt ready_qs_runnable idleThreadNotQueued
 
 end
diff --git a/spec/haskell/src/SEL4/Kernel/Thread.lhs b/spec/haskell/src/SEL4/Kernel/Thread.lhs
index 0a0fcff881..e3215bd567 100644
--- a/spec/haskell/src/SEL4/Kernel/Thread.lhs
+++ b/spec/haskell/src/SEL4/Kernel/Thread.lhs
@@ -19,7 +19,7 @@ We use the C preprocessor to select a target architecture.
 \begin{impdetails}
 
 % {-# BOOT-IMPORTS: SEL4.Model SEL4.Machine SEL4.Object.Structures SEL4.Object.Instances() SEL4.API.Types #-}
-% {-# BOOT-EXPORTS: setDomain setMCPriority setPriority getThreadState setThreadState setBoundNotification getBoundNotification doIPCTransfer isRunnable restart suspend  doReplyTransfer tcbSchedEnqueue tcbSchedDequeue rescheduleRequired timerTick possibleSwitchTo #-}
+% {-# BOOT-EXPORTS: setDomain setMCPriority setPriority getThreadState setThreadState setBoundNotification getBoundNotification doIPCTransfer isRunnable restart suspend  doReplyTransfer tcbSchedEnqueue tcbSchedDequeue rescheduleRequired timerTick possibleSwitchTo tcbQueueEmpty tcbQueuePrepend tcbQueueAppend tcbQueueInsert tcbQueueRemove #-}
 
 > import Prelude hiding (Word)
 > import SEL4.Config
@@ -35,6 +35,7 @@ We use the C preprocessor to select a target architecture.
 > import Data.Bits hiding (countLeadingZeros)
 > import Data.Array
 > import Data.WordLib
+> import Data.Maybe(fromJust, isJust)
 
 \end{impdetails}
 
@@ -405,13 +406,15 @@ Note also that the level 2 bitmap array is stored in reverse in order to get bet
 
 > chooseThread :: Kernel ()
 > chooseThread = do
+>     stateAssert ksReadyQueues_asrt ""
+>     stateAssert ready_qs_runnable "threads in the ready queues are runnable'"
 >     curdom <- if numDomains > 1 then curDomain else return 0
 >     l1 <- getReadyQueuesL1Bitmap curdom
 >     if l1 /= 0
 >         then do
 >             prio <- getHighestPrio curdom
 >             queue <- getQueue curdom prio
->             let thread = head queue
+>             let thread = fromJust $ tcbQueueHead queue
 >             runnable <- isRunnable thread
 >             assert runnable "Scheduled a non-runnable thread"
 >             switchToThread thread
@@ -424,6 +427,10 @@ To switch to a new thread, we call the architecture-specific thread switch funct
 
 > switchToThread :: PPtr TCB -> Kernel ()
 > switchToThread thread = do
+>         runnable <- isRunnable thread
+>         assert runnable "thread must be runnable"
+>         stateAssert ksReadyQueues_asrt ""
+>         stateAssert ready_qs_runnable "threads in the ready queues are runnable'"
 >         Arch.switchToThread thread
 >         tcbSchedDequeue thread
 >         setCurThread thread
@@ -432,6 +439,7 @@ Switching to the idle thread is similar, except that we call a different archite
 
 > switchToIdleThread :: Kernel ()
 > switchToIdleThread = do
+>         stateAssert ready_qs_runnable "threads in the ready queues are runnable'"
 >         thread <- getIdleThread
 >         Arch.switchToIdleThread
 >         setCurThread thread
@@ -597,41 +605,135 @@ The following two functions place a thread at the beginning or end of its priori
 >         modifyReadyQueuesL1Bitmap tdom $
 >             (\w -> w .&. (complement $ bit l1index))
 
+> tcbQueueEmpty :: TcbQueue -> Bool
+> tcbQueueEmpty queue = tcbQueueHead queue == Nothing
+
+> tcbQueuePrepend :: TcbQueue -> PPtr TCB -> Kernel TcbQueue
+> tcbQueuePrepend queue tcbPtr = do
+>     q <- if tcbQueueEmpty queue
+>              then return $ queue { tcbQueueEnd = Just tcbPtr }
+>              else do
+>                  threadSet (\t -> t { tcbSchedNext = tcbQueueHead queue }) tcbPtr
+>                  threadSet (\t -> t { tcbSchedPrev = Just tcbPtr }) (fromJust $ tcbQueueHead queue)
+>                  return $ queue
+
+>     return $ q { tcbQueueHead = Just tcbPtr}
+
+> tcbQueueAppend :: TcbQueue -> PPtr TCB -> Kernel TcbQueue
+> tcbQueueAppend queue tcbPtr = do
+>     q <- if tcbQueueEmpty queue
+>              then return $ queue { tcbQueueHead = Just tcbPtr }
+>              else do
+>                  threadSet (\t -> t { tcbSchedPrev = tcbQueueEnd queue }) tcbPtr
+>                  threadSet (\t -> t { tcbSchedNext = Just tcbPtr }) (fromJust $ tcbQueueEnd queue)
+>                  return $ queue
+
+>     return $ q { tcbQueueEnd = Just tcbPtr}
+
+Insert a thread into the middle of a queue, immediately before afterPtr, where afterPtr is not the head of the queue
+
+> tcbQueueInsert :: PPtr TCB -> PPtr TCB -> Kernel ()
+> tcbQueueInsert tcbPtr afterPtr = do
+>    tcb <- getObject afterPtr
+>    beforePtrOpt <- return $ tcbSchedPrev tcb
+>    assert (beforePtrOpt /= Nothing) "afterPtr must not be the head of the list"
+>    beforePtr <- return $ fromJust beforePtrOpt
+>    assert (beforePtr /= afterPtr) "the tcbSchedPrev pointer of a TCB must never point to itself"
+
+>    threadSet (\t -> t { tcbSchedPrev = Just beforePtr }) tcbPtr
+>    threadSet (\t -> t { tcbSchedNext = Just afterPtr}) tcbPtr
+>    threadSet (\t -> t { tcbSchedPrev = Just tcbPtr }) afterPtr
+>    threadSet (\t -> t { tcbSchedNext = Just tcbPtr }) beforePtr
+
+Remove a thread from a queue, which must originally contain the thread
+
+> tcbQueueRemove :: TcbQueue -> PPtr TCB -> Kernel TcbQueue
+> tcbQueueRemove queue tcbPtr = do
+>     tcb <- getObject tcbPtr
+>     beforePtrOpt <- return $ tcbSchedPrev tcb
+>     afterPtrOpt <- return $ tcbSchedNext tcb
+
+>     if tcbQueueHead queue == Just tcbPtr && tcbQueueEnd queue == Just tcbPtr
+
+The queue is the singleton containing tcbPtr
+
+>         then return $ TcbQueue { tcbQueueHead = Nothing, tcbQueueEnd = Nothing }
+>         else
+>             if tcbQueueHead queue == Just tcbPtr
+
+tcbPtr is the head of the queue
+
+>                 then do
+>                     assert (afterPtrOpt /= Nothing) "the queue is not a singleton"
+>                     threadSet (\t -> t { tcbSchedPrev = Nothing }) (fromJust $ afterPtrOpt)
+>                     threadSet (\t -> t { tcbSchedNext = Nothing }) tcbPtr
+>                     return $ queue { tcbQueueHead = afterPtrOpt }
+>                 else
+>                     if tcbQueueEnd queue == Just tcbPtr
+
+tcbPtr is the end of the queue
+
+>                         then do
+>                             assert (beforePtrOpt /= Nothing) "the queue is not a singleton"
+>                             threadSet (\t -> t { tcbSchedNext = Nothing }) (fromJust $ beforePtrOpt)
+>                             threadSet (\t -> t { tcbSchedPrev = Nothing }) tcbPtr
+>                             return $ queue { tcbQueueEnd = beforePtrOpt }
+>                         else do
+
+tcbPtr is in the middle of the queue
+
+>                             assert (afterPtrOpt /= Nothing) "the queue is not a singleton"
+>                             assert (beforePtrOpt /= Nothing) "the queue is not a singleton"
+>                             threadSet (\t -> t { tcbSchedNext = afterPtrOpt }) (fromJust $ beforePtrOpt)
+>                             threadSet (\t -> t { tcbSchedPrev = beforePtrOpt }) (fromJust $ afterPtrOpt)
+>                             threadSet (\t -> t { tcbSchedPrev = Nothing }) tcbPtr
+>                             threadSet (\t -> t { tcbSchedNext = Nothing }) tcbPtr
+>                             return queue
+
 > tcbSchedEnqueue :: PPtr TCB -> Kernel ()
 > tcbSchedEnqueue thread = do
+>     stateAssert ksReadyQueues_asrt ""
+>     runnable <- isRunnable thread
+>     assert runnable "thread must be runnable"
 >     queued <- threadGet tcbQueued thread
 >     unless queued $ do
 >         tdom <- threadGet tcbDomain thread
 >         prio <- threadGet tcbPriority thread
 >         queue <- getQueue tdom prio
->         setQueue tdom prio $ thread : queue
->         when (null queue) $ addToBitmap tdom prio
+>         when (tcbQueueEmpty queue) $ addToBitmap tdom prio
+>         queue' <- tcbQueuePrepend queue thread
+>         setQueue tdom prio queue'
 >         threadSet (\t -> t { tcbQueued = True }) thread
 
 > tcbSchedAppend :: PPtr TCB -> Kernel ()
 > tcbSchedAppend thread = do
+>     stateAssert ksReadyQueues_asrt ""
+>     runnable <- isRunnable thread
+>     assert runnable "thread must be runnable"
 >     queued <- threadGet tcbQueued thread
 >     unless queued $ do
 >         tdom <- threadGet tcbDomain thread
 >         prio <- threadGet tcbPriority thread
 >         queue <- getQueue tdom prio
->         setQueue tdom prio $ queue ++ [thread]
->         when (null queue) $ addToBitmap tdom prio
+>         when (tcbQueueEmpty queue) $ addToBitmap tdom prio
+>         queue' <- tcbQueueAppend queue thread
+>         setQueue tdom prio queue'
 >         threadSet (\t -> t { tcbQueued = True }) thread
 
 The following function dequeues a thread, if it is queued.
 
 > tcbSchedDequeue :: PPtr TCB -> Kernel ()
 > tcbSchedDequeue thread = do
+>     stateAssert ksReadyQueues_asrt ""
 >     queued <- threadGet tcbQueued thread
 >     when queued $ do
 >         tdom <- threadGet tcbDomain thread
 >         prio <- threadGet tcbPriority thread
 >         queue <- getQueue tdom prio
->         let queue' = filter (/=thread) queue
+>         queue' <- tcbQueueRemove queue thread
 >         setQueue tdom prio queue'
->         when (null queue') $ removeFromBitmap tdom prio
 >         threadSet (\t -> t { tcbQueued = False }) thread
+>         when (tcbQueueEmpty queue') $ removeFromBitmap tdom prio
 
 \subsubsection{Timer Ticks}
 
diff --git a/spec/haskell/src/SEL4/Model/StateData.lhs b/spec/haskell/src/SEL4/Model/StateData.lhs
index 76663ed29c..29dc2ddaf6 100644
--- a/spec/haskell/src/SEL4/Model/StateData.lhs
+++ b/spec/haskell/src/SEL4/Model/StateData.lhs
@@ -127,7 +127,7 @@ Note that there is no error-signalling mechanism available to functions in "Kern
 The ready queue is simply a list of threads that are ready to
 run. Each thread in this list is at the same priority level.
 
-> type ReadyQueue = [PPtr TCB]
+> type ReadyQueue = TcbQueue
 
 This is a standard Haskell singly-linked list independent of the
 thread control block structures. However, in a real implementation, it
@@ -153,7 +153,15 @@ replaces the previous one.
 > getCurThread = gets ksCurThread
 
 > setCurThread :: PPtr TCB -> Kernel ()
-> setCurThread tptr = modify (\ks -> ks { ksCurThread = tptr })
+> setCurThread tptr = do
+>     stateAssert idleThreadNotQueued "the idle thread cannot be in the ready queues"
+>     modify (\ks -> ks { ksCurThread = tptr })
+
+In many places, we would like to be able to use the fact that threads in the
+ready queues have runnable' thread state. We add an assertion that it does hold.
+
+> ready_qs_runnable :: KernelState -> Bool
+> ready_qs_runnable _ = True
 
 Similarly, these functions access the idle thread pointer, the ready queue for a given priority level (adjusted to account for the active security domain), the requested action of the scheduler, and the interrupt handler state.
 
@@ -232,7 +240,7 @@ A new kernel state structure contains an empty physical address space, a set of
 >         ksCurDomain = 0,
 >         ksDomainTime = 15,
 >         ksReadyQueues =
->             funPartialArray (const [])
+>             funPartialArray (const (TcbQueue {tcbQueueHead = Nothing, tcbQueueEnd = Nothing}))
 >                             ((0, 0), (fromIntegral numDomains, maxPriority)),
 >         ksReadyQueuesL1Bitmap = funPartialArray (const 0) (0, fromIntegral numDomains),
 >         ksReadyQueuesL2Bitmap =
@@ -282,4 +290,12 @@ The function "findM" searches a list, returning the first item for which the giv
 >     r <- f x
 >     if r then return $ Just x else findM f xs
 
+Several asserts about ksReadyQueues
+
+> ksReadyQueues_asrt :: KernelState -> Bool
+> ksReadyQueues_asrt _ = True
+
+An assert that will say that the idle thread is not in a ready queue
 
+> idleThreadNotQueued :: KernelState -> Bool
+> idleThreadNotQueued _ = True
diff --git a/spec/haskell/src/SEL4/Object/Endpoint.lhs b/spec/haskell/src/SEL4/Object/Endpoint.lhs
index 497d50d575..873d91ea23 100644
--- a/spec/haskell/src/SEL4/Object/Endpoint.lhs
+++ b/spec/haskell/src/SEL4/Object/Endpoint.lhs
@@ -229,6 +229,7 @@ If an endpoint is deleted, then every pending IPC operation using it must be can
 
 > cancelAllIPC :: PPtr Endpoint -> Kernel ()
 > cancelAllIPC epptr = do
+>         stateAssert ksReadyQueues_asrt ""
 >         ep <- getEndpoint epptr
 >         case ep of
 >             IdleEP ->
@@ -244,6 +245,7 @@ If a badged endpoint is recycled, then cancel every pending send operation using
 
 > cancelBadgedSends :: PPtr Endpoint -> Word -> Kernel ()
 > cancelBadgedSends epptr badge = do
+>     stateAssert ksReadyQueues_asrt ""
 >     ep <- getEndpoint epptr
 >     case ep of
 >         IdleEP -> return ()
diff --git a/spec/haskell/src/SEL4/Object/Instances.lhs b/spec/haskell/src/SEL4/Object/Instances.lhs
index 5720f93ead..eb20a91117 100644
--- a/spec/haskell/src/SEL4/Object/Instances.lhs
+++ b/spec/haskell/src/SEL4/Object/Instances.lhs
@@ -138,6 +138,8 @@ By default, new threads are unable to change the security domains of other threa
 >         tcbFaultHandler = CPtr 0,
 >         tcbIPCBuffer = VPtr 0,
 >         tcbBoundNotification = Nothing,
+>         tcbSchedPrev = Nothing,
+>         tcbSchedNext = Nothing,
 >         tcbArch = newArchTCB }
 >     injectKO   = KOTCB
 >     projectKO o = case o of
diff --git a/spec/haskell/src/SEL4/Object/Notification.lhs b/spec/haskell/src/SEL4/Object/Notification.lhs
index d462a19e81..ce735402f7 100644
--- a/spec/haskell/src/SEL4/Object/Notification.lhs
+++ b/spec/haskell/src/SEL4/Object/Notification.lhs
@@ -131,6 +131,7 @@ If a notification object is deleted, then pending receive operations must be can
 
 > cancelAllSignals :: PPtr Notification -> Kernel ()
 > cancelAllSignals ntfnPtr = do
+>         stateAssert ksReadyQueues_asrt ""
 >         ntfn <- getNotification ntfnPtr
 >         case ntfnObj ntfn of
 >             WaitingNtfn queue -> do
diff --git a/spec/haskell/src/SEL4/Object/Structures.lhs b/spec/haskell/src/SEL4/Object/Structures.lhs
index c3e27918e4..d3d1263e40 100644
--- a/spec/haskell/src/SEL4/Object/Structures.lhs
+++ b/spec/haskell/src/SEL4/Object/Structures.lhs
@@ -248,6 +248,14 @@ The TCB is used to store various data about the thread's current state:
 >         tcbState :: ThreadState,
 >         tcbMCP :: Priority,
 >         tcbPriority :: Priority,
+
+\item a flag indicating whether the thread is a member of a ready queue.
+    Note that the flag is necessary, since although the tcbSchedPrev and tcbSchedNext fields listed below
+    are used only to navigate through a ready queue, we cannot say that a thread is queued
+    if and only if either its tcbSchedPrev or tcbSchedNext field is not Nothing.
+    For consider a thread that is the sole member of a ready queue.
+    It will have both its tcbSchedNext and tcbSchedPrev fields equal to Nothing, but it will still be tcbQueued.
+
 >         tcbQueued :: Bool,
 
 \item the thread's current fault state;
@@ -270,6 +278,11 @@ The TCB is used to store various data about the thread's current state:
 
 >         tcbBoundNotification :: Maybe (PPtr Notification),
 
+\item the thread's pointers to the previous and next entries in a scheduling queue;
+
+>         tcbSchedPrev :: Maybe (PPtr TCB),
+>         tcbSchedNext :: Maybe (PPtr TCB),
+
 \item and any arch-specific TCB contents
 
 >         tcbArch :: ArchTCB }
@@ -476,4 +489,6 @@ Various operations on the free index of an Untyped cap.
 >         endPtr = capPtr cap + PPtr (2 ^ capBlockSize cap) - 1
 > untypedZeroRange _ = Nothing
 
-
+> data TcbQueue = TcbQueue {
+>     tcbQueueHead :: Maybe (PPtr TCB),
+>     tcbQueueEnd :: Maybe (PPtr TCB) }