(* * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230) * * SPDX-License-Identifier: GPL-2.0-only *) theory InitIRQ_SI imports "DSpecProofs.IRQ_DP" ObjectInitialised_SI RootTask_SI SysInit_SI begin lemma seL4_IRQHandler_SetEndpoint_irq_initialised_helper_sep: "\\irq_empty spec t irq \* si_cap_at t orig_caps spec dev ntfn_id \* si_irq_cap_at irq_caps spec irq \* si_objects \* R\ and K(well_formed spec \ cdl_objects spec ntfn_id = Some ntfn \ is_ntfn ntfn \ irq \ bound_irqs spec \ opt_cap (cdl_irq_node spec irq, 0) spec = Some ntfn_cap \ ntfn_id = cap_object ntfn_cap \ t (cdl_irq_node spec irq) = Some kernel_irq_id \ t ntfn_id = Some kernel_ntfn_id \ cdl_objects spec (cdl_irq_node spec irq) = Some spec_irq \ irq_caps irq = Some irq_handler_cptr \ orig_caps ntfn_id = Some endpoint_cptr \ irq_handler_cptr < 2 ^ si_cnode_size \ endpoint_cptr < 2 ^ si_cnode_size)\ seL4_IRQHandler_SetEndpoint irq_handler_cptr endpoint_cptr \\_. \irq_initialised spec t irq \* si_cap_at t orig_caps spec dev ntfn_id \* si_irq_cap_at irq_caps spec irq \* si_objects \* R\\" apply (rule hoare_gen_asm, clarsimp) apply (frule well_formed_bound_irqs_are_used_irqs) apply (subst irq_initialised_decomp_total, assumption+, fast) apply (subst irq_empty_decomp_total, assumption+, fast) apply (clarsimp simp: irq_slot_initialised_def irq_slot_empty_def irq_initialised_general_def si_cap_at_def si_irq_cap_at_def si_objects_def sep_conj_assoc sep_conj_exists) apply (frule (1) well_formed_irq_is_irq_node) apply (frule (1) well_formed_size_irq_node) apply (frule (2) well_formed_irq_ntfn_cap) apply (rule hoare_chain) apply (rule seL4_IRQHandler_SetEndpoint_wp [where root_tcb = root_tcb and cnode_cap = si_cspace_cap and cnode_id = si_cnode_id and root_size = si_cnode_size and irq = irq and irq_handler_slot = "unat (the (irq_caps irq))" and endpoint_slot = "unat (the (orig_caps (cap_object ntfn_cap)))" and irq_id = "the (t (cdl_irq_node spec irq))" and old_cap = NullCap and endpoint_cap = "NotificationCap (the (t (cap_object ntfn_cap))) 0 {AllowRead, AllowWrite}" and R="object_empty_slots_initialised spec t (cdl_irq_node spec irq) \* object_fields_empty spec t (cdl_irq_node spec irq) \* (si_cnode_id, unat seL4_CapInitThreadCNode) \c si_cnode_cap \* (si_cnode_id, unat seL4_CapIRQControl) \c IrqControlCap \* si_asid \* R"]) apply (intro pred_conjI) apply (clarsimp simp: object_type_is_object default_cap_def) apply (sep_drule sep_map_c_sep_map_s [where cap=NullCap]) apply (rule object_slots_object_default_state_NullCap', (simp add: object_type_has_slots)+) apply sep_solve apply simp apply (frule guard_equal_si_cspace_cap' [where src_index=irq_handler_cptr]) apply (frule guard_equal_si_cspace_cap' [where src_index=endpoint_cptr]) apply (clarsimp simp: ep_related_cap_def offset_slot') apply simp apply (clarsimp simp: object_type_is_object default_cap_def) apply (subst (asm) irq_node_fields_empty_initialised) apply (simp add: object_type_object_at) apply (simp add: object_fields_initialised_def object_initialised_general_def) apply (sep_drule sep_map_s_sep_map_c [where obj_id = kernel_irq_id and cap = "NotificationCap kernel_ntfn_id 0 {AllowRead, AllowWrite}" and obj = "spec2s t spec_irq"]) apply simp apply (frule (1) object_slots_opt_capI) apply (subst object_slots_spec2s, (fastforce simp: object_type_has_slots cap_has_object_def update_cap_object_def cap_type_def split: cdl_cap.splits)+) apply sep_solve done lemma seL4_IRQHandler_SetEndpoint_irq_initialised_sep: "\\irq_empty spec t irq \* si_caps_at t orig_caps spec dev {obj_id. real_object_at obj_id spec} \* si_irq_caps_at irq_caps spec (bound_irqs spec) \* si_objects \* R\ and K(well_formed spec \ irq \ bound_irqs spec \ irq_caps irq = Some irq_handler_cptr \ orig_caps (cap_object (the (opt_cap (cdl_irq_node spec irq, 0) spec))) = Some endpoint_cptr)\ seL4_IRQHandler_SetEndpoint irq_handler_cptr endpoint_cptr \\_. \irq_initialised spec t irq \* si_caps_at t orig_caps spec dev {obj_id. real_object_at obj_id spec} \* si_irq_caps_at irq_caps spec (bound_irqs spec) \* si_objects \* R\\" apply (rule hoare_gen_asm) apply (clarsimp simp: si_irq_caps_at_def) apply (frule well_formed_bound_irqs_are_used_irqs) apply (frule (1) well_formed_cap_object_cdl_irq_node, clarsimp) apply (frule object_at_real_object_at [where obj_id = "cap_object (the (opt_cap (cdl_irq_node spec irq, 0) spec))"], fastforce simp: object_at_def) apply (frule well_formed_slot_0_of_used_irq_node, fast, clarsimp) apply (frule slots_of_cdl_objects, clarsimp) apply (rule hoare_chain [OF sep_set_conj_map_singleton_wp [where P = "irq_empty spec t irq \* si_caps_at t orig_caps spec dev {obj_id. real_object_at obj_id spec} \* si_objects" and Q = "irq_initialised spec t irq \* si_caps_at t orig_caps spec dev {obj_id. real_object_at obj_id spec} \* si_objects" and I = "si_irq_cap_at irq_caps spec" and x = irq and xs = "bound_irqs spec"]], simp+) apply (clarsimp simp: si_irq_caps_at_def si_caps_at_def) apply (rule hoare_chain [OF sep_set_conj_map_singleton_wp [where P = "irq_empty spec t irq \* si_irq_cap_at irq_caps spec irq \* si_objects" and Q = "irq_initialised spec t irq \* si_irq_cap_at irq_caps spec irq \* si_objects" and I = "si_cap_at t orig_caps spec dev" and x = "cap_object (the (opt_cap (cdl_irq_node spec irq, 0) spec))" and xs = "{obj_id. real_object_at obj_id spec}"]], simp+) apply (wp sep_wp: seL4_IRQHandler_SetEndpoint_irq_initialised_helper_sep [where t=t and spec=spec and irq=irq and ntfn_cap = "the (opt_cap (cdl_irq_node spec irq, 0) spec)" and kernel_irq_id = "the (t (cdl_irq_node spec irq))" and kernel_ntfn_id = "the (t (cap_object (the (opt_cap (cdl_irq_node spec irq, 0) spec))))"], simp) apply (rule conjI) apply sep_solve apply (fastforce simp: opt_cap_def irq_empty_def irq_initialised_general_def si_irq_cap_at_def si_cap_at_def sep_conj_exists) apply sep_solve apply sep_solve apply sep_solve apply sep_solve done lemma init_irq_sep: "\\irq_empty spec t irq \* si_caps_at t orig_caps spec dev {obj_id. real_object_at obj_id spec} \* si_irq_caps_at irq_caps spec (bound_irqs spec) \* si_objects \* R\ and K(well_formed spec \ irq \ bound_irqs spec)\ init_irq spec orig_caps irq_caps irq \\_. \irq_initialised spec t irq \* si_caps_at t orig_caps spec dev {obj_id. real_object_at obj_id spec} \* si_irq_caps_at irq_caps spec (bound_irqs spec) \* si_objects \* R\\" apply (rule hoare_gen_asm, clarsimp) apply (clarsimp simp: init_irq_def) apply (wp hoare_drop_imp seL4_IRQHandler_SetEndpoint_irq_initialised_sep | simp)+ apply (frule (1) well_formed_cap_object_cdl_irq_node) apply (frule object_at_real_object_at [where obj_id = "cap_object (the (opt_cap (cdl_irq_node spec irq, 0) spec))"], fastforce simp: object_at_def) apply (clarsimp simp: si_caps_at_def get_irq_slot_def) apply (subst (asm) sep.prod.remove [where x="cap_object (the (opt_cap (cdl_irq_node spec irq, 0) spec))"], simp) apply clarsimp apply (clarsimp simp: si_cap_at_def sep_conj_exists) done lemma init_irqs_bound_irqs_sep: "\\irqs_empty spec t (bound_irqs spec) \* si_caps_at t orig_caps spec dev {obj_id. real_object_at obj_id spec} \* si_irq_caps_at irq_caps spec (bound_irqs spec) \* si_objects \* R\ and K(well_formed spec)\ init_irqs spec orig_caps irq_caps \\_.\irqs_initialised spec t (bound_irqs spec) \* si_caps_at t orig_caps spec dev {obj_id. real_object_at obj_id spec} \* si_irq_caps_at irq_caps spec (bound_irqs spec) \* si_objects \* R\\" apply (rule hoare_gen_asm) apply (clarsimp simp: init_irqs_def) apply (clarsimp simp: irqs_empty_def irqs_initialised_def) apply (rule mapM_x_set_sep' [where P="irq_empty spec t" and Q="irq_initialised spec t" and I="si_caps_at t orig_caps spec dev {obj_id. real_object_at obj_id spec} \* si_irq_caps_at irq_caps spec (bound_irqs spec) \* si_objects" and R=R, simplified sep_conj_assoc], fastforce+) apply (wp init_irq_sep, simp+) done lemma irq_slot_empty_initialised_NullCap: "\well_formed spec; slots_of (cdl_irq_node spec irq) spec slot = Some NullCap\ \ irq_slot_empty spec t irq slot = irq_slot_initialised spec t irq slot" apply (frule slots_of_cdl_objects, clarsimp) apply (frule (1) well_formed_irq_is_irq_node) apply (frule (1) well_formed_object_slots) apply (rule ext) apply (clarsimp simp: irq_slot_empty_def irq_slot_initialised_def irq_initialised_general_def slots_of_def split: option.splits) apply (subgoal_tac "object_slots (object_default_state obj) slot = object_slots (spec2s t obj) slot") apply (subst sep_map_s_object_slots_equal, assumption, simp) apply clarsimp apply (frule object_slots_spec2s_NullCap [where t=t], simp) apply (erule object_slots_object_default_state_NullCap [where obj_id = "cdl_irq_node spec irq" and cap = NullCap]) apply (clarsimp simp: object_at_def object_type_is_object) apply (clarsimp simp: opt_cap_def slots_of_def) apply simp done lemma irq_slot_empty_initialised: "\well_formed spec; irq \ bound_irqs spec; irq \ used_irqs spec; cdl_objects spec (cdl_irq_node spec irq) = Some irq_node\ \ irq_slot_empty spec t irq 0 = irq_slot_initialised spec t irq 0" apply (frule (1) well_formed_slots_of_used_irq_node) apply (erule irq_slot_empty_initialised_NullCap) apply (clarsimp simp: bound_irqs_def) apply blast done lemma irq_empty_initialised: "\well_formed spec; irq \ bound_irqs spec; irq \ used_irqs spec\ \ irq_empty spec t irq = irq_initialised spec t irq" apply (frule (1) well_formed_used_irqs_have_irq_node, clarsimp) apply (frule (1) well_formed_irq_is_irq_node) apply (subst irq_empty_decomp_total, assumption+) apply (subst irq_initialised_decomp_total, assumption+) apply (subst irq_node_fields_empty_initialised) apply (simp add: object_type_object_at object_at_def) apply (subst irq_slot_empty_initialised, assumption+) apply simp done (* If all the bound IRQs are done, then all the used ones are too. To show this is true we note that: - by well_formed_bound_irqs_are_used_irqs: well_formed spec \ bound_irqs spec \ used_irqs spec - empty (used and not bound) IRQs don't need any setting up - there's no problem having si_irq_caps_at to more IRQ caps. *) lemma init_irqs_sep: "\\irqs_empty spec t (used_irqs spec) \* si_caps_at t orig_caps spec dev {obj_id. real_object_at obj_id spec} \* si_irq_caps_at irq_caps spec (used_irqs spec) \* si_objects \* R\ and K(well_formed spec)\ init_irqs spec orig_caps irq_caps \\_.\irqs_initialised spec t (used_irqs spec) \* si_caps_at t orig_caps spec dev {obj_id. real_object_at obj_id spec} \* si_irq_caps_at irq_caps spec (used_irqs spec) \* si_objects \* R\\" apply (rule hoare_gen_asm) apply (clarsimp simp: si_irq_caps_at_def irqs_initialised_def irqs_empty_def) apply (frule well_formed_bound_irqs_are_used_irqs) apply (frule sep_set_conj_subset_wp [where P = "sep_map_set_conj (irq_empty spec t) (used_irqs spec) \* si_caps_at t orig_caps spec dev {obj_id. real_object_at obj_id spec} \* si_objects" and Q = "sep_map_set_conj (irq_initialised spec t) (used_irqs spec) \* si_caps_at t orig_caps spec dev {obj_id. real_object_at obj_id spec} \* si_objects" and f = "init_irqs spec orig_caps irq_caps"], simp+) apply (subst sep.prod.subset_diff, assumption, simp)+ apply (rule hoare_pre, sep_wp init_irqs_bound_irqs_sep [where t=t]) apply (simp add: si_irq_caps_at_def irqs_initialised_def irqs_empty_def sep_conj_assoc) apply(subgoal_tac "sep_map_set_conj (irq_empty spec t) (used_irqs spec - bound_irqs spec) = sep_map_set_conj (irq_initialised spec t) (used_irqs spec - bound_irqs spec)", simp) apply sep_solve apply (rule sep.prod.cong, simp) apply (subst irq_empty_initialised, simp+) apply (erule hoare_chain, sep_solve, sep_solve) done end