148 lines
5.2 KiB
Plaintext
148 lines
5.2 KiB
Plaintext
(*
|
|
* Copyright 2014, General Dynamics C4 Systems
|
|
*
|
|
* SPDX-License-Identifier: GPL-2.0-only
|
|
*)
|
|
|
|
theory BCorres_AI
|
|
imports
|
|
Include_AI
|
|
"Lib.BCorres_UL"
|
|
begin
|
|
|
|
abbreviation "bcorres \<equiv> bcorres_underlying truncate_state"
|
|
|
|
abbreviation "s_bcorres \<equiv> s_bcorres_underlying truncate_state"
|
|
|
|
lemma dxo_bcorres[wp]:
|
|
"bcorres (do_extended_op f) (do_extended_op f)"
|
|
apply (simp add: do_extended_op_def)
|
|
apply (simp add: bind_def select_f_def modify_def return_def get_def put_def gets_def)
|
|
apply (simp add: split_def)
|
|
apply (simp add: bcorres_underlying_def s_bcorres_underlying_def)
|
|
apply (clarsimp simp: mk_ef_def wrap_ext_op_unit_def return_def)
|
|
done
|
|
|
|
lemma OR_choice_bcorres[wp]:
|
|
"bcorres f f' \<Longrightarrow> bcorres g g' \<Longrightarrow> bcorres (OR_choice b f g) (OR_choice b f' g')"
|
|
apply (simp add: OR_choice_def wrap_ext_bool_unit_def)
|
|
apply (rule get_bcorres)
|
|
apply (simp add: bind_def select_f_def mk_ef_def modify_def return_def get_def put_def gets_def
|
|
select_def)
|
|
apply (simp add: bcorres_underlying_def s_bcorres_underlying_def)
|
|
apply (clarsimp simp: if_split_asm)
|
|
apply (rule_tac x=ab in exI)
|
|
apply force
|
|
done
|
|
|
|
lemma OR_choiceE_bcorres[wp]:
|
|
"bcorres f f' \<Longrightarrow> bcorres g g' \<Longrightarrow> bcorres (OR_choiceE b f g) (OR_choiceE b f' g')"
|
|
apply (simp add: OR_choiceE_def wrap_ext_bool_unit_def)
|
|
apply wp
|
|
apply (simp add: bind_def select_f_def mk_ef_def modify_def return_def get_def put_def gets_def
|
|
select_def)
|
|
apply (simp add: bcorres_underlying_def s_bcorres_underlying_def)
|
|
apply (clarsimp simp: if_split_asm)
|
|
apply (rule_tac x=ab in exI)
|
|
apply force
|
|
done
|
|
|
|
crunch_ignore (bcorres)
|
|
(add: NonDetMonad.bind gets modify get put do_extended_op empty_slot_ext mapM_x "when"
|
|
select unless mapM catch bindE liftE whenE alternative cap_swap_ext
|
|
cap_insert_ext cap_move_ext liftM create_cap_ext
|
|
possible_switch_to reschedule_required set_priority
|
|
set_thread_state_ext tcb_sched_action timer_tick
|
|
lookup_error_on_failure getActiveIRQ
|
|
gets_the liftME zipWithM_x unlessE mapME_x handleE forM_x)
|
|
|
|
lemma bcorres_select_ext[wp]:
|
|
"bcorres (select_ext a A) (select_ext a A)"
|
|
by (clarsimp simp: select_ext_def bind_def gets_def return_def select_def assert_def get_def
|
|
select_switch_unit_def bcorres_underlying_def s_bcorres_underlying_def fail_def)
|
|
|
|
context Arch begin
|
|
|
|
crunch (bcorres)bcorres[wp]: arch_post_cap_deletion truncate_state
|
|
|
|
end
|
|
|
|
requalify_facts
|
|
Arch.arch_post_cap_deletion_bcorres
|
|
|
|
crunch (bcorres) bcorres[wp]:
|
|
set_original, set_object, set_cap, set_irq_state, deleted_irq_handler, get_cap,set_cdt, empty_slot
|
|
truncate_state
|
|
(ignore: maskInterrupt)
|
|
|
|
lemma get_cap_det:
|
|
"(r,s') \<in> fst (get_cap p s) \<Longrightarrow> get_cap p s = ({(r,s)}, False)"
|
|
apply (cases p)
|
|
apply (clarsimp simp add: in_monad get_cap_def get_object_def
|
|
split: kernel_object.split_asm)
|
|
apply (clarsimp simp add: bind_def return_def assert_opt_def simpler_gets_def)
|
|
apply (simp add: bind_def simpler_gets_def return_def assert_opt_def)
|
|
done
|
|
|
|
lemma get_object_bcorres_any[wp]:
|
|
"bcorres_underlying (trans_state e) (get_object a) (get_object a)"
|
|
by (wpsimp simp: get_object_def)
|
|
|
|
lemma get_cap_bcorres_any:
|
|
"bcorres_underlying (trans_state e) (get_cap x) (get_cap x)"
|
|
by (wpsimp simp: get_cap_def)
|
|
|
|
lemma get_cap_helper:
|
|
"(fst (get_cap cref (trans_state e x)) =
|
|
{(cap', trans_state e x)}) = (fst (get_cap cref x) = {(cap', x)})"
|
|
apply (rule iffI)
|
|
apply (cut_tac x=cref and e="\<lambda>_. exst x" in get_cap_bcorres_any)
|
|
apply (simp add: bcorres_underlying_def)
|
|
apply (drule_tac x="trans_state e x" in spec)
|
|
apply (simp add: s_bcorres_underlying_def)
|
|
apply (drule get_cap_det)
|
|
apply (simp add: trans_state_update')
|
|
apply (cut_tac x=cref and e="e" in get_cap_bcorres_any)
|
|
apply (simp add: bcorres_underlying_def)
|
|
apply (drule_tac x="x" in spec)
|
|
apply (simp add: s_bcorres_underlying_def)
|
|
apply (drule get_cap_det)
|
|
apply simp
|
|
done
|
|
|
|
lemma is_final_cap_bcorres[wp]:
|
|
"bcorres (is_final_cap a) (is_final_cap a)"
|
|
by (simp add: is_final_cap_def is_final_cap'_def gets_def get_cap_helper | wp)+
|
|
|
|
lemma get_tcb_truncate[simp]: "get_tcb a (truncate_state s) = get_tcb a s"
|
|
by (simp add: get_tcb_def)
|
|
|
|
crunch (bcorres) bcorres[wp]:
|
|
cancel_all_ipc, cancel_all_signals, unbind_maybe_notification, unbind_notification, bind_notification
|
|
truncate_state
|
|
(simp: gets_the_def ignore: gets_the)
|
|
|
|
lemma fast_finalise_bcorres[wp]:
|
|
"bcorres (fast_finalise a b) (fast_finalise a b)"
|
|
by (cases a; wpsimp)
|
|
|
|
crunch (bcorres) bcorres[wp]: get_irq_slot truncate_state (simp: gets_def)
|
|
|
|
lemma throw_on_false_bcorres[wp]:
|
|
"bcorres f f' \<Longrightarrow> bcorres (throw_on_false e f) (throw_on_false e f')"
|
|
by (simp add: throw_on_false_def | wp)+
|
|
|
|
crunch_ignore (bcorres) (add: getActiveIRQ)
|
|
|
|
lemma preemption_point_bcorres[wp]:
|
|
"bcorres preemption_point preemption_point"
|
|
unfolding preemption_point_def by wpsimp
|
|
|
|
crunch (bcorres) bcorres[wp]: cap_swap_for_delete truncate_state
|
|
|
|
lemma gets_the_get_tcb_bcorres[wp]:
|
|
"bcorres (gets_the (get_tcb a)) (gets_the (get_tcb a)) "
|
|
by (wpsimp simp: gets_the_def bcorres_underlying_def assert_opt_def split: option.splits|rule conjI)+
|
|
|
|
end
|