212 lines
6.7 KiB
Plaintext
212 lines
6.7 KiB
Plaintext
(*
|
|
* Copyright 2014, General Dynamics C4 Systems
|
|
*
|
|
* This software may be distributed and modified according to the terms of
|
|
* the GNU General Public License version 2. Note that NO WARRANTY is provided.
|
|
* See "LICENSE_GPLv2.txt" for details.
|
|
*
|
|
* @TAG(GD_GPL)
|
|
*)
|
|
|
|
theory InvariantsPre_AI
|
|
imports LevityCatch_AI
|
|
begin
|
|
|
|
context begin interpretation Arch .
|
|
|
|
requalify_types
|
|
aa_type
|
|
|
|
requalify_consts
|
|
aa_type
|
|
|
|
end
|
|
|
|
(* FIXME: move *)
|
|
declare ranI [intro]
|
|
|
|
section "Locale Setup"
|
|
|
|
locale pspace_update_eq' =
|
|
fixes f :: "'z::state_ext state \<Rightarrow> 'c::state_ext state"
|
|
assumes pspace: "kheap (f s) = kheap s"
|
|
|
|
locale Arch_pspace_update_eq = pspace_update_eq'
|
|
sublocale Arch_pspace_update_eq \<subseteq> Arch .
|
|
|
|
locale pspace_update_eq = pspace_update_eq'
|
|
|
|
|
|
locale arch_update_eq' =
|
|
fixes f :: "'z::state_ext state \<Rightarrow> 'c::state_ext state"
|
|
assumes arch: "arch_state (f s) = arch_state s"
|
|
|
|
locale Arch_arch_update_eq = arch_update_eq'
|
|
sublocale Arch_arch_update_eq \<subseteq> Arch .
|
|
|
|
locale arch_update_eq = arch_update_eq'
|
|
|
|
locale arch_idle_update_eq_more =
|
|
fixes f :: "'z::state_ext state \<Rightarrow> 'c::state_ext state"
|
|
assumes idle: "idle_thread (f s) = idle_thread s"
|
|
assumes irq: "interrupt_irq_node (f s) = interrupt_irq_node s"
|
|
|
|
locale Arch_arch_idle_update_eq = Arch_arch_update_eq + arch_idle_update_eq_more
|
|
sublocale Arch_arch_idle_update_eq \<subseteq> Arch .
|
|
|
|
locale arch_idle_update_eq = arch_update_eq + arch_idle_update_eq_more
|
|
|
|
|
|
locale Arch_p_arch_update_eq = Arch_pspace_update_eq + Arch_arch_update_eq
|
|
sublocale Arch_p_arch_update_eq \<subseteq> Arch .
|
|
|
|
locale p_arch_update_eq = pspace_update_eq + arch_update_eq
|
|
|
|
locale Arch_p_arch_idle_update_eq = Arch_p_arch_update_eq + Arch_arch_idle_update_eq
|
|
locale p_arch_idle_update_eq = p_arch_update_eq + arch_idle_update_eq
|
|
|
|
locale Arch_p_arch_idle_update_int_eq = Arch_p_arch_idle_update_eq + Arch_pspace_update_eq
|
|
|
|
section "Base definitions for Invariants"
|
|
|
|
definition
|
|
obj_at :: "(kernel_object \<Rightarrow> bool) \<Rightarrow> obj_ref \<Rightarrow> 'z::state_ext state \<Rightarrow> bool"
|
|
where
|
|
"obj_at P ref s \<equiv> \<exists>ko. kheap s ref = Some ko \<and> P ko"
|
|
|
|
lemma obj_at_pspaceI:
|
|
"\<lbrakk> obj_at P ref s; kheap s = kheap s' \<rbrakk> \<Longrightarrow> obj_at P ref s'"
|
|
by (simp add: obj_at_def)
|
|
|
|
abbreviation
|
|
"ko_at k \<equiv> obj_at (op = k)"
|
|
|
|
lemma obj_atE:
|
|
"\<lbrakk> obj_at P p s; \<And>ko. \<lbrakk> kheap s p = Some ko; P ko \<rbrakk> \<Longrightarrow> R \<rbrakk> \<Longrightarrow> R"
|
|
by (auto simp: obj_at_def)
|
|
|
|
lemma obj_at_weakenE:
|
|
"\<lbrakk> obj_at P r s; \<And>ko. P ko \<Longrightarrow> P' ko \<rbrakk> \<Longrightarrow> obj_at P' r s"
|
|
by (clarsimp simp: obj_at_def)
|
|
|
|
lemma ko_at_weakenE:
|
|
"\<lbrakk> ko_at k ptr s; P k \<rbrakk> \<Longrightarrow> obj_at P ptr s"
|
|
by (erule obj_at_weakenE, simp)
|
|
|
|
text {* An alternative formulation that allows abstraction over type: *}
|
|
|
|
|
|
datatype a_type =
|
|
ATCB
|
|
| AEndpoint
|
|
| ANTFN
|
|
| ACapTable nat
|
|
| AGarbage
|
|
| AArch aa_type
|
|
|
|
definition
|
|
a_type :: "kernel_object \<Rightarrow> a_type"
|
|
where
|
|
"a_type ob \<equiv> case ob of
|
|
CNode sz cspace \<Rightarrow> if well_formed_cnode_n sz cspace
|
|
then ACapTable sz else AGarbage
|
|
| TCB tcb \<Rightarrow> ATCB
|
|
| Endpoint endpoint \<Rightarrow> AEndpoint
|
|
| Notification notification \<Rightarrow> ANTFN
|
|
| ArchObj ao \<Rightarrow> AArch (aa_type ao)"
|
|
|
|
lemmas a_type_simps =
|
|
a_type_def[split_simps kernel_object.split]
|
|
|
|
lemma a_type_aa_type: "(a_type (ArchObj ako) = AArch T) = (aa_type ako = T)"
|
|
by (simp add: a_type_def)
|
|
|
|
abbreviation
|
|
"typ_at T \<equiv> obj_at (\<lambda>ob. a_type ob = T)"
|
|
|
|
definition
|
|
pspace_aligned :: "'z::state_ext state \<Rightarrow> bool"
|
|
where
|
|
"pspace_aligned s \<equiv>
|
|
\<forall>x \<in> dom (kheap s). is_aligned x (obj_bits (the (kheap s x)))"
|
|
|
|
lemma pspace_alignedD [intro?]:
|
|
"\<lbrakk> kheap s p = Some ko; pspace_aligned s \<rbrakk> \<Longrightarrow> is_aligned p (obj_bits ko)"
|
|
unfolding pspace_aligned_def by (drule bspec, blast, simp)
|
|
|
|
text "objects don't overlap"
|
|
definition
|
|
pspace_distinct :: "'z::state_ext state \<Rightarrow> bool"
|
|
where
|
|
"pspace_distinct \<equiv>
|
|
\<lambda>s. \<forall>x y ko ko'. kheap s x = Some ko \<and> kheap s y = Some ko' \<and> x \<noteq> y \<longrightarrow>
|
|
{x .. x + (2 ^ obj_bits ko - 1)} \<inter>
|
|
{y .. y + (2 ^ obj_bits ko' - 1)} = {}"
|
|
|
|
|
|
definition
|
|
caps_of_state :: "'z::state_ext state \<Rightarrow> cslot_ptr \<Rightarrow> cap option"
|
|
where
|
|
"caps_of_state s \<equiv> (\<lambda>p. if (\<exists>cap. fst (get_cap p s) = {(cap, s)})
|
|
then Some (THE cap. fst (get_cap p s) = {(cap, s)})
|
|
else None)"
|
|
|
|
definition
|
|
"arch_cap_fun_lift P F c \<equiv> case c of ArchObjectCap ac \<Rightarrow> P ac | _ \<Rightarrow> F"
|
|
|
|
lemmas arch_cap_fun_lift_simps[simp] =
|
|
arch_cap_fun_lift_def[split_simps cap.split]
|
|
|
|
definition
|
|
"arch_obj_fun_lift P F c \<equiv> case c of ArchObj ac \<Rightarrow> P ac | _ \<Rightarrow> F"
|
|
|
|
lemmas arch_obj_fun_lift_simps[simp] =
|
|
arch_obj_fun_lift_def[split_simps kernel_object.split]
|
|
|
|
lemma
|
|
arch_obj_fun_lift_in_empty[dest!]:
|
|
"x \<in> arch_obj_fun_lift f {} ko
|
|
\<Longrightarrow> \<exists>ako. ko = ArchObj ako \<and> x \<in> f ako"
|
|
by (cases ko; simp add: arch_obj_fun_lift_def)
|
|
|
|
lemma
|
|
arch_obj_fun_lift_Some[dest!]:
|
|
"arch_obj_fun_lift f None ko = Some x
|
|
\<Longrightarrow> \<exists>ako. ko = ArchObj ako \<and> f ako = Some x"
|
|
by (cases ko; simp add: arch_obj_fun_lift_def)
|
|
|
|
lemma
|
|
arch_obj_fun_lift_True[dest!]:
|
|
"arch_obj_fun_lift f False ko
|
|
\<Longrightarrow> \<exists>ako. ko = ArchObj ako \<and> f ako"
|
|
by (cases ko; simp add: arch_obj_fun_lift_def)
|
|
|
|
lemma
|
|
arch_cap_fun_lift_in_empty[dest!]:
|
|
"x \<in> arch_cap_fun_lift f {} cap
|
|
\<Longrightarrow> \<exists>acap. cap = ArchObjectCap acap \<and> x \<in> f acap"
|
|
by (cases cap; simp add: arch_cap_fun_lift_def)
|
|
|
|
lemma
|
|
arch_cap_fun_lift_Some[dest!]:
|
|
"arch_cap_fun_lift f None cap = Some x
|
|
\<Longrightarrow> \<exists>acap. cap = ArchObjectCap acap \<and> f acap = Some x"
|
|
by (cases cap; simp add: arch_cap_fun_lift_def)
|
|
|
|
lemma
|
|
arch_cap_fun_lift_True[dest!]:
|
|
"arch_cap_fun_lift f False cap
|
|
\<Longrightarrow> \<exists>acap. cap = ArchObjectCap acap \<and> f acap"
|
|
by (cases cap; simp add: arch_cap_fun_lift_def)
|
|
|
|
lemma
|
|
arch_obj_fun_lift_non_arch[simp]:
|
|
"\<forall>ako. ko \<noteq> ArchObj ako \<Longrightarrow> arch_obj_fun_lift f F ko = F"
|
|
by (cases ko; fastforce)
|
|
|
|
lemma
|
|
arch_cap_fun_lift_non_arch[simp]:
|
|
"\<forall>ako. cap \<noteq> ArchObjectCap ako \<Longrightarrow> arch_cap_fun_lift f F cap = F"
|
|
by (cases cap; fastforce)
|
|
|
|
end |