140 lines
3.6 KiB
Plaintext
140 lines
3.6 KiB
Plaintext
(*
|
|
* Copyright 2014, General Dynamics C4 Systems
|
|
*
|
|
* SPDX-License-Identifier: GPL-2.0-only
|
|
*)
|
|
|
|
chapter "Deleting Capabilities"
|
|
|
|
theory Delete_H
|
|
imports
|
|
CNode_H
|
|
Interrupt_H
|
|
Endpoint_H
|
|
Thread_H
|
|
begin
|
|
|
|
definition
|
|
slotsPointed :: "capability \<Rightarrow> machine_word set"
|
|
where
|
|
"slotsPointed cap \<equiv> case cap of
|
|
CNodeCap ptr a b c \<Rightarrow> {ptr}
|
|
| ThreadCap ptr \<Rightarrow> {ptr}
|
|
| Zombie ptr bits num \<Rightarrow> {ptr}
|
|
| _ \<Rightarrow> {}"
|
|
|
|
primrec
|
|
sethelper :: "bool \<Rightarrow> 'a set \<Rightarrow> 'a set"
|
|
where
|
|
"sethelper True s = {}"
|
|
| "sethelper False s = s"
|
|
|
|
function
|
|
finaliseSlot' :: "machine_word \<Rightarrow> bool \<Rightarrow> (bool * capability) kernel_p"
|
|
where
|
|
"finaliseSlot' x b s =
|
|
(\<lambda> finaliseSlot.
|
|
(\<lambda> cteDelete.
|
|
(\<lambda> reduceZombie.
|
|
#INCLUDE_HASKELL SEL4/Object/CNode.lhs BODY finaliseSlot
|
|
)
|
|
(
|
|
#INCLUDE_HASKELL SEL4/Object/CNode.lhs BODY reduceZombie
|
|
)
|
|
)
|
|
(
|
|
#INCLUDE_HASKELL SEL4/Object/CNode.lhs BODY cteDelete
|
|
)
|
|
)
|
|
finaliseSlot' x b s"
|
|
|
|
by auto
|
|
|
|
defs
|
|
finaliseSlot_def:
|
|
"finaliseSlot \<equiv> finaliseSlot'"
|
|
|
|
#INCLUDE_HASKELL_PREPARSE SEL4/Object/Structures.lhs
|
|
|
|
function
|
|
cteDeleteOne' :: "machine_word \<Rightarrow> unit kernel"
|
|
where
|
|
"cteDeleteOne' x s =
|
|
(\<lambda> cteDeleteOne.
|
|
(\<lambda> deletingIRQHandler.
|
|
(\<lambda> cancelIPC.
|
|
(\<lambda> suspend.
|
|
(\<lambda> finaliseCap.
|
|
#INCLUDE_HASKELL SEL4/Object/CNode.lhs BODY cteDeleteOne
|
|
)
|
|
(
|
|
#INCLUDE_HASKELL SEL4/Object/ObjectType.lhs Arch=Arch BODY finaliseCap
|
|
)
|
|
)
|
|
(
|
|
#INCLUDE_HASKELL SEL4/Kernel/Thread.lhs BODY suspend
|
|
)
|
|
)
|
|
(
|
|
#INCLUDE_HASKELL SEL4/Object/Endpoint.lhs BODY cancelIPC
|
|
)
|
|
)
|
|
(
|
|
#INCLUDE_HASKELL SEL4/Object/Interrupt.lhs BODY deletingIRQHandler
|
|
)
|
|
)
|
|
cteDeleteOne' x s"
|
|
|
|
by auto
|
|
|
|
defs
|
|
cteDeleteOne_def1:
|
|
"cteDeleteOne \<equiv> cteDeleteOne'"
|
|
|
|
termination cteDeleteOne'
|
|
by (rule cteDeleteOne'.termination[OF wf_empty], simp+)
|
|
|
|
lemma cteDeleteOne_def:
|
|
"cteDeleteOne =
|
|
(
|
|
#INCLUDE_HASKELL SEL4/Object/CNode.lhs BODY cteDeleteOne
|
|
)"
|
|
apply (rule ext)+
|
|
apply (subst cteDeleteOne_def1)
|
|
apply (subst cteDeleteOne'.simps)
|
|
apply (unfold finaliseCap_def suspend_def cancelIPC_def
|
|
deletingIRQHandler_def cteDeleteOne_def1)
|
|
apply (rule refl)
|
|
done
|
|
|
|
lemma card_reduce:
|
|
"(s :: ('a :: finite) set) \<inter> s' = {} \<Longrightarrow> card (UNIV - (s \<union> s')) < card (UNIV - s) = (s' \<noteq> {})"
|
|
apply (case_tac "s' \<subseteq> s")
|
|
apply (simp add: Un_absorb2)
|
|
apply (simp add: Int_absorb1)
|
|
apply (clarsimp simp: subset_iff)
|
|
apply (subst psubset_card_mono)
|
|
apply simp
|
|
apply blast
|
|
apply blast
|
|
done
|
|
|
|
lemma isCapDs:
|
|
"isUntypedCap cap \<Longrightarrow> \<exists>dev ptr size freeIndex. cap = UntypedCap dev ptr size freeIndex"
|
|
"isEndpointCap cap \<Longrightarrow> \<exists>ptr bdg cans canr cang cangr. cap = EndpointCap ptr bdg cans canr cang cangr"
|
|
"isNotificationCap cap \<Longrightarrow> \<exists>ptr bdg cans canr. cap = NotificationCap ptr bdg cans canr"
|
|
"isCNodeCap cap \<Longrightarrow> \<exists>ptr bits grd gsize. cap = CNodeCap ptr bits grd gsize"
|
|
"isThreadCap cap \<Longrightarrow> \<exists>ptr. cap = ThreadCap ptr"
|
|
"isArchObjectCap cap \<Longrightarrow> \<exists>archcap. cap = ArchObjectCap archcap"
|
|
"isZombie cap \<Longrightarrow> \<exists>ptr bits num. cap = Zombie ptr bits num"
|
|
apply (case_tac cap, simp_all add: isUntypedCap_def)
|
|
apply (case_tac cap, simp_all add: isEndpointCap_def)
|
|
apply (case_tac cap, simp_all add: isNotificationCap_def)
|
|
apply (case_tac cap, simp_all add: isCNodeCap_def)
|
|
apply (case_tac cap, simp_all add: isThreadCap_def)
|
|
apply (case_tac cap, simp_all add: isArchObjectCap_def)
|
|
apply (case_tac cap, simp_all add: isZombie_def)
|
|
done
|
|
|
|
end
|