lh-l4v/proof/infoflow/ARM/Example_Valid_State.thy

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

theory Example_Valid_State
imports
  "ArchNoninterference"
  "Lib.Distinct_Cmd"
begin

section \<open>Example\<close>

(* This example is a classic 'one way information flow'
   example, where information is allowed to flow from Low to High,
   but not the reverse. We consider a typical scenario where
   shared memory and an notification for notifications are used to
   implement a ring-buffer. We consider the NTFN to be in the domain of High,
   and the shared memory to be in the domain of Low. *)

(* basic machine-level declarations that need to happen outside the locale *)

consts s0_context :: user_context

(* define the irqs to come regularly every 10 *)

axiomatization where
  irq_oracle_def: "ARM.irq_oracle \<equiv> \<lambda>pos. if pos mod 10 = 0 then 10 else 0"

context begin interpretation Arch . (*FIXME: arch_split*)

subsection \<open>We show that the authority graph does not let
              information flow from High to Low\<close>

datatype auth_graph_label = High | Low | IRQ0

abbreviation partition_label where
  "partition_label x \<equiv> OrdinaryLabel x"

definition Sys1AuthGraph :: "(auth_graph_label subject_label) auth_graph" where
  "Sys1AuthGraph \<equiv>
   { (partition_label High,Read,partition_label Low),
     (partition_label Low,Notify,partition_label High),
     (partition_label Low,Reset,partition_label High),
     (SilcLabel,Notify,partition_label High),
     (SilcLabel,Reset,partition_label High)
   } \<union> {(x, a, y). x = y}"

lemma subjectReads_Low: "subjectReads Sys1AuthGraph (partition_label Low) = {partition_label Low}"
  apply(rule equalityI)
   apply(rule subsetI)
   apply(erule subjectReads.induct, (fastforce simp: Sys1AuthGraph_def)+)
  done

lemma Low_in_subjectReads_High:
  "partition_label Low \<in> subjectReads Sys1AuthGraph (partition_label High)"
  apply (simp add: Sys1AuthGraph_def reads_read)
  done

lemma subjectReads_High: "subjectReads Sys1AuthGraph (partition_label High) = {partition_label High,partition_label Low}"
  apply(rule equalityI)
   apply(rule subsetI)
   apply(erule subjectReads.induct, (fastforce simp: Sys1AuthGraph_def)+)
  apply(auto intro: Low_in_subjectReads_High)
  done

lemma subjectReads_IRQ0: "subjectReads Sys1AuthGraph (partition_label IRQ0) = {partition_label IRQ0}"
  apply(rule equalityI)
   apply(rule subsetI)
   apply(erule subjectReads.induct, (fastforce simp: Sys1AuthGraph_def)+)
  done

lemma High_in_subjectAffects_Low:
  "partition_label High \<in> subjectAffects Sys1AuthGraph (partition_label Low)"
  apply(rule affects_ep)
   apply (simp add: Sys1AuthGraph_def)
   apply (rule disjI1, simp+)
   done

lemma subjectAffects_Low: "subjectAffects Sys1AuthGraph (partition_label Low) = {partition_label Low, partition_label High}"
  apply(rule equalityI)
   apply(rule subsetI)
   apply(erule subjectAffects.induct, (fastforce simp: Sys1AuthGraph_def)+)
  apply(auto intro: affects_lrefl High_in_subjectAffects_Low)
  done

lemma subjectAffects_High: "subjectAffects Sys1AuthGraph (partition_label High) = {partition_label High}"
  apply(rule equalityI)
   apply(rule subsetI)
   apply(erule subjectAffects.induct, (fastforce simp: Sys1AuthGraph_def)+)
  apply(auto intro: affects_lrefl)
  done

lemma subjectAffects_IRQ0: "subjectAffects Sys1AuthGraph (partition_label IRQ0) = {partition_label IRQ0}"
  apply(rule equalityI)
   apply(rule subsetI)
   apply(erule subjectAffects.induct, (fastforce simp: Sys1AuthGraph_def)+)
  apply(auto intro: affects_lrefl)
  done



lemmas subjectReads = subjectReads_High subjectReads_Low subjectReads_IRQ0



lemma partsSubjectAffects_Low: "partsSubjectAffects Sys1AuthGraph Low = {Partition Low, Partition High}"
  apply(auto simp: partsSubjectAffects_def image_def label_can_affect_partition_def subjectReads subjectAffects_Low | case_tac xa, rename_tac xa)+
  done

lemma partsSubjectAffects_High: "partsSubjectAffects Sys1AuthGraph High = {Partition High}"
  apply(auto simp: partsSubjectAffects_def image_def label_can_affect_partition_def subjectReads subjectAffects_High | rename_tac xa, case_tac xa)+
  done

lemma partsSubjectAffects_IRQ0: "partsSubjectAffects Sys1AuthGraph IRQ0 = {Partition IRQ0}"
  apply(auto simp: partsSubjectAffects_def image_def label_can_affect_partition_def subjectReads subjectAffects_IRQ0 | rename_tac xa, case_tac xa)+
  done

lemmas partsSubjectAffects =
   partsSubjectAffects_High partsSubjectAffects_Low partsSubjectAffects_IRQ0


definition example_policy where
  "example_policy \<equiv> {(PSched, d)|d. True} \<union>
                    {(d,e). d = e} \<union>
                    {(Partition Low, Partition High)}"

lemma "policyFlows Sys1AuthGraph = example_policy"
  apply(rule equalityI)
   apply(rule subsetI)
   apply(clarsimp simp: example_policy_def)
   apply(erule policyFlows.cases)
    apply(case_tac l, auto simp: partsSubjectAffects)[1]
   apply assumption
  apply(rule subsetI)
  apply(clarsimp simp: example_policy_def)
  apply(elim disjE)
    apply(fastforce simp: partsSubjectAffects intro: policy_affects)
   apply(fastforce intro: policy_scheduler)
  apply(fastforce intro: policyFlows_refl refl_onD)
  done

subsection \<open>We show there exists a valid initial state associated to the
              above authority graph\<close>

text \<open>

This example (modified from ../access-control/ExampleSystem) is a system Sys1 made
of 2 main components Low and High, connected through an notification NTFN.
Both Low and High contains:

  . one TCB
  . one vspace made up of one page directory
  . each pd contains a single page table, with access to a shared page in memory
     Low can read/write to this page, High can only read
  . one cspace made up of one cnode
  . each cspace contains 4 caps:
         one to the tcb
         one to the cnode itself
         one to the vspace
         one to the ntfn

Low can send to the ntfn while High can receive from it.

Attempt to ASCII art:


          --------    ----                    ----   --------
          |       |   |  |                    |  |   |      |
          V       |   |  V    S         R     |  V   |      V
Low_tcb(3079)-->Low_cnode(6)--->ntfn(9)<---High_cnode(7)<--High_tcb(3080)
  |              |                               |          |
  V              |                               |          V
Low_pd(3063)<-----                               -------> High_pd(3065)
  |                                                         |
  V               R/W                           R           V
Low_pt(3072)---------------->shared_page<-----------------High_pt(3077)


(the references are derived from the dump of the SAC system)


The aim is to be able to prove

  valid_initial_state s0_internal Sys1PAS timer_irq utf

where Sys1PAS is the label graph defining the AC policy for Sys1 using
the authority graph defined above and s0 is the state of Sys1 described above.

\<close>

subsubsection \<open>Defining the State\<close>


definition "ntfn_ptr \<equiv> kernel_base + 0x10"

definition "Low_tcb_ptr \<equiv> kernel_base + 0x200"
definition "High_tcb_ptr = kernel_base + 0x400"
definition "idle_tcb_ptr = kernel_base + 0x1000"

definition "Low_pt_ptr = kernel_base + 0x800"
definition "High_pt_ptr = kernel_base + 0xC00"


(* init_globals_frame \<equiv> {kernel_base + 0x5000,... kernel_base + 0x5FFF} *)

definition "shared_page_ptr_virt = kernel_base + 0x6000"
definition "shared_page_ptr_phys = addrFromPPtr shared_page_ptr_virt"

definition "Low_pd_ptr = kernel_base + 0x20000"
definition "High_pd_ptr = kernel_base + 0x24000"

definition "Low_cnode_ptr = kernel_base + 0x10000"
definition "High_cnode_ptr = kernel_base + 0x14000"
definition "Silc_cnode_ptr = kernel_base + 0x18000"
definition "irq_cnode_ptr = kernel_base + 0x1C000"

(* init_global_pd \<equiv> {kernel_base + 0x60000,... kernel_base + 0x603555} *)

definition "timer_irq \<equiv> 10" (* not sure exactly how this fits in *)

definition "Low_mcp \<equiv> 5 :: word8"
definition "Low_prio \<equiv> 5 :: word8"
definition "High_mcp \<equiv> 5 :: word8"
definition "High_prio \<equiv> 5 :: word8"
definition "Low_time_slice \<equiv> 0 :: nat"
definition "High_time_slice \<equiv> 5 :: nat"
definition "Low_domain \<equiv> 0 :: word8"
definition "High_domain \<equiv> 1 :: word8"

lemmas s0_ptr_defs =
  Low_cnode_ptr_def High_cnode_ptr_def Silc_cnode_ptr_def ntfn_ptr_def irq_cnode_ptr_def
  Low_pd_ptr_def High_pd_ptr_def Low_pt_ptr_def High_pt_ptr_def Low_tcb_ptr_def
  High_tcb_ptr_def idle_tcb_ptr_def timer_irq_def Low_prio_def High_prio_def Low_time_slice_def
  Low_domain_def High_domain_def init_irq_node_ptr_def init_globals_frame_def init_global_pd_def
  kernel_base_def shared_page_ptr_virt_def

(* Distinctness proof of kernel pointers. *)

distinct ptrs_distinct [simp]:
  Low_tcb_ptr High_tcb_ptr idle_tcb_ptr
  Low_pt_ptr High_pt_ptr
  shared_page_ptr_virt ntfn_ptr
  Low_pd_ptr High_pd_ptr
  Low_cnode_ptr High_cnode_ptr Silc_cnode_ptr irq_cnode_ptr
  init_globals_frame init_global_pd
  by (auto simp: s0_ptr_defs)


text \<open>We need to define the asids of each pd and pt to ensure that
the object is included in the right ASID-label\<close>

text \<open>Low's ASID\<close>

definition
  Low_asid :: machine_word
where
  "Low_asid \<equiv> 1<<asid_low_bits"

text \<open>High's ASID\<close>

definition
  High_asid :: machine_word
where
  "High_asid \<equiv> 2<<asid_low_bits"

lemma "asid_high_bits_of High_asid \<noteq> asid_high_bits_of Low_asid"
by (simp add: Low_asid_def asid_high_bits_of_def High_asid_def asid_low_bits_def)


text \<open>converting a nat to a bool list of size 10 - for the cnodes\<close>

definition
  nat_to_bl :: "nat \<Rightarrow> nat \<Rightarrow> bool list option"
where
  "nat_to_bl bits n \<equiv>
    if n \<ge> 2^bits then
      None
    else
      Some $ bin_to_bl bits (of_nat n)"

lemma nat_to_bl_id [simp]: "nat_to_bl (size (x :: (('a::len) word))) (unat x) = Some (to_bl x)"
  by (clarsimp simp: nat_to_bl_def to_bl_def le_def word_size)

definition
  the_nat_to_bl :: "nat \<Rightarrow> nat \<Rightarrow> bool list"
where
  "the_nat_to_bl sz n \<equiv>
      the (nat_to_bl sz (n mod 2^sz))"

abbreviation (input)
  the_nat_to_bl_10  :: "nat \<Rightarrow> bool list"
where
  "the_nat_to_bl_10 n \<equiv> the_nat_to_bl 10 n"

lemma len_the_nat_to_bl [simp]:
    "length (the_nat_to_bl x y) = x"
  apply (clarsimp simp: the_nat_to_bl_def nat_to_bl_def)
  apply safe
   apply (metis le_def mod_less_divisor nat_zero_less_power_iff zero_less_numeral)
  apply (clarsimp simp: len_bin_to_bl_aux not_le)
  done

lemma tcb_cnode_index_nat_to_bl [simp]:
  "the_nat_to_bl_10 n \<noteq> tcb_cnode_index n"
  by (clarsimp simp: tcb_cnode_index_def intro!: length_neq)

lemma mod_less_self [simp]:
    "a \<le> b mod a \<longleftrightarrow> ((a :: nat) = 0)"
  by (metis mod_less_divisor nat_neq_iff not_less not_less0)

lemma split_div_mod:
    "a = (b::nat) \<longleftrightarrow> (a div k = b div k \<and> a mod k = b mod k)"
  by (metis mult_div_mod_eq)

lemma nat_to_bl_eq:
  assumes "a < 2 ^ n \<or> b < 2 ^ n"
  shows "nat_to_bl n a = nat_to_bl n b \<longleftrightarrow> a = b"
  using assms
  apply -
  apply (erule disjE_R)
   apply (clarsimp simp: nat_to_bl_def)
  apply (case_tac "a \<ge> 2 ^ n")
   apply (clarsimp simp: nat_to_bl_def)
  apply (clarsimp simp: not_le)
  apply (induct n arbitrary: a b)
   apply (clarsimp simp: nat_to_bl_def)
  apply atomize
  apply (clarsimp simp: nat_to_bl_def)
  apply (erule_tac x="a div 2" in allE)
  apply (erule_tac x="b div 2" in allE)
  apply (erule impE)
   apply (metis power_commutes td_gal_lt zero_less_numeral)
  apply (clarsimp simp: bin_last_def zdiv_int)
  apply (rule iffI [rotated], clarsimp)
  apply (subst (asm) (1 2 3 4) bin_to_bl_aux_alt)
  apply (clarsimp simp: mod_eq_dvd_iff)
  apply (subst split_div_mod [where k=2])
  apply clarsimp
  apply presburger
  done

lemma nat_to_bl_mod_n_eq [simp]:
    "nat_to_bl n a = nat_to_bl n b \<longleftrightarrow> ((a = b \<and> a < 2 ^ n) \<or> (a \<ge> 2 ^ n \<and> b \<ge> 2 ^ n))"
  apply (rule iffI)
  apply (clarsimp simp: not_le)
  apply (subst (asm) nat_to_bl_eq, simp)
  apply clarsimp
  apply (erule disjE)
   apply clarsimp
  apply (clarsimp simp: nat_to_bl_def)
  done

lemma the_the_eq:
    "\<lbrakk> x \<noteq> None; y \<noteq> None \<rbrakk> \<Longrightarrow> (the x = the y) = (x = y)"
  by auto

lemma the_nat_to_bl_eq [simp]:
    "(the_nat_to_bl n a = the_nat_to_bl m b) \<longleftrightarrow> (n = m \<and> (a mod 2 ^ n = b mod 2 ^ n))"
  apply (case_tac "n = m")
   apply (clarsimp simp: the_nat_to_bl_def)
   apply (subst the_the_eq)
     apply (clarsimp simp: nat_to_bl_def)
    apply (clarsimp simp: nat_to_bl_def)
   apply simp
  apply simp
  apply (metis len_the_nat_to_bl)
  done

lemma empty_cnode_eq_Some [simp]:
    "(empty_cnode n x = Some y) = (length x = n \<and> y = NullCap)"
  by (clarsimp simp: empty_cnode_def, metis)

lemma empty_cnode_eq_None [simp]:
    "(empty_cnode n x = None) = (length x \<noteq> n)"
  by (clarsimp simp: empty_cnode_def)

text \<open>Low's CSpace\<close>

definition
  Low_caps :: cnode_contents
where
  "Low_caps \<equiv>
   (empty_cnode 10)
      ( (the_nat_to_bl_10 1)
            \<mapsto> ThreadCap Low_tcb_ptr,
        (the_nat_to_bl_10 2)
            \<mapsto> CNodeCap Low_cnode_ptr 10 (the_nat_to_bl_10 2),
        (the_nat_to_bl_10 3)
            \<mapsto> ArchObjectCap (PageDirectoryCap Low_pd_ptr
                                             (Some Low_asid)),
        (the_nat_to_bl_10 318)
            \<mapsto> NotificationCap ntfn_ptr 0 {AllowSend} )"

definition
  Low_cnode :: kernel_object
where
  "Low_cnode \<equiv> CNode 10 Low_caps"

lemma ran_empty_cnode [simp]:
    "ran (empty_cnode C) = {NullCap}"
  by (auto simp: empty_cnode_def ran_def Ex_list_of_length intro: set_eqI)

lemma empty_cnode_app [simp]:
    "length x = n \<Longrightarrow> empty_cnode n x = Some NullCap"
  by (auto simp: empty_cnode_def)

lemma in_ran_If [simp]:
      "(x \<in> ran (\<lambda>n. if P n then A n else B n))
            \<longleftrightarrow>  (\<exists>n. P n \<and> A n = Some x) \<or> (\<exists>n. \<not> P n \<and> B n = Some x)"
 by (auto simp: ran_def)


lemma Low_caps_ran:
  "ran Low_caps = {ThreadCap Low_tcb_ptr,
                   CNodeCap Low_cnode_ptr 10 (the_nat_to_bl_10 2),
                   ArchObjectCap (PageDirectoryCap Low_pd_ptr
                                              (Some Low_asid)),
                   NotificationCap ntfn_ptr 0 {AllowSend},
                   NullCap}"
  apply (rule equalityI)
   apply (clarsimp simp: Low_caps_def fun_upd_def empty_cnode_def split: if_split_asm)
  apply (clarsimp simp: Low_caps_def fun_upd_def empty_cnode_def split: if_split_asm
                  cong: conj_cong)
  apply (rule exI [where x="the_nat_to_bl_10 0"])
  apply simp
  done

text \<open>High's Cspace\<close>

definition
  High_caps :: cnode_contents
where
  "High_caps \<equiv>
   (empty_cnode 10)
      ( (the_nat_to_bl_10 1)
            \<mapsto> ThreadCap High_tcb_ptr,
        (the_nat_to_bl_10 2)
            \<mapsto> CNodeCap High_cnode_ptr 10 (the_nat_to_bl_10 2),
        (the_nat_to_bl_10 3)
           \<mapsto> ArchObjectCap (PageDirectoryCap High_pd_ptr
                                            (Some High_asid)),
        (the_nat_to_bl_10 318)
           \<mapsto> NotificationCap ntfn_ptr 0 {AllowRecv}) "

definition
  High_cnode :: kernel_object
where
  "High_cnode \<equiv> CNode 10 High_caps"

lemma High_caps_ran:
  "ran High_caps = {ThreadCap High_tcb_ptr,
                    CNodeCap High_cnode_ptr 10 (the_nat_to_bl_10 2),
                    ArchObjectCap (PageDirectoryCap High_pd_ptr
                                               (Some High_asid)),
                    NotificationCap ntfn_ptr 0 {AllowRecv},
                    NullCap}"
  apply (rule equalityI)
   apply (clarsimp simp: High_caps_def ran_def empty_cnode_def split: if_split_asm)
  apply (clarsimp simp: High_caps_def ran_def empty_cnode_def split: if_split_asm
                  cong: conj_cong)
  apply (rule exI [where x="the_nat_to_bl_10 0"])
  apply simp
  done

text \<open>We need a copy of boundary crossing caps owned by SilcLabel.
        The only such cap is Low's cap to the notification\<close>

definition
  Silc_caps :: cnode_contents
where
  "Silc_caps \<equiv>
   (empty_cnode 10)
      ( (the_nat_to_bl_10 2)
            \<mapsto> CNodeCap Silc_cnode_ptr 10 (the_nat_to_bl_10 2),
        (the_nat_to_bl_10 318)
            \<mapsto> NotificationCap ntfn_ptr 0 {AllowSend} )"


definition
  Silc_cnode :: kernel_object
where
  "Silc_cnode \<equiv> CNode 10 Silc_caps"

lemma Silc_caps_ran:
  "ran Silc_caps = {CNodeCap Silc_cnode_ptr 10 (the_nat_to_bl_10 2),
                    NotificationCap ntfn_ptr 0 {AllowSend},
                    NullCap}"
  apply (rule equalityI)
   apply (clarsimp simp: Silc_caps_def ran_def empty_cnode_def)
  apply (clarsimp simp: ran_def Silc_caps_def empty_cnode_def cong: conj_cong)
  apply (rule_tac x="the_nat_to_bl_10 0" in exI)
  apply simp
  done

text \<open>notification between Low and High\<close>

definition
  ntfn :: kernel_object
where
  "ntfn \<equiv> Notification \<lparr>ntfn_obj = WaitingNtfn [High_tcb_ptr], ntfn_bound_tcb=None\<rparr>"


text \<open>Low's VSpace (PageDirectory)\<close>

definition
  Low_pt' :: "word8 \<Rightarrow> pte "
where
  "Low_pt' \<equiv> (\<lambda>_. InvalidPTE)
            (0 := SmallPagePTE shared_page_ptr_phys {} vm_read_write)"

definition
  Low_pt :: kernel_object
where
  "Low_pt \<equiv> ArchObj (PageTable Low_pt')"


definition
  Low_pd' :: "12 word \<Rightarrow> pde "
where
  "Low_pd' \<equiv>
    global_pd
     (0 := PageTablePDE
              (addrFromPPtr Low_pt_ptr)
              {}
              undefined )"

(* used addrFromPPtr because proof gives me ptrFromAddr.. TODO: check
if it's right *)

definition
  Low_pd :: kernel_object
where
  "Low_pd \<equiv> ArchObj (PageDirectory Low_pd')"


text \<open>High's VSpace (PageDirectory)\<close>


definition
  High_pt' :: "word8 \<Rightarrow> pte "
where
  "High_pt' \<equiv>
    (\<lambda>_. InvalidPTE)
     (0 := SmallPagePTE shared_page_ptr_phys {} vm_read_only)"


definition
  High_pt :: kernel_object
where
  "High_pt \<equiv> ArchObj (PageTable High_pt')"


definition
  High_pd' :: "12 word \<Rightarrow> pde "
where
  "High_pd' \<equiv>
    global_pd
     (0 := PageTablePDE
             (addrFromPPtr High_pt_ptr)
             {}
             undefined )"

(* used addrFromPPtr because proof gives me ptrFromAddr.. TODO: check
if it's right *)

definition
  High_pd :: kernel_object
where
  "High_pd \<equiv> ArchObj (PageDirectory High_pd')"


text \<open>Low's tcb\<close>

definition
  Low_tcb :: kernel_object
where
  "Low_tcb \<equiv>
   TCB \<lparr>
     tcb_ctable        = CNodeCap Low_cnode_ptr 10 (the_nat_to_bl_10 2),
     tcb_vtable        = ArchObjectCap
                           (PageDirectoryCap Low_pd_ptr (Some Low_asid)),
     tcb_reply         = ReplyCap Low_tcb_ptr True {AllowGrant, AllowWrite}, \<comment> \<open>master reply cap\<close>
     tcb_caller        = NullCap,
     tcb_ipcframe      = NullCap,
     tcb_state         = Running,
     tcb_fault_handler = replicate word_bits False,
     tcb_ipc_buffer    = 0,
     tcb_fault         = None,
     tcb_bound_notification     = None,
     tcb_mcpriority    = Low_mcp,
     tcb_arch = \<lparr>tcb_context = undefined\<rparr>\<rparr>"

definition
  Low_etcb :: etcb
where
  "Low_etcb \<equiv> \<lparr>tcb_priority   = Low_prio,
               tcb_time_slice = Low_time_slice,
               tcb_domain     = Low_domain\<rparr>"


text \<open>High's tcb\<close>

definition
  High_tcb :: kernel_object
where
  "High_tcb \<equiv>
   TCB \<lparr>
     tcb_ctable        = CNodeCap High_cnode_ptr 10 (the_nat_to_bl_10 2) ,
     tcb_vtable        = ArchObjectCap
                           (PageDirectoryCap High_pd_ptr (Some High_asid)),
     tcb_reply         = ReplyCap High_tcb_ptr True {AllowGrant,AllowWrite}, \<comment> \<open>master reply cap to itself\<close>
     tcb_caller        = NullCap,
     tcb_ipcframe      = NullCap,
     tcb_state         = BlockedOnNotification ntfn_ptr,
     tcb_fault_handler = replicate word_bits False,
     tcb_ipc_buffer    = 0,
     tcb_fault         = None,
     tcb_bound_notification     = None,
     tcb_mcpriority    = High_mcp,
     tcb_arch = \<lparr>tcb_context = undefined\<rparr>\<rparr>"

definition
  High_etcb :: etcb
where
  "High_etcb \<equiv> \<lparr>tcb_priority   = High_prio,
                tcb_time_slice = High_time_slice,
                tcb_domain     = High_domain\<rparr>"


text \<open>idle's tcb\<close>

definition
  idle_tcb :: kernel_object
where
  "idle_tcb \<equiv>
   TCB \<lparr>
     tcb_ctable        = NullCap,
     tcb_vtable        = NullCap,
     tcb_reply         = NullCap,
     tcb_caller        = NullCap,
     tcb_ipcframe      = NullCap,
     tcb_state         = IdleThreadState,
     tcb_fault_handler = replicate word_bits False,
     tcb_ipc_buffer    = 0,
     tcb_fault         = None,
     tcb_bound_notification     = None,
     tcb_mcpriority    = default_priority,
     tcb_arch = \<lparr>tcb_context = empty_context\<rparr>\<rparr>"


definition
 "irq_cnode \<equiv> CNode 0 (Map.empty([] \<mapsto> cap.NullCap))"

definition
  kh0 :: kheap
where
  "kh0 \<equiv> (\<lambda>x. if \<exists>irq::10 word. init_irq_node_ptr + (ucast irq << cte_level_bits) = x
          then Some (CNode 0 (empty_cnode 0)) else None)
         (Low_cnode_ptr  \<mapsto> Low_cnode,
          High_cnode_ptr \<mapsto> High_cnode,
          Silc_cnode_ptr \<mapsto> Silc_cnode,
          ntfn_ptr        \<mapsto> ntfn,
          irq_cnode_ptr  \<mapsto> irq_cnode,
          Low_pd_ptr     \<mapsto> Low_pd,
          High_pd_ptr    \<mapsto> High_pd,
          Low_pt_ptr     \<mapsto> Low_pt,
          High_pt_ptr    \<mapsto> High_pt,
          Low_tcb_ptr    \<mapsto> Low_tcb,
          High_tcb_ptr   \<mapsto> High_tcb,
          idle_tcb_ptr   \<mapsto> idle_tcb,
          init_globals_frame \<mapsto> ArchObj (DataPage False ARMSmallPage),
          init_global_pd \<mapsto> ArchObj (PageDirectory global_pd))"

lemma irq_node_offs_min:
  "init_irq_node_ptr \<le> init_irq_node_ptr + (ucast (irq:: 10 word) << cte_level_bits)"
  apply (rule_tac sz=28 in machine_word_plus_mono_right_split)
   apply (simp add: unat_word_ariths mask_def shiftl_t2n s0_ptr_defs cte_level_bits_def)
   apply (cut_tac x=irq and 'a=32 in ucast_less)
    apply simp
   apply (simp add: word_less_nat_alt)
  apply (simp add: word_bits_def)
  done

lemma irq_node_offs_max:
  "init_irq_node_ptr + (ucast (irq:: 10 word) << cte_level_bits) < init_irq_node_ptr + 0x4000"
  apply (simp add: s0_ptr_defs cte_level_bits_def shiftl_t2n)
  apply (cut_tac x=irq and 'a=32 in ucast_less)
   apply simp
  apply (simp add: word_less_nat_alt unat_word_ariths)
  done

definition irq_node_offs_range where
  "irq_node_offs_range \<equiv> {x. init_irq_node_ptr \<le> x \<and> x < init_irq_node_ptr + 0x4000}
                         \<inter> {x. is_aligned x cte_level_bits}"



lemma irq_node_offs_in_range:
  "init_irq_node_ptr + (ucast (irq:: 10 word) << cte_level_bits)
     \<in> irq_node_offs_range"
  apply (clarsimp simp: irq_node_offs_min irq_node_offs_max irq_node_offs_range_def)
  apply (rule is_aligned_add[OF _ is_aligned_shift])
  apply (simp add: is_aligned_def s0_ptr_defs cte_level_bits_def)
  done

lemma irq_node_offs_range_correct:
  "x \<in> irq_node_offs_range
    \<Longrightarrow> \<exists>irq. x = init_irq_node_ptr + (ucast (irq:: 10 word) << cte_level_bits)"
  apply (clarsimp simp: irq_node_offs_min irq_node_offs_max irq_node_offs_range_def
                        s0_ptr_defs cte_level_bits_def)
  apply (rule_tac x="ucast ((x - 0xE0008000) >> 4)" in exI)
  apply (clarsimp simp: ucast_ucast_mask)
  apply (subst aligned_shiftr_mask_shiftl)
   apply (rule aligned_sub_aligned)
     apply assumption
    apply (simp add: is_aligned_def)
   apply simp
  apply simp
  apply (rule_tac n=14 in mask_eqI)
   apply (subst mask_add_aligned)
    apply (simp add: is_aligned_def)
   apply (simp add: mask_twice)
   apply (simp add: diff_conv_add_uminus del: add_uminus_conv_diff)
   apply (subst add.commute[symmetric])
   apply (subst mask_add_aligned)
    apply (simp add: is_aligned_def)
   apply simp
  apply (simp add: diff_conv_add_uminus del: add_uminus_conv_diff)
  apply (subst add_mask_lower_bits)
    apply (simp add: is_aligned_def)
   apply clarsimp
  apply (cut_tac x=x and y="0xE000BFFF" and n=14 in neg_mask_mono_le)
   apply (force dest: word_less_sub_1)
  apply (drule_tac n=14 in aligned_le_sharp)
   apply (simp add: is_aligned_def)
  apply (simp add: mask_def)
  done

lemma irq_node_offs_range_distinct[simp]:
  "Low_cnode_ptr \<notin> irq_node_offs_range"
  "High_cnode_ptr \<notin> irq_node_offs_range"
  "Silc_cnode_ptr \<notin> irq_node_offs_range"
  "ntfn_ptr \<notin> irq_node_offs_range"
  "irq_cnode_ptr \<notin> irq_node_offs_range"
  "Low_pd_ptr \<notin> irq_node_offs_range"
  "High_pd_ptr \<notin> irq_node_offs_range"
  "Low_pt_ptr \<notin> irq_node_offs_range"
  "High_pt_ptr \<notin> irq_node_offs_range"
  "Low_tcb_ptr \<notin> irq_node_offs_range"
  "High_tcb_ptr \<notin> irq_node_offs_range"
  "idle_tcb_ptr \<notin> irq_node_offs_range"
  "init_globals_frame \<notin> irq_node_offs_range"
  "init_global_pd \<notin> irq_node_offs_range"
  by(simp add:irq_node_offs_range_def s0_ptr_defs)+

lemma irq_node_offs_distinct[simp]:
  "init_irq_node_ptr + (ucast (irq:: 10 word) << cte_level_bits) \<noteq> Low_cnode_ptr"
  "init_irq_node_ptr + (ucast (irq:: 10 word) << cte_level_bits) \<noteq> High_cnode_ptr"
  "init_irq_node_ptr + (ucast (irq:: 10 word) << cte_level_bits) \<noteq> Silc_cnode_ptr"
  "init_irq_node_ptr + (ucast (irq:: 10 word) << cte_level_bits) \<noteq> ntfn_ptr"
  "init_irq_node_ptr + (ucast (irq:: 10 word) << cte_level_bits) \<noteq> irq_cnode_ptr"
  "init_irq_node_ptr + (ucast (irq:: 10 word) << cte_level_bits) \<noteq> Low_pd_ptr"
  "init_irq_node_ptr + (ucast (irq:: 10 word) << cte_level_bits) \<noteq> High_pd_ptr"
  "init_irq_node_ptr + (ucast (irq:: 10 word) << cte_level_bits) \<noteq> Low_pt_ptr"
  "init_irq_node_ptr + (ucast (irq:: 10 word) << cte_level_bits) \<noteq> High_pt_ptr"
  "init_irq_node_ptr + (ucast (irq:: 10 word) << cte_level_bits) \<noteq> Low_tcb_ptr"
  "init_irq_node_ptr + (ucast (irq:: 10 word) << cte_level_bits) \<noteq> High_tcb_ptr"
  "init_irq_node_ptr + (ucast (irq:: 10 word) << cte_level_bits) \<noteq> idle_tcb_ptr"
  "init_irq_node_ptr + (ucast (irq:: 10 word) << cte_level_bits) \<noteq> init_globals_frame"
  "init_irq_node_ptr + (ucast (irq:: 10 word) << cte_level_bits) \<noteq> init_global_pd"
  by (simp add:not_inD[symmetric, OF _ irq_node_offs_in_range])+

lemma kh0_dom:
  "dom kh0 = {init_globals_frame, init_global_pd, idle_tcb_ptr, High_tcb_ptr, Low_tcb_ptr,
              High_pt_ptr, Low_pt_ptr, High_pd_ptr, Low_pd_ptr, irq_cnode_ptr, ntfn_ptr,
              Silc_cnode_ptr, High_cnode_ptr, Low_cnode_ptr} \<union>
             irq_node_offs_range"
  apply (rule equalityI)
   apply (simp add: kh0_def dom_def)
   apply (clarsimp simp: irq_node_offs_in_range)
  apply (clarsimp simp: dom_def)
  apply (rule conjI, clarsimp simp: kh0_def)+
  apply (force simp: kh0_def cte_level_bits_def dest: irq_node_offs_range_correct)
  done

lemmas kh0_SomeD' = set_mp[OF equalityD1[OF kh0_dom[simplified dom_def]], OF CollectI, simplified, OF exI]

lemma kh0_SomeD:
  "kh0 x = Some y \<Longrightarrow>
        x = init_globals_frame \<and> y = ArchObj (DataPage False ARMSmallPage) \<or>
        x = init_global_pd \<and> y = ArchObj (PageDirectory global_pd) \<or>
        x = idle_tcb_ptr \<and> y = idle_tcb \<or>
        x = High_tcb_ptr \<and> y = High_tcb \<or>
        x = Low_tcb_ptr \<and> y = Low_tcb \<or>
        x = High_pt_ptr \<and> y = High_pt \<or>
        x = Low_pt_ptr \<and> y = Low_pt \<or>
        x = High_pd_ptr \<and> y = High_pd \<or>
        x = Low_pd_ptr \<and> y = Low_pd \<or>
        x = irq_cnode_ptr \<and> y = irq_cnode \<or>
        x = ntfn_ptr \<and> y = ntfn \<or>
        x = Silc_cnode_ptr \<and> y = Silc_cnode \<or>
        x = High_cnode_ptr \<and> y = High_cnode \<or>
        x = Low_cnode_ptr \<and> y = Low_cnode \<or>
        x \<in> irq_node_offs_range \<and> y = CNode 0 (empty_cnode 0)"
  apply (frule kh0_SomeD')
  apply (erule disjE, simp add: kh0_def
        | force simp: kh0_def split: if_split_asm)+
  done

lemmas kh0_obj_def =
  Low_cnode_def High_cnode_def Silc_cnode_def ntfn_def irq_cnode_def Low_pd_def
  High_pd_def Low_pt_def High_pt_def Low_tcb_def High_tcb_def idle_tcb_def

definition exst0 :: "det_ext" where
  "exst0 \<equiv> \<lparr>work_units_completed_internal = undefined,
             scheduler_action_internal = resume_cur_thread,
             ekheap_internal = [Low_tcb_ptr  \<mapsto> Low_etcb,
                                High_tcb_ptr \<mapsto> High_etcb,
                                idle_tcb_ptr \<mapsto> default_etcb],
             domain_list_internal = [(0, 10), (1, 10)],
             domain_index_internal = 0,
             cur_domain_internal = 0,
             domain_time_internal = 5,
             ready_queues_internal = (const (const [])),
             cdt_list_internal = const []\<rparr>"

lemmas ekh0_obj_def =
  Low_etcb_def High_etcb_def default_etcb_def

definition machine_state0 :: "machine_state" where
  "machine_state0 \<equiv> \<lparr>irq_masks = (\<lambda>irq. if irq = timer_irq then False else True),
                     irq_state = 0,
                     underlying_memory = const 0,
                     device_state = Map.empty,
                     exclusive_state = undefined,
                     machine_state_rest = undefined\<rparr>"

definition arch_state0 :: "arch_state" where
  "arch_state0 \<equiv> \<lparr>arm_asid_table = Map.empty,
                  arm_hwasid_table = Map.empty, arm_next_asid = 0, arm_asid_map = Map.empty,
                  arm_global_pd = init_global_pd, arm_global_pts = [],
                  arm_kernel_vspace =
       \<lambda>ref. if ref \<in> {kernel_base..kernel_base + mask 20} then ArmVSpaceKernelWindow
               else ArmVSpaceInvalidRegion\<rparr>"

definition
  s0_internal :: "det_ext state"
where
  "s0_internal \<equiv>  \<lparr>
    kheap = kh0,
    cdt = Map.empty,
    is_original_cap =  (\<lambda>_. False) ((Low_tcb_ptr, tcb_cnode_index 2) := True,
                                    (High_tcb_ptr, tcb_cnode_index 2) := True),
    cur_thread = Low_tcb_ptr,
    idle_thread = idle_tcb_ptr,
    machine_state = machine_state0,
    interrupt_irq_node = (\<lambda>irq. init_irq_node_ptr + (ucast irq << cte_level_bits)),
    interrupt_states = (\<lambda>_. irq_state.IRQInactive) (timer_irq := irq_state.IRQTimer),
    arch_state = arch_state0,
     exst = exst0
   \<rparr>"


subsubsection \<open>Defining the policy graph\<close>

(* FIXME: should incorporate SharedPage above *)

(* There is an NTFN in the High label, a SharedPage in the Low label *)

definition
  Sys1AgentMap :: "(auth_graph_label subject_label) agent_map"
where
  "Sys1AgentMap \<equiv>
   (\<lambda>p. if p \<in> ptr_range shared_page_ptr_virt pageBits
          then partition_label Low else partition_label IRQ0)
            \<comment> \<open>set the range of the shared_page to Low, default everything else to IRQ0\<close>
     (Low_cnode_ptr := partition_label Low,
      High_cnode_ptr := partition_label High,
      ntfn_ptr := partition_label High,
      irq_cnode_ptr := partition_label IRQ0,
      Silc_cnode_ptr := SilcLabel,
      Low_pd_ptr := partition_label Low,
      High_pd_ptr := partition_label High,
      Low_pt_ptr := partition_label Low,
      High_pt_ptr := partition_label High,
      Low_tcb_ptr := partition_label Low,
      High_tcb_ptr := partition_label High,
      idle_tcb_ptr := partition_label Low)"

lemma Sys1AgentMap_simps:
  "Sys1AgentMap Low_cnode_ptr = partition_label Low"
      "Sys1AgentMap High_cnode_ptr = partition_label High"
      "Sys1AgentMap ntfn_ptr = partition_label High"
      "Sys1AgentMap irq_cnode_ptr = partition_label IRQ0"
      "Sys1AgentMap Silc_cnode_ptr = SilcLabel"
      "Sys1AgentMap Low_pd_ptr = partition_label Low"
      "Sys1AgentMap High_pd_ptr = partition_label High"
      "Sys1AgentMap Low_pt_ptr = partition_label Low"
      "Sys1AgentMap High_pt_ptr = partition_label High"
      "Sys1AgentMap Low_tcb_ptr = partition_label Low"
      "Sys1AgentMap High_tcb_ptr = partition_label High"
      "Sys1AgentMap idle_tcb_ptr = partition_label Low"
      "\<And>p. p \<in> ptr_range shared_page_ptr_virt pageBits
          \<Longrightarrow> Sys1AgentMap p = partition_label Low"
  unfolding Sys1AgentMap_def
  apply simp_all
  by (auto simp: s0_ptr_defs ptr_range_def pageBits_def)

definition
  Sys1ASIDMap :: "(auth_graph_label subject_label) agent_asid_map"
where
  "Sys1ASIDMap \<equiv>
    (\<lambda>x. if (asid_high_bits_of x = asid_high_bits_of Low_asid)
          then partition_label Low
         else if (asid_high_bits_of x = asid_high_bits_of High_asid)
          then partition_label High else undefined)"

(* We include 2 domains, Low is associated to domain 0, High to domain 1, we default the rest of the possible domains to High *)

definition Sys1PAS :: "(auth_graph_label subject_label) PAS" where
  "Sys1PAS \<equiv> \<lparr>
    pasObjectAbs = Sys1AgentMap,
    pasASIDAbs = Sys1ASIDMap,
    pasIRQAbs = (\<lambda>_. partition_label IRQ0),
    pasPolicy = Sys1AuthGraph,
    pasSubject = partition_label Low,
    pasMayActivate = True,
    pasMayEditReadyQueues = True, pasMaySendIrqs = False,
    pasDomainAbs = ((\<lambda>_. {partition_label High})(0 := {partition_label Low}))
   \<rparr>"

subsubsection \<open>Proof of pas_refined for Sys1\<close>

lemma High_caps_well_formed: "well_formed_cnode_n 10 High_caps"
  by (auto simp: High_caps_def well_formed_cnode_n_def  split: if_split_asm)

lemma Low_caps_well_formed: "well_formed_cnode_n 10 Low_caps"
  by (auto simp: Low_caps_def well_formed_cnode_n_def  split: if_split_asm)

lemma Silc_caps_well_formed: "well_formed_cnode_n 10 Silc_caps"
  by (auto simp: Silc_caps_def well_formed_cnode_n_def  split: if_split_asm)

lemma s0_caps_of_state :
  "caps_of_state s0_internal p = Some cap \<Longrightarrow>
     cap = NullCap \<or>
     (p,cap) \<in>
       { ((Low_cnode_ptr::obj_ref,(the_nat_to_bl_10 1)),  ThreadCap Low_tcb_ptr),
         ((Low_cnode_ptr::obj_ref,(the_nat_to_bl_10 2)),  CNodeCap Low_cnode_ptr 10 (the_nat_to_bl_10 2)),
         ((Low_cnode_ptr::obj_ref,(the_nat_to_bl_10 3)),  ArchObjectCap (PageDirectoryCap Low_pd_ptr (Some Low_asid))),
         ((Low_cnode_ptr::obj_ref,(the_nat_to_bl_10 318)),NotificationCap ntfn_ptr 0 {AllowSend}),
         ((High_cnode_ptr::obj_ref,(the_nat_to_bl_10 1)),  ThreadCap High_tcb_ptr),
         ((High_cnode_ptr::obj_ref,(the_nat_to_bl_10 2)),  CNodeCap High_cnode_ptr 10 (the_nat_to_bl_10 2)),
         ((High_cnode_ptr::obj_ref,(the_nat_to_bl_10 3)),  ArchObjectCap (PageDirectoryCap High_pd_ptr (Some High_asid))),
         ((High_cnode_ptr::obj_ref,(the_nat_to_bl_10 318)),NotificationCap  ntfn_ptr 0 {AllowRecv}) ,
         ((Silc_cnode_ptr::obj_ref,(the_nat_to_bl_10 2)),CNodeCap Silc_cnode_ptr 10 (the_nat_to_bl_10 2)),
         ((Silc_cnode_ptr::obj_ref,(the_nat_to_bl_10 318)),NotificationCap ntfn_ptr 0 {AllowSend}),
         ((Low_tcb_ptr::obj_ref, (tcb_cnode_index 0)), CNodeCap Low_cnode_ptr 10 (the_nat_to_bl_10 2)),
         ((Low_tcb_ptr::obj_ref, (tcb_cnode_index 1)), ArchObjectCap (PageDirectoryCap Low_pd_ptr (Some Low_asid))),
         ((Low_tcb_ptr::obj_ref, (tcb_cnode_index 2)), ReplyCap Low_tcb_ptr True {AllowGrant, AllowWrite}),
         ((Low_tcb_ptr::obj_ref, (tcb_cnode_index 3)), NullCap),
         ((Low_tcb_ptr::obj_ref, (tcb_cnode_index 4)), NullCap),
         ((High_tcb_ptr::obj_ref, (tcb_cnode_index 0)), CNodeCap High_cnode_ptr 10 (the_nat_to_bl_10 2)),
         ((High_tcb_ptr::obj_ref, (tcb_cnode_index 1)), ArchObjectCap (PageDirectoryCap High_pd_ptr (Some High_asid))),
         ((High_tcb_ptr::obj_ref, (tcb_cnode_index 2)), ReplyCap High_tcb_ptr True {AllowGrant, AllowWrite}),
         ((High_tcb_ptr::obj_ref, (tcb_cnode_index 3)), NullCap),
         ((High_tcb_ptr::obj_ref, (tcb_cnode_index 4)), NullCap)} "
  supply if_cong[cong]
  apply (insert High_caps_well_formed)
  apply (insert Low_caps_well_formed)
  apply (insert Silc_caps_well_formed)
  apply (simp add: caps_of_state_cte_wp_at cte_wp_at_cases s0_internal_def kh0_def kh0_obj_def)
  apply (case_tac p, clarsimp)
  apply (clarsimp split: if_splits)
       apply (clarsimp simp: cte_wp_at_cases tcb_cap_cases_def
                       split: if_split_asm)+
    apply (clarsimp simp: Silc_caps_def split: if_splits)
   apply (clarsimp simp: High_caps_def split: if_splits)
  apply (clarsimp simp: Low_caps_def cte_wp_at_cases split: if_splits)
  done

lemma tcb_states_of_state_s0:
  "tcb_states_of_state s0_internal = [High_tcb_ptr \<mapsto> thread_state.BlockedOnNotification ntfn_ptr,  Low_tcb_ptr \<mapsto> thread_state.Running, idle_tcb_ptr \<mapsto> thread_state.IdleThreadState ]"
  unfolding s0_internal_def tcb_states_of_state_def
  apply (rule ext)
  apply (simp add: get_tcb_def)
  apply (simp add: kh0_def kh0_obj_def)
  done

lemma thread_bounds_of_state_s0:
  "thread_bound_ntfns s0_internal = Map.empty"
  unfolding s0_internal_def thread_bound_ntfns_def
  apply (rule ext)
  apply (simp add: get_tcb_def)
  apply (simp add: kh0_def kh0_obj_def)
  done

lemma Sys1_wellformed':
  "policy_wellformed (pasPolicy Sys1PAS) False irqs x"
  apply (clarsimp simp: Sys1PAS_def policy_wellformed_def Sys1AuthGraph_def)
  done

corollary Sys1_wellformed:
  "x \<in> range (pasObjectAbs Sys1PAS) \<union> \<Union>(range (pasDomainAbs Sys1PAS)) - {SilcLabel} \<Longrightarrow>
   policy_wellformed (pasPolicy Sys1PAS) False irqs x"
  by (rule Sys1_wellformed')

lemma Sys1_pas_wellformed:
  "pas_wellformed Sys1PAS"
  apply (clarsimp simp: Sys1PAS_def policy_wellformed_def Sys1AuthGraph_def)
  done

lemma domains_of_state_s0[simp]:
  "domains_of_state s0_internal = {(High_tcb_ptr, High_domain), (Low_tcb_ptr, Low_domain), (idle_tcb_ptr, default_domain)}"
  apply(rule equalityI)
   apply(rule subsetI)
   apply clarsimp
   apply (erule domains_of_state_aux.cases)
   apply (clarsimp simp: s0_internal_def exst0_def ekh0_obj_def split: if_split_asm)
  apply clarsimp
  apply (force simp: s0_internal_def exst0_def ekh0_obj_def intro: domains_of_state_aux.domtcbs)+
  done

lemma Sys1_pas_refined:
  "pas_refined Sys1PAS s0_internal"
  apply (clarsimp simp: pas_refined_def)
  apply (intro conjI)
       apply (simp add: Sys1_pas_wellformed)
      apply (clarsimp simp: irq_map_wellformed_aux_def s0_internal_def Sys1PAS_def)
      apply (clarsimp simp: Sys1AgentMap_def)
      apply (clarsimp simp: s0_ptr_defs ptr_range_def pageBits_def cte_level_bits_def)
      apply word_bitwise
     apply (clarsimp simp: tcb_domain_map_wellformed_aux_def
                           Sys1PAS_def Sys1AgentMap_def
                           default_domain_def minBound_word
                           High_domain_def Low_domain_def cte_level_bits_def)
    apply (clarsimp simp: auth_graph_map_def
                          Sys1PAS_def
                          state_objs_to_policy_def
                          state_bits_to_policy_def)
    apply (erule state_bits_to_policyp.cases, simp_all, clarsimp)
        apply (drule s0_caps_of_state, clarsimp)
        apply (simp add: Sys1AuthGraph_def)
        apply (elim disjE conjE, auto simp: Sys1AgentMap_simps cap_auth_conferred_def cap_rights_to_auth_def)[1]
       apply (drule s0_caps_of_state, clarsimp)
       apply (elim disjE, simp_all)[1]
      apply (clarsimp simp: state_refs_of_def thread_st_auth_def tcb_states_of_state_s0
             Sys1AuthGraph_def Sys1AgentMap_simps split: if_splits)
      apply (clarsimp simp: state_refs_of_def thread_st_auth_def thread_bounds_of_state_s0)
     apply (simp add: s0_internal_def) (* this is OK because cdt is empty..*)
     apply (simp add: s0_internal_def) (* this is OK because cdt is empty..*)
    apply (clarsimp simp: state_vrefs_def
                           vs_refs_no_global_pts_def
                           s0_internal_def kh0_def  Sys1AgentMap_simps
                           kh0_obj_def comp_def Low_pt'_def High_pt'_def
                           pte_ref_def pde_ref2_def Low_pd'_def High_pd'_def
                           Sys1AuthGraph_def ptr_range_def vspace_cap_rights_to_auth_def
                           vm_read_only_def vm_read_write_def

                     dest!: graph_ofD
                     split: if_splits)
     apply (rule Sys1AgentMap_simps(13))
     apply (simp add: ptr_range_def pageBits_def shared_page_ptr_phys_def)
    apply (erule notE)
    apply (rule Sys1AgentMap_simps(13)[symmetric])
    apply (simp add: ptr_range_def pageBits_def shared_page_ptr_phys_def)

   apply (rule subsetI, clarsimp)
   apply (erule state_asids_to_policy_aux.cases)
     apply clarsimp
     apply (drule s0_caps_of_state, clarsimp)
     apply (simp add: Sys1AuthGraph_def Sys1PAS_def Sys1ASIDMap_def)
     apply (elim disjE conjE, simp_all add: Sys1AgentMap_simps cap_auth_conferred_def
                                            cap_rights_to_auth_def Low_asid_def High_asid_def
       asid_low_bits_def asid_high_bits_of_def )[1]
    apply (clarsimp simp: state_vrefs_def
                           vs_refs_no_global_pts_def
                           s0_internal_def kh0_def  Sys1AgentMap_simps
                           kh0_obj_def comp_def Low_pt'_def High_pt'_def
                           pte_ref_def pde_ref2_def Low_pd'_def High_pd'_def
                           Sys1AuthGraph_def ptr_range_def
                     dest!: graph_ofD
                     split: if_splits)
   apply (clarsimp simp: s0_internal_def arch_state0_def)
  apply (rule subsetI, clarsimp)
  apply (erule state_irqs_to_policy_aux.cases)
   apply (simp add: Sys1AuthGraph_def Sys1PAS_def Sys1ASIDMap_def)
   apply (drule s0_caps_of_state)
   apply (simp add: Sys1AuthGraph_def Sys1PAS_def Sys1ASIDMap_def)
   apply (elim disjE conjE, simp_all add: Sys1AgentMap_simps cap_auth_conferred_def cap_rights_to_auth_def Low_asid_def High_asid_def
     asid_low_bits_def asid_high_bits_of_def )[1]
   done

lemma Sys1_pas_cur_domain:
  "pas_cur_domain Sys1PAS s0_internal"
  by (simp add: s0_internal_def exst0_def Sys1PAS_def)

lemma Sys1_current_subject_idemp:
  "Sys1PAS\<lparr>pasSubject := the_elem (pasDomainAbs Sys1PAS (cur_domain s0_internal))\<rparr> = Sys1PAS"
  apply (simp add: Sys1PAS_def s0_internal_def exst0_def)
  done

lemma pasMaySendIrqs_Sys1PAS[simp]:
  "pasMaySendIrqs Sys1PAS = False"
  by(auto simp: Sys1PAS_def)

lemma Sys1_pas_domains_distinct:
  "pas_domains_distinct Sys1PAS"
  apply (clarsimp simp: Sys1PAS_def pas_domains_distinct_def)
  done

lemma Sys1_pas_wellformed_noninterference:
  "pas_wellformed_noninterference Sys1PAS"
  apply (simp add: pas_wellformed_noninterference_def)
  apply (intro conjI ballI allI)
    apply (blast intro: Sys1_wellformed)
   apply (clarsimp simp: Sys1PAS_def policy_wellformed_def Sys1AuthGraph_def)
  apply (rule Sys1_pas_domains_distinct)
  done

lemma silc_inv_s0:
  "silc_inv Sys1PAS s0_internal s0_internal"
  apply (clarsimp simp: silc_inv_def)
  apply (rule conjI, simp add: Sys1PAS_def)
  apply (rule conjI)
   apply (clarsimp simp: Sys1PAS_def Sys1AgentMap_def
                         s0_internal_def kh0_def obj_at_def kh0_obj_def
                         is_cap_table_def Silc_caps_well_formed split: if_split_asm)
  apply (rule conjI)
   apply (clarsimp simp: Sys1PAS_def Sys1AuthGraph_def)
  apply (rule conjI)
   apply clarsimp
   apply (rule_tac x=Silc_cnode_ptr in exI)
   apply (rule conjI)
    apply (rule_tac x="the_nat_to_bl_10 318" in exI)
    apply (clarsimp simp: slots_holding_overlapping_caps_def2)
    apply (case_tac "cap = NullCap")
     apply clarsimp
     apply (simp add: cte_wp_at_cases s0_internal_def kh0_def kh0_obj_def)
     apply (case_tac a, clarsimp)
     apply (clarsimp split: if_splits)
            apply ((clarsimp simp: intra_label_cap_def cte_wp_at_cases tcb_cap_cases_def
                                   cap_points_to_label_def split: if_split_asm)+)[8]
    apply (clarsimp simp: intra_label_cap_def cap_points_to_label_def)
    apply (drule cte_wp_at_caps_of_state' s0_caps_of_state)+
    apply ((erule disjE |
          clarsimp simp: Sys1PAS_def Sys1AgentMap_simps
              the_nat_to_bl_def nat_to_bl_def ctes_wp_at_def cte_wp_at_cases
              s0_internal_def kh0_def kh0_obj_def Silc_caps_well_formed obj_refs_def
         | simp add: Silc_caps_def)+)[1]
   apply (simp add: Sys1PAS_def Sys1AgentMap_simps)
  apply (intro conjI)
  apply (clarsimp simp: all_children_def s0_internal_def silc_dom_equiv_def equiv_for_refl)
  apply (clarsimp simp: all_children_def s0_internal_def silc_dom_equiv_def equiv_for_refl)
  apply (clarsimp simp: Invariants_AI.cte_wp_at_caps_of_state )
  by (auto simp:is_transferable.simps dest:s0_caps_of_state)


lemma only_timer_irq_s0:
  "only_timer_irq timer_irq s0_internal"
  apply (clarsimp simp: only_timer_irq_def s0_internal_def irq_is_recurring_def is_irq_at_def
                        irq_at_def Let_def irq_oracle_def machine_state0_def timer_irq_def)
  apply presburger
  done

lemma domain_sep_inv_s0:
  "domain_sep_inv False s0_internal s0_internal"
  apply (clarsimp simp: domain_sep_inv_def)
  apply (force dest: cte_wp_at_caps_of_state' s0_caps_of_state
        | rule conjI allI | clarsimp simp: s0_internal_def)+
  done

lemma only_timer_irq_inv_s0:
  "only_timer_irq_inv timer_irq s0_internal s0_internal"
  by (simp add: only_timer_irq_inv_def only_timer_irq_s0 domain_sep_inv_s0)

lemma Sys1_guarded_pas_domain:
  "guarded_pas_domain Sys1PAS s0_internal"
  by (clarsimp simp: guarded_pas_domain_def Sys1PAS_def s0_internal_def
                     exst0_def Sys1AgentMap_simps)

lemma s0_valid_domain_list:
  "valid_domain_list s0_internal"
  by (clarsimp simp: valid_domain_list_2_def s0_internal_def exst0_def)


definition
  "s0 \<equiv> ((if ct_idle s0_internal then idle_context s0_internal else s0_context,s0_internal),KernelExit)"



subsubsection \<open>einvs\<close>


lemma well_formed_cnode_n_s0_caps[simp]:
  "well_formed_cnode_n 10 High_caps"
  "well_formed_cnode_n 10 Low_caps"
  "well_formed_cnode_n 10 Silc_caps"
  "\<not> well_formed_cnode_n 10 [[] \<mapsto> NullCap]"
  apply ((force simp: High_caps_def Low_caps_def Silc_caps_def well_formed_cnode_n_def
                  the_nat_to_bl_def nat_to_bl_def dom_empty_cnode)+)[3]
  apply (clarsimp simp: well_formed_cnode_n_def)
  apply (drule eqset_imp_iff[where x="[]"])
  apply simp
  done

lemma valid_caps_s0[simp]:
  "s0_internal \<turnstile> ThreadCap Low_tcb_ptr"
  "s0_internal \<turnstile> ThreadCap High_tcb_ptr"
  "s0_internal \<turnstile> CNodeCap Low_cnode_ptr 10 (the_nat_to_bl_10 2)"
  "s0_internal \<turnstile> CNodeCap High_cnode_ptr 10 (the_nat_to_bl_10 2)"
  "s0_internal \<turnstile> CNodeCap Silc_cnode_ptr 10 (the_nat_to_bl_10 2)"
  "s0_internal \<turnstile> ArchObjectCap (PageDirectoryCap Low_pd_ptr (Some Low_asid))"
  "s0_internal \<turnstile> ArchObjectCap (PageDirectoryCap High_pd_ptr (Some High_asid))"
  "s0_internal \<turnstile> NotificationCap ntfn_ptr 0 {AllowWrite}"
  "s0_internal \<turnstile> NotificationCap ntfn_ptr 0 {AllowRead}"
  "s0_internal \<turnstile> ReplyCap Low_tcb_ptr True {AllowGrant,AllowWrite}"
  "s0_internal \<turnstile> ReplyCap High_tcb_ptr True {AllowGrant,AllowWrite}"
  by (simp_all add: valid_cap_def s0_internal_def s0_ptr_defs cap_aligned_def is_aligned_def
                       word_bits_def cte_level_bits_def the_nat_to_bl_def
                       nat_to_bl_def Low_asid_def High_asid_def asid_low_bits_def asid_bits_def
                       obj_at_def kh0_def kh0_obj_def is_tcb_def is_cap_table_def a_type_def
                       is_ntfn_def)

lemma valid_obj_s0[simp]:
  "valid_obj Low_cnode_ptr  Low_cnode s0_internal"
  "valid_obj High_cnode_ptr High_cnode s0_internal"
  "valid_obj Silc_cnode_ptr Silc_cnode s0_internal"
  "valid_obj ntfn_ptr        ntfn s0_internal"
  "valid_obj irq_cnode_ptr  irq_cnode s0_internal"
  "valid_obj Low_pd_ptr     Low_pd s0_internal"
  "valid_obj High_pd_ptr    High_pd s0_internal"
  "valid_obj Low_pt_ptr     Low_pt s0_internal"
  "valid_obj High_pt_ptr    High_pt s0_internal"
  "valid_obj Low_tcb_ptr    Low_tcb s0_internal"
  "valid_obj High_tcb_ptr   High_tcb s0_internal"
  "valid_obj idle_tcb_ptr   idle_tcb s0_internal"
  "valid_obj init_global_pd (ArchObj (PageDirectory ((\<lambda>_. InvalidPDE)
            (ucast (kernel_base >> 20) := SectionPDE (addrFromPPtr kernel_base) {} 0 {}))))
                                     s0_internal"
  "valid_obj init_globals_frame (ArchObj (DataPage False ARMSmallPage)) s0_internal"
               apply (simp_all add: valid_obj_def kh0_obj_def)
              apply (simp add: valid_cs_def Low_caps_ran High_caps_ran Silc_caps_ran
                               valid_cs_size_def word_bits_def cte_level_bits_def)+
           apply (simp add: valid_ntfn_def obj_at_def s0_internal_def kh0_def
                            High_tcb_def is_tcb_def)
          apply (simp add: valid_cs_def valid_cs_size_def word_bits_def cte_level_bits_def)
          apply (simp add: well_formed_cnode_n_def)
         apply (fastforce simp: Low_pd'_def High_pd'_def Low_pt'_def High_pt'_def
                                Low_pt_ptr_def High_pt_ptr_def
                                shared_page_ptr_phys_def shared_page_ptr_virt_def
                                valid_vm_rights_def vm_kernel_only_def
                                kernel_base_def pageBits_def pt_bits_def vmsz_aligned_def
                                is_aligned_def[THEN iffD2]
                                is_aligned_addrFromPPtr_n)+
     apply (clarsimp simp: valid_tcb_def tcb_cap_cases_def is_master_reply_cap_def
                           valid_ipc_buffer_cap_def valid_tcb_state_def valid_arch_tcb_def
           | simp add: obj_at_def s0_internal_def kh0_def kh0_obj_def is_ntfn_def
                       is_valid_vtable_root_def)+
  apply (simp add: valid_vm_rights_def vm_kernel_only_def
                   kernel_base_def pageBits_def vmsz_aligned_def
                   is_aligned_def[THEN iffD2]
                   is_aligned_addrFromPPtr_n)
  done

lemma valid_objs_s0:
  "valid_objs s0_internal"
  apply (clarsimp simp: valid_objs_def)
  apply (subst(asm) s0_internal_def kh0_def)+
  apply (simp split: if_split_asm)
    apply force+
  apply (clarsimp simp: valid_obj_def valid_cs_def empty_cnode_def valid_cs_size_def ran_def
                        cte_level_bits_def word_bits_def well_formed_cnode_n_def dom_def)
  done

lemma pspace_aligned_s0:
  "pspace_aligned s0_internal"
  apply (clarsimp simp: pspace_aligned_def s0_internal_def)
  apply (drule kh0_SomeD)
  apply (erule disjE
         | (subst is_aligned_def,
           fastforce simp: s0_ptr_defs cte_level_bits_def kh0_def kh0_obj_def))+
  apply (clarsimp simp: cte_level_bits_def)
  apply (drule irq_node_offs_range_correct)
  apply (clarsimp simp: s0_ptr_defs cte_level_bits_def)
  apply (rule is_aligned_add[OF _ is_aligned_shift])
  apply (simp add: is_aligned_def s0_ptr_defs cte_level_bits_def)
  done

lemma pspace_distinct_s0:
  "pspace_distinct s0_internal"
  apply (clarsimp simp: pspace_distinct_def s0_internal_def)
  apply (drule kh0_SomeD)+
  apply (case_tac "x \<in> irq_node_offs_range \<and> y \<in> irq_node_offs_range")
   apply clarsimp
   apply (drule irq_node_offs_range_correct)+
   apply clarsimp
   apply (clarsimp simp: s0_ptr_defs cte_level_bits_def)
   apply (case_tac "(ucast irq << 4) < (ucast irqa << 4)")
    apply (frule udvd_decr'[where K="0x10::32 word" and ua=0, simplified])
       apply (simp add: shiftl_t2n uint_word_ariths)
       apply (subst mod_mult_mult1[where c="2^4" and b="2^28", simplified])
       apply simp
      apply (simp add: shiftl_t2n uint_word_ariths)
      apply (subst mod_mult_mult1[where c="2^4" and b="2^28", simplified])
      apply simp
     apply (simp add: shiftl_def uint_shiftl word_size bintrunc_shiftl)
     apply (simp add: shiftl_int_def take_bit_eq_mod push_bit_eq_mult)
    apply (frule_tac y="ucast irq << 4" in word_plus_mono_right[where x="0xE000800F"])
     apply (simp add: shiftl_t2n)
     apply (case_tac "(1::32 word) \<le> ucast irqa")
      apply (drule_tac i=1 and k="0x10" in word_mult_le_mono1)
        apply simp
       apply (cut_tac x=irqa and 'a=32 in ucast_less)
        apply simp
       apply (simp add: word_less_nat_alt)
      apply (simp add: mult.commute)
      apply (drule_tac y="0x10" and x="0xE0007FFF" in word_plus_mono_right)
       apply (rule_tac sz=28 in machine_word_plus_mono_right_split)
        apply (simp add: unat_word_ariths mask_def)
        apply (cut_tac x=irqa and 'a=32 in ucast_less)
         apply simp
        apply (simp add: word_less_nat_alt)
       apply (simp add: word_bits_def)
      apply simp
     apply (simp add: lt1_neq0)
    apply (drule(1) order_trans_rules(23))
    apply clarsimp
    apply (drule_tac a="0xE0008000 + (ucast irqa << 4)" and b="ucast irqa << 4"
                 and c="0xE0007FFF + (ucast irqa << 4)" and d="ucast irqa << 4" in word_sub_mono)
       apply simp
      apply simp
      apply (rule_tac sz=28 in machine_word_plus_mono_right_split)
       apply (simp add: unat_word_ariths mask_def shiftl_t2n)
       apply (cut_tac x=irqa and 'a=32 in ucast_less)
        apply simp
       apply (simp add: word_less_nat_alt)
      apply (simp add: word_bits_def)
     apply simp
     apply (rule_tac sz=28 in machine_word_plus_mono_right_split)
      apply (simp add: unat_word_ariths mask_def shiftl_t2n)
      apply (cut_tac x=irqa and 'a=32 in ucast_less)
       apply simp
      apply (simp add: word_less_nat_alt)
     apply (simp add: word_bits_def)
    apply simp
   apply (case_tac "(ucast irq << 4) > (ucast irqa << 4)")
    apply (frule udvd_decr'[where K="0x10::32 word" and ua=0, simplified])
       apply (simp add: shiftl_t2n uint_word_ariths)
       apply (subst mod_mult_mult1[where c="2^4" and b="2^28", simplified])
       apply simp
      apply (simp add: shiftl_t2n uint_word_ariths)
      apply (subst mod_mult_mult1[where c="2^4" and b="2^28", simplified])
      apply simp
     apply (simp add: shiftl_def uint_shiftl word_size bintrunc_shiftl)
     apply (simp add: shiftl_int_def take_bit_eq_mod push_bit_eq_mult)
    apply (frule_tac y="ucast irqa << 4" in word_plus_mono_right[where x="0xE000800F"])
     apply (simp add: shiftl_t2n)
     apply (case_tac "(1::32 word) \<le> ucast irq")
      apply (drule_tac i=1 and k="0x10" in word_mult_le_mono1)
        apply simp
       apply (cut_tac x=irq and 'a=32 in ucast_less)
        apply simp
       apply (simp add: word_less_nat_alt)
      apply (simp add: mult.commute)
      apply (drule_tac y="0x10" and x="0xE0007FFF" in word_plus_mono_right)
       apply (rule_tac sz=28 in machine_word_plus_mono_right_split)
        apply (simp add: unat_word_ariths mask_def)
        apply (cut_tac x=irq and 'a=32 in ucast_less)
         apply simp
        apply (simp add: word_less_nat_alt)
       apply (simp add: word_bits_def)
      apply simp
     apply (simp add: lt1_neq0)
    apply (drule(1) order_trans_rules(23))
    apply clarsimp
    apply (drule_tac a="0xE0008000 + (ucast irq << 4)" and b="ucast irq << 4"
                 and c="0xE0007FFF + (ucast irq << 4)" and d="ucast irq << 4" in word_sub_mono)
       apply simp
      apply simp
      apply (rule_tac sz=28 in machine_word_plus_mono_right_split)
       apply (simp add: unat_word_ariths mask_def shiftl_t2n)
       apply (cut_tac x=irq and 'a=32 in ucast_less)
        apply simp
       apply (simp add: word_less_nat_alt)
      apply (simp add: word_bits_def)
     apply simp
     apply (rule_tac sz=28 in machine_word_plus_mono_right_split)
      apply (simp add: unat_word_ariths mask_def shiftl_t2n)
      apply (cut_tac x=irq and 'a=32 in ucast_less)
       apply simp
      apply (simp add: word_less_nat_alt)
     apply (simp add: word_bits_def)
    apply simp
   apply simp
  by ((simp | erule disjE | clarsimp simp: kh0_obj_def cte_level_bits_def s0_ptr_defs
        | clarsimp simp: irq_node_offs_range_def s0_ptr_defs,
          drule_tac x="0xF" in word_plus_strict_mono_right, simp, simp add: add.commute,
          drule(1) notE[rotated, OF less_trans, OF _ _ leD, rotated 2] |
          drule(1) notE[rotated, OF le_less_trans, OF _ _ leD, rotated 2], simp, assumption)+)

lemma valid_pspace_s0[simp]:
  "valid_pspace s0_internal"
  apply (simp add: valid_pspace_def pspace_distinct_s0 pspace_aligned_s0 valid_objs_s0)
  apply (rule conjI)
   apply (clarsimp simp: if_live_then_nonz_cap_def)
   apply (subst(asm) s0_internal_def)
   apply (clarsimp simp: live_def hyp_live_def obj_at_def kh0_def kh0_obj_def s0_ptr_defs split: if_split_asm)
     apply (clarsimp simp: ex_nonz_cap_to_def)
     apply (rule_tac x="High_cnode_ptr" in exI)
     apply (rule_tac x="the_nat_to_bl_10 1" in exI)
     apply (force simp: cte_wp_at_cases s0_internal_def kh0_def kh0_obj_def s0_ptr_defs tcb_cap_cases_def High_caps_def the_nat_to_bl_def nat_to_bl_def well_formed_cnode_n_def dom_empty_cnode)
    apply (clarsimp simp: ex_nonz_cap_to_def)
    apply (rule_tac x="Low_cnode_ptr" in exI)
    apply (rule_tac x="the_nat_to_bl_10 1" in exI)
    apply (force simp: cte_wp_at_cases s0_internal_def kh0_def kh0_obj_def s0_ptr_defs tcb_cap_cases_def Low_caps_def the_nat_to_bl_def nat_to_bl_def well_formed_cnode_n_def dom_empty_cnode)
   apply (clarsimp simp: ex_nonz_cap_to_def)
   apply (rule_tac x="High_cnode_ptr" in exI)
   apply (rule_tac x="the_nat_to_bl_10 318" in exI)
   apply (force simp: cte_wp_at_cases s0_internal_def kh0_def kh0_obj_def s0_ptr_defs tcb_cap_cases_def High_caps_def the_nat_to_bl_def nat_to_bl_def well_formed_cnode_n_def dom_empty_cnode)
  apply (rule conjI)
   apply (simp add: Invariants_AI.cte_wp_at_caps_of_state zombies_final_def)
   apply (force dest: s0_caps_of_state simp: is_zombie_def)
  apply (rule conjI)
   apply (clarsimp simp: sym_refs_def state_refs_of_def state_hyp_refs_of_def s0_internal_def)
   apply (subst(asm) kh0_def)
   apply (clarsimp split: if_split_asm)
   apply (simp add: refs_of_def kh0_def s0_ptr_defs kh0_obj_def)+
  apply (clarsimp simp: sym_refs_def state_hyp_refs_of_def s0_internal_def)
  apply (subst(asm) kh0_def)
  apply (clarsimp split: if_split_asm)
             by (simp add: refs_of_def kh0_def s0_ptr_defs kh0_obj_def)+

lemma descendants_s0[simp]:
  "descendants_of (a, b) (cdt s0_internal) = {}"
  apply (rule set_eqI)
  apply clarsimp
  apply (drule descendants_of_NoneD[rotated])
   apply (simp add: s0_internal_def)+
   done

lemma valid_mdb_s0[simp]:
  "valid_mdb s0_internal"
  apply (simp add: valid_mdb_def reply_mdb_def)
  apply (intro conjI)
           apply (clarsimp simp: mdb_cte_at_def s0_internal_def)
          apply (force dest: s0_caps_of_state simp: untyped_mdb_def)
         apply (clarsimp simp: descendants_inc_def)
        apply (clarsimp simp: no_mloop_def s0_internal_def cdt_parent_defs)
       apply (clarsimp simp: untyped_inc_def)
       apply (drule s0_caps_of_state)+
       apply ((simp | erule disjE)+)[1]
      apply (force dest: s0_caps_of_state simp: ut_revocable_def)
     apply (force dest: s0_caps_of_state simp: irq_revocable_def)
    apply (clarsimp simp: reply_master_revocable_def)
    apply (drule s0_caps_of_state)
    apply ((simp add: is_master_reply_cap_def s0_internal_def s0_ptr_defs | erule disjE)+)[1]
   apply (force dest: s0_caps_of_state simp: reply_caps_mdb_def)
  apply (clarsimp simp: reply_masters_mdb_def)
  apply (simp add: s0_internal_def)
  done

lemma valid_ioc_s0[simp]:
  "valid_ioc s0_internal"
  by (clarsimp simp: cte_wp_at_cases tcb_cap_cases_def valid_ioc_def
                        s0_internal_def kh0_def kh0_obj_def split: if_split_asm)+

lemma valid_idle_s0[simp]:
  "valid_idle s0_internal"
  apply (clarsimp simp: valid_idle_def st_tcb_at_tcb_states_of_state_eq
                        thread_bounds_of_state_s0
                        identity_eq[symmetric] tcb_states_of_state_s0
                        valid_arch_idle_def)
  by (simp add: s0_ptr_defs s0_internal_def idle_thread_ptr_def pred_tcb_at_def obj_at_def kh0_def idle_tcb_def)

lemma only_idle_s0[simp]:
  "only_idle s0_internal"
  apply (clarsimp simp: only_idle_def st_tcb_at_tcb_states_of_state_eq
                        identity_eq[symmetric] tcb_states_of_state_s0)
  apply (simp add: s0_ptr_defs s0_internal_def)
  done

lemma if_unsafe_then_cap_s0[simp]:
  "if_unsafe_then_cap s0_internal"
  apply (clarsimp simp: if_unsafe_then_cap_def ex_cte_cap_wp_to_def)
  apply (drule s0_caps_of_state)
  apply (case_tac "a=Low_cnode_ptr")
   apply (rule_tac x=Low_tcb_ptr in exI, rule_tac x="tcb_cnode_index 0" in exI)
   apply ((clarsimp simp: cte_wp_at_cases s0_internal_def kh0_def kh0_obj_def
                          tcb_cap_cases_def the_nat_to_bl_def nat_to_bl_def
                          Low_caps_def | erule disjE)+)[1]
  apply (case_tac "a=High_cnode_ptr")
   apply (rule_tac x=High_tcb_ptr in exI, rule_tac x="tcb_cnode_index 0" in exI)
   apply ((clarsimp simp: cte_wp_at_cases s0_internal_def kh0_def kh0_obj_def
                          tcb_cap_cases_def the_nat_to_bl_def nat_to_bl_def
                          High_caps_def | erule disjE)+)[1]
  apply (case_tac "a=Low_tcb_ptr")
   apply (rule_tac x=Low_cnode_ptr in exI, rule_tac x="the_nat_to_bl_10 1" in exI)
   apply ((clarsimp simp: cte_wp_at_cases s0_internal_def kh0_def kh0_obj_def
                          tcb_cap_cases_def the_nat_to_bl_def nat_to_bl_def
                          Low_caps_def well_formed_cnode_n_def dom_empty_cnode
         | erule disjE | force)+)[1]
  apply (case_tac "a=High_tcb_ptr")
   apply (rule_tac x=High_cnode_ptr in exI, rule_tac x="the_nat_to_bl_10 1" in exI)
   apply ((clarsimp simp: cte_wp_at_cases s0_internal_def kh0_def kh0_obj_def
                          tcb_cap_cases_def the_nat_to_bl_def nat_to_bl_def
                          High_caps_def well_formed_cnode_n_def dom_empty_cnode
         | erule disjE | force)+)[1]
  apply (rule_tac x=Silc_cnode_ptr in exI, rule_tac x="the_nat_to_bl_10 2" in exI)
  apply ((clarsimp simp: cte_wp_at_cases s0_internal_def kh0_def kh0_obj_def
                         tcb_cap_cases_def the_nat_to_bl_def nat_to_bl_def
                         Silc_caps_def well_formed_cnode_n_def dom_empty_cnode
        | erule disjE | force)+)[1]
  done

lemma valid_reply_caps_s0[simp]:
  "valid_reply_caps s0_internal"
  apply (clarsimp simp: valid_reply_caps_def)
  apply (rule conjI)
   apply (force  dest: s0_caps_of_state
                 simp: Invariants_AI.cte_wp_at_caps_of_state has_reply_cap_def is_reply_cap_to_def)
  apply (clarsimp simp: unique_reply_caps_def)
  apply (drule s0_caps_of_state)+
  apply (erule disjE | simp add: is_reply_cap_def)+
  done

lemma valid_reply_masters_s0[simp]:
  "valid_reply_masters s0_internal"
  apply (clarsimp simp: valid_reply_masters_def)
  apply (force dest: s0_caps_of_state
               simp: Invariants_AI.cte_wp_at_caps_of_state  is_master_reply_cap_to_def)
  done

lemma valid_global_refs_s0[simp]:
  "valid_global_refs s0_internal"
  apply (clarsimp simp: valid_global_refs_def valid_refs_def)
  apply (simp add: Invariants_AI.cte_wp_at_caps_of_state)
  apply clarsimp
  apply (drule s0_caps_of_state)
  apply (clarsimp simp: global_refs_def s0_internal_def arch_state0_def)
  apply (erule disjE | simp add: cap_range_def
                     | clarsimp simp: irq_node_offs_distinct[symmetric]
                     | simp only: s0_ptr_defs, force)+
  done

lemma valid_arch_state_s0[simp]:
  "valid_arch_state s0_internal"
  apply (clarsimp simp: valid_arch_state_def s0_internal_def arch_state0_def)
  apply (intro conjI)
      apply (clarsimp simp: obj_at_def kh0_def)
     apply (simp add: valid_asid_table_def)
    apply (clarsimp simp: obj_at_def kh0_def a_type_def)
   apply (simp add: valid_global_pts_def)
  apply (simp add: is_inv_def)
  done

lemma valid_irq_node_s0[simp]:
  "valid_irq_node s0_internal"
  apply (clarsimp simp: valid_irq_node_def)
  apply (rule conjI)
   apply (simp add: s0_internal_def)
   apply (rule injI)
   apply simp
   apply (rule ccontr)
   apply (rule_tac bnd="0x400" and 'a=32 in shift_distinct_helper[rotated 3])
        apply assumption
       apply (simp add: cte_level_bits_def)
      apply (simp add: cte_level_bits_def)
     apply (rule ucast_less[where 'b=10, simplified])
     apply simp
    apply (rule ucast_less[where 'b=10, simplified])
    apply simp
   apply (rule notI)
   apply (drule ucast_up_inj)
    apply simp
   apply simp
  apply (clarsimp simp: obj_at_def s0_internal_def)
  apply (force simp: kh0_def is_cap_table_def well_formed_cnode_n_def dom_empty_cnode)
  done

lemma valid_irq_handlers_s0[simp]:
  "valid_irq_handlers s0_internal"
  apply (clarsimp simp: valid_irq_handlers_def ran_def)
  apply (force dest: s0_caps_of_state)
  done

lemma valid_irq_state_s0[simp]:
  "valid_irq_states s0_internal"
  apply (clarsimp simp: valid_irq_states_def valid_irq_masks_def s0_internal_def machine_state0_def)
  done

lemma valid_machine_state_s0[simp]:
  "valid_machine_state s0_internal"
  apply (clarsimp simp: valid_machine_state_def s0_internal_def machine_state0_def in_user_frame_def obj_at_def const_def)
  done

lemma valid_arch_objs_s0[simp]:
  "valid_vspace_objs s0_internal"
  apply (clarsimp simp: valid_vspace_objs_def obj_at_def s0_internal_def)
  apply (drule kh0_SomeD)
  apply (erule disjE | clarsimp simp: addrFromPPtr_def
         | erule vs_lookupE, force simp: arch_state0_def vs_asid_refs_def)+
  done


lemma valid_arch_caps_s0[simp]:
  "valid_arch_caps s0_internal"
  apply (clarsimp simp: valid_arch_caps_def)
  apply (intro conjI)
     apply (clarsimp simp: valid_vs_lookup_def vs_lookup_pages_def vs_asid_refs_def
                           s0_internal_def arch_state0_def)
    apply (clarsimp simp: valid_table_caps_def is_pd_cap_def is_pt_cap_def)
    apply (drule s0_caps_of_state)
    apply (erule disjE | simp)+
   apply (clarsimp simp: unique_table_caps_def is_pd_cap_def is_pt_cap_def)
   apply (drule s0_caps_of_state)+
   apply (erule disjE | simp)+
  apply (clarsimp simp: unique_table_refs_def table_cap_ref_def)
  apply (drule s0_caps_of_state)+
  by auto

lemma valid_global_objs_s0[simp]:
  "valid_global_objs s0_internal"
  apply (clarsimp simp: valid_global_objs_def s0_internal_def arch_state0_def)
  apply (force simp: valid_vso_at_def obj_at_def kh0_def kh0_obj_def
                     is_aligned_addrFromPPtr kernel_base_aligned_pageBits
                     kernel_mapping_slots_def empty_table_def pde_ref_def valid_pde_mappings_def)
  done

lemma valid_kernel_mappings_s0[simp]:
  "valid_kernel_mappings s0_internal"
  apply (clarsimp simp: valid_kernel_mappings_def s0_internal_def ran_def
                 valid_kernel_mappings_if_pd_def split: kernel_object.splits
                                                        arch_kernel_obj.splits)
  apply (drule kh0_SomeD)
  apply (clarsimp simp: arch_state0_def kernel_mapping_slots_def)
  apply (erule disjE | simp add: pde_ref_def s0_ptr_defs kh0_obj_def High_pd'_def Low_pd'_def
                          split: if_split_asm pde.splits)+
  done

lemma equal_kernel_mappings_s0[simp]:
  "equal_kernel_mappings s0_internal"
  apply (clarsimp simp: equal_kernel_mappings_def obj_at_def s0_internal_def)
  apply (drule kh0_SomeD)+
  apply (force simp: kh0_obj_def High_pd'_def Low_pd'_def s0_ptr_defs kernel_mapping_slots_def)
  done

lemma valid_asid_map_s0[simp]:
  "valid_asid_map s0_internal"
  apply (clarsimp simp: valid_asid_map_def s0_internal_def arch_state0_def)
  done

lemma valid_global_pd_mappings_s0[simp]:
  "valid_global_vspace_mappings s0_internal"
  apply (clarsimp simp: valid_global_vspace_mappings_def s0_internal_def arch_state0_def
                        obj_at_def kh0_def kh0_obj_def s0_ptr_defs valid_pd_kernel_mappings_def
                        valid_pde_kernel_mappings_def pde_mapping_bits_def mask_def)
  apply (rule conjI)
   apply force
  apply clarsimp
  apply (subgoal_tac "xa - 0xFFFFF \<le> ucast x << 20")
   apply (case_tac "ucast x << 20 > (0xE0000000::32 word)")
    apply (subgoal_tac "(0xE0100000::32 word) \<le> ucast x << 20")
     apply ((drule(1) order_trans_rules(23))+, force)
    apply (simp add: shiftl_t2n)
    apply (cut_tac p="0xE0000000::32 word" and n=20 and m=20 and q="0x100000 * ucast x" in word_plus_power_2_offset_le)
         apply (simp add: is_aligned_def)
        apply (simp add: is_aligned_def unat_word_ariths)
        apply (subst mod_mult_mult1[where c="2^20" and b="2^12", simplified])
        apply simp
       apply simp
      apply simp
     apply simp
    apply simp
   apply (case_tac "ucast x << 20 < (0xE0000000::32 word)")
    apply (subgoal_tac "(0xE0000000::32 word) - 0x100000 \<ge> ucast x << 20")
     apply (subgoal_tac "0xFFFFF + (ucast x << 20) \<le> 0xDFFFFFFF")
      apply (drule_tac y="0xFFFFF + (ucast x << 20)" and z="0xDFFFFFFF::32 word" in order_trans_rules(23))
       apply simp
      apply ((drule(1) order_trans_rules(23))+, force)
     apply (simp add: add.commute)
     apply (simp add: word_plus_mono_left[where x="0xFFFFF" and z="0xDFF00000", simplified])
    apply (simp add: shiftl_t2n)
    apply (rule udvd_decr'[where K="0x100000" and q="0xE0000000" and ua=0, simplified])
       apply simp
      apply (simp add: uint_word_ariths)
      apply (subst mod_mult_mult1[where c="2^20" and b="2^12", simplified])
      apply simp
     apply simp
    apply simp
   apply (erule notE)
   apply (cut_tac x="ucast x::32 word" and n=20 in shiftl_shiftr_id)
     apply simp
    apply (simp add: ucast_less[where 'b=12, simplified])
   apply simp
   apply (rule ucast_up_inj[where 'b=32])
    apply simp
   apply simp
  apply (drule_tac c="0xFFFFF + (ucast x << 20)" and d="0xFFFFF" and b="0xFFFFF" in word_sub_mono)
     apply simp
    apply (rule word_sub_le)
    apply (rule order_trans_rules(23)[rotated], assumption)
    apply simp
   apply (simp add: add.commute)
   apply (rule no_plus_overflow_neg)
   apply simp
   apply (drule_tac x="ucast x << 20" in order_trans_rules(23), assumption)
   apply (simp add: le_less_trans)
  apply simp
  done

lemma pspace_in_kernel_window_s0[simp]:
  "pspace_in_kernel_window s0_internal"
  apply (clarsimp simp: pspace_in_kernel_window_def s0_internal_def)
  apply (drule kh0_SomeD)
  apply (erule disjE | simp add: arch_state0_def kh0_obj_def s0_ptr_defs mask_def
                                 irq_node_offs_range_def cte_level_bits_def | rule conjI
                     | rule order_trans_rules(23)[rotated] order_trans_rules(23), force, force)+
   apply (force intro: order_trans_rules(23)[rotated])
  apply clarsimp
  apply (drule_tac x=y in le_less_trans)
   apply (rule neq_le_trans[rotated])
    apply (rule word_plus_mono_right)
     apply (rule less_imp_le)
     apply simp+
  apply (force intro: less_imp_le less_le_trans)
  done

lemma cap_refs_in_kernel_window_s0[simp]:
  "cap_refs_in_kernel_window s0_internal"
  apply (clarsimp simp: cap_refs_in_kernel_window_def valid_refs_def cap_range_def
                        Invariants_AI.cte_wp_at_caps_of_state)
  apply (drule s0_caps_of_state)
  apply (erule disjE | simp add: arch_state0_def s0_internal_def s0_ptr_defs mask_def)+
  done

lemma cur_tcb_s0[simp]:
  "cur_tcb s0_internal"
  by (simp add: cur_tcb_def s0_ptr_defs s0_internal_def kh0_def kh0_obj_def obj_at_def is_tcb_def)

lemma valid_list_s0[simp]:
  "valid_list s0_internal"
  apply (simp add: valid_list_2_def s0_internal_def exst0_def const_def)
  done

lemma valid_sched_s0[simp]:
  "valid_sched s0_internal"
  apply (simp add: valid_sched_def s0_internal_def exst0_def)
  apply (intro conjI)
        apply (clarsimp simp: valid_etcbs_def s0_ptr_defs kh0_def kh0_obj_def is_etcb_at'_def
                              st_tcb_at_kh_def obj_at_kh_def obj_at_def)
       apply (clarsimp simp: const_def)
      apply (clarsimp simp: const_def)
     apply (clarsimp simp: valid_sched_action_def is_activatable_def st_tcb_at_kh_def
                           obj_at_kh_def obj_at_def kh0_def kh0_obj_def s0_ptr_defs)
    apply (clarsimp simp: ct_in_cur_domain_def in_cur_domain_def etcb_at'_def ekh0_obj_def
                          s0_ptr_defs)
   apply (clarsimp simp: const_def valid_blocked_def st_tcb_at_kh_def obj_at_kh_def obj_at_def
                         kh0_def kh0_obj_def split: if_split_asm)
  apply (clarsimp simp: valid_idle_etcb_def etcb_at'_def ekh0_obj_def s0_ptr_defs idle_thread_ptr_def)
  done

lemma respects_device_trivial:
  "pspace_respects_device_region s0_internal"
  "cap_refs_respects_device_region s0_internal"
  apply (clarsimp simp: s0_internal_def pspace_respects_device_region_def machine_state0_def device_mem_def
                        in_device_frame_def kh0_obj_def obj_at_kh_def obj_at_def kh0_def
                 split: if_splits)[1]
   apply fastforce
  apply (clarsimp simp: cap_refs_respects_device_region_def Invariants_AI.cte_wp_at_caps_of_state
                        cap_range_respects_device_region_def machine_state0_def)
  apply (intro conjI impI)
   apply (drule s0_caps_of_state)
   apply fastforce
  apply (clarsimp simp: s0_internal_def machine_state0_def)
  done

lemma einvs_s0:
  "einvs s0_internal"
  apply (simp add: valid_state_def invs_def respects_device_trivial)
  done

lemma obj_valid_pdpt_kh0:
  "x \<in> ran kh0 \<Longrightarrow> obj_valid_pdpt x"
  by (auto simp: kh0_def valid_entries_def obj_valid_pdpt_def idle_tcb_def High_tcb_def Low_tcb_def
                 High_pt_def High_pt'_def entries_align_def Low_pt_def High_pd_def Low_pt'_def High_pd'_def
                 Low_pd_def irq_cnode_def ntfn_def Silc_cnode_def High_cnode_def Low_cnode_def Low_pd'_def)

subsubsection \<open>Haskell state\<close>

text \<open>One invariant we need on s0 is that there exists
        an associated Haskell state satisfying the invariants.
        This does not yet exist.\<close>

lemma Sys1_valid_initial_state_noenabled:
  assumes extras_s0: "step_restrict s0"
  assumes utf_det: "\<forall>pl pr pxn tc ms s. det_inv InUserMode tc s \<and> einvs s \<and> context_matches_state pl pr pxn ms s \<and> ct_running s
                   \<longrightarrow> (\<exists>x. utf (cur_thread s) pl pr pxn (tc, ms) = {x})"
  assumes utf_non_empty: "\<forall>t pl pr pxn tc ms. utf t pl pr pxn (tc, ms) \<noteq> {}"
  assumes utf_non_interrupt: "\<forall>t pl pr pxn tc ms e f g. (e,f,g) \<in> utf t pl pr pxn (tc, ms) \<longrightarrow> e \<noteq> Some Interrupt"
  assumes det_inv_invariant: "invariant_over_ADT_if det_inv utf"
  assumes det_inv_s0: "det_inv KernelExit (cur_context s0_internal) s0_internal"
  shows "valid_initial_state_noenabled det_inv utf s0_internal Sys1PAS timer_irq s0_context"
  apply (unfold_locales, simp_all only: pasMaySendIrqs_Sys1PAS)
                     apply (insert det_inv_invariant)[9]
                     apply (erule(2) invariant_over_ADT_if.det_inv_abs_state)
                    apply ((erule invariant_over_ADT_if.det_inv_abs_state
                                  invariant_over_ADT_if.check_active_irq_if_Idle_det_inv
                                  invariant_over_ADT_if.check_active_irq_if_User_det_inv
                                  invariant_over_ADT_if.do_user_op_if_det_inv
                                  invariant_over_ADT_if.handle_preemption_if_det_inv
                                  invariant_over_ADT_if.kernel_entry_if_Interrupt_det_inv
                                  invariant_over_ADT_if.kernel_entry_if_det_inv
                                  invariant_over_ADT_if.kernel_exit_if_det_inv
                                  invariant_over_ADT_if.schedule_if_det_inv)+)[8]
            apply (rule Sys1_pas_cur_domain)
           apply (rule Sys1_pas_wellformed_noninterference)
          apply (simp only: einvs_s0)
          apply (simp add: Sys1_current_subject_idemp)
          apply (simp add: only_timer_irq_inv_s0 silc_inv_s0 Sys1_pas_cur_domain
                           domain_sep_inv_s0 Sys1_pas_refined Sys1_guarded_pas_domain
                           idle_equiv_refl)
          apply (clarsimp simp: obj_valid_pdpt_kh0 valid_domain_list_2_def s0_internal_def exst0_def)
         apply (simp add: det_inv_s0)
        apply (simp add: s0_internal_def exst0_def)
       apply (simp add: ct_in_state_def st_tcb_at_tcb_states_of_state_eq
                        identity_eq[symmetric] tcb_states_of_state_s0)
       apply (simp add: s0_ptr_defs s0_internal_def)
      apply (simp add: s0_internal_def exst0_def)
     apply (rule utf_det)
    apply (rule utf_non_empty)
   apply (rule utf_non_interrupt)
  apply (simp add: extras_s0[simplified s0_def])
  done

text \<open>the extra assumptions in valid_initial_state of being enabled,
        and a serial system, follow from ADT_IF_Refine\<close>

end

end