2014-07-14 19:32:44 +00:00
|
|
|
(*
|
|
|
|
* 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 Bits_AI
|
2016-02-17 05:20:58 +00:00
|
|
|
imports "./$L4V_ARCH/ArchBits_AI"
|
2014-07-14 19:32:44 +00:00
|
|
|
begin
|
|
|
|
|
|
|
|
lemmas crunch_wps = hoare_drop_imps mapM_wp' mapM_x_wp'
|
|
|
|
|
|
|
|
lemmas crunch_simps = split_def whenE_def unlessE_def Let_def if_fun_split
|
|
|
|
assertE_def zipWithM_mapM zipWithM_x_mapM
|
|
|
|
|
2019-04-04 04:05:09 +00:00
|
|
|
lemma in_set_object:
|
|
|
|
"(rv, s') \<in> fst (set_object ptr obj s) \<Longrightarrow> s' = s \<lparr> kheap := kheap s (ptr \<mapsto> obj) \<rparr>"
|
|
|
|
by (clarsimp simp: set_object_def get_object_def in_monad)
|
2014-07-14 19:32:44 +00:00
|
|
|
|
|
|
|
definition
|
|
|
|
intr :: "ExceptionTypes_A.interrupt \<Rightarrow> irq \<Rightarrow> bool" where
|
|
|
|
"intr x y \<equiv> (x = Interrupted y)"
|
|
|
|
|
|
|
|
lemma intr_simp[simp]:
|
|
|
|
"intr (Interrupted x) y = (x = y)"
|
|
|
|
by (simp add: intr_def)
|
|
|
|
|
|
|
|
lemma cap_fault_injection:
|
|
|
|
"cap_fault_on_failure addr b = injection_handler (ExceptionTypes_A.CapFault addr b)"
|
|
|
|
apply (rule ext)
|
|
|
|
apply (simp add: cap_fault_on_failure_def injection_handler_def o_def)
|
|
|
|
done
|
|
|
|
|
|
|
|
lemma lookup_error_injection:
|
|
|
|
"lookup_error_on_failure b = injection_handler (ExceptionTypes_A.FailedLookup b)"
|
|
|
|
apply (rule ext)
|
|
|
|
apply (simp add: lookup_error_on_failure_def injection_handler_def o_def)
|
|
|
|
done
|
|
|
|
|
|
|
|
|
2017-08-28 06:25:35 +00:00
|
|
|
ML \<open>Thm.consolidate @{thms lookup_error_injection}\<close>
|
2016-03-04 00:00:54 +00:00
|
|
|
|
2014-07-14 19:32:44 +00:00
|
|
|
lemmas cap_fault_wp[wp] = injection_wp[OF cap_fault_injection]
|
|
|
|
|
|
|
|
lemmas cap_fault_wp_E[wp] = injection_wp_E[OF cap_fault_injection]
|
|
|
|
|
|
|
|
lemmas cap_fault_bindE = injection_bindE[OF cap_fault_injection cap_fault_injection]
|
|
|
|
|
|
|
|
lemmas cap_fault_liftE[simp] = injection_liftE[OF cap_fault_injection]
|
|
|
|
|
|
|
|
lemmas lookup_error_wp[wp] = injection_wp[OF lookup_error_injection]
|
|
|
|
|
|
|
|
lemmas lookup_error_wp_E[wp] = injection_wp_E[OF lookup_error_injection]
|
|
|
|
|
|
|
|
lemmas lookup_error_bindE = injection_bindE[OF lookup_error_injection lookup_error_injection]
|
|
|
|
|
|
|
|
lemmas lookup_error_liftE[simp] = injection_liftE[OF lookup_error_injection]
|
|
|
|
|
|
|
|
lemma unify_failure_injection:
|
|
|
|
"unify_failure = injection_handler (\<lambda>x. ())"
|
|
|
|
by (intro ext, simp add: unify_failure_def injection_handler_def)
|
|
|
|
|
|
|
|
|
|
|
|
lemmas unify_failure_wp[wp] = injection_wp [OF unify_failure_injection]
|
|
|
|
|
|
|
|
lemmas unify_failure_wp_E[wp] = injection_wp_E [OF unify_failure_injection]
|
|
|
|
|
|
|
|
lemma ep_cases_weak_wp:
|
2017-07-12 05:13:51 +00:00
|
|
|
assumes "\<lbrace>P_A\<rbrace> a \<lbrace>Q\<rbrace>"
|
2014-07-14 19:32:44 +00:00
|
|
|
assumes "\<And>q. \<lbrace>P_B\<rbrace> b q \<lbrace>Q\<rbrace>"
|
|
|
|
assumes "\<And>q. \<lbrace>P_C\<rbrace> c q \<lbrace>Q\<rbrace>"
|
2017-07-12 05:13:51 +00:00
|
|
|
shows
|
|
|
|
"\<lbrace>P_A and P_B and P_C\<rbrace>
|
|
|
|
case ts of
|
2014-07-14 19:32:44 +00:00
|
|
|
Structures_A.IdleEP \<Rightarrow> a
|
|
|
|
| Structures_A.SendEP q \<Rightarrow> b q
|
|
|
|
| Structures_A.RecvEP q \<Rightarrow> c q \<lbrace>Q\<rbrace>"
|
|
|
|
apply (cases ts)
|
|
|
|
apply (simp, rule hoare_weaken_pre, rule assms, simp)+
|
|
|
|
done
|
|
|
|
|
2015-11-02 00:00:32 +00:00
|
|
|
lemma ntfn_cases_weak_wp:
|
2017-07-12 05:13:51 +00:00
|
|
|
assumes "\<lbrace>P_A\<rbrace> a \<lbrace>Q\<rbrace>"
|
2014-07-14 19:32:44 +00:00
|
|
|
assumes "\<And>q. \<lbrace>P_B\<rbrace> b q \<lbrace>Q\<rbrace>"
|
|
|
|
assumes "\<And>bdg msg. \<lbrace>P_C\<rbrace> c bdg msg \<lbrace>Q\<rbrace>"
|
2017-07-12 05:13:51 +00:00
|
|
|
shows
|
|
|
|
"\<lbrace>P_A and P_B and P_C\<rbrace>
|
|
|
|
case ts of
|
2015-11-02 00:00:32 +00:00
|
|
|
Structures_A.IdleNtfn \<Rightarrow> a
|
|
|
|
| Structures_A.WaitingNtfn q \<Rightarrow> b q
|
|
|
|
| Structures_A.ActiveNtfn bdg \<Rightarrow> c bdg msg \<lbrace>Q\<rbrace>"
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (cases ts)
|
|
|
|
apply (simp, rule hoare_weaken_pre, rule assms, simp)+
|
|
|
|
done
|
|
|
|
|
|
|
|
lemma NullCap_valid [simp]: "s \<turnstile> cap.NullCap"
|
|
|
|
by (simp add: valid_cap_def)
|
|
|
|
|
|
|
|
lemma empty_on_failure_wp[wp]:
|
|
|
|
"\<lbrace>P\<rbrace> m \<lbrace>Q\<rbrace>,\<lbrace>\<lambda>rv. Q []\<rbrace>
|
|
|
|
\<Longrightarrow> \<lbrace>P\<rbrace> empty_on_failure m \<lbrace>Q\<rbrace>"
|
2017-01-13 12:58:40 +00:00
|
|
|
by (simp add: empty_on_failure_def) wp
|
2014-07-14 19:32:44 +00:00
|
|
|
|
2016-01-12 05:44:35 +00:00
|
|
|
end
|