-
Notifications
You must be signed in to change notification settings - Fork 0
/
Asid_D.thy
105 lines (90 loc) · 4.07 KB
/
Asid_D.thy
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
(*
* Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
*
* SPDX-License-Identifier: GPL-2.0-only
*)
(*
* Operations on page table objects and frames.
*)
theory Asid_D
imports
Invocations_D
CSpace_D
Untyped_D
begin
definition
decode_asid_control_invocation :: "cdl_cap \<Rightarrow> cdl_cap_ref \<Rightarrow> (cdl_cap \<times> cdl_cap_ref) list \<Rightarrow>
cdl_asid_control_intent \<Rightarrow> cdl_asid_control_invocation except_monad"
where
"decode_asid_control_invocation target target_ref caps intent \<equiv> case intent of
AsidControlMakePoolIntent index depth \<Rightarrow>
doE
base \<leftarrow> liftE $ select {x. x < 2 ^ asid_high_bits};
\<comment> \<open>Fetch the untyped item, and ensure it is valid.\<close>
(untyped_cap, untyped_cap_ref) \<leftarrow> throw_on_none $ get_index caps 0;
(case untyped_cap of
UntypedCap _ s _ \<Rightarrow> returnOk ()
| _ \<Rightarrow> throw);
ensure_no_children untyped_cap_ref;
\<comment> \<open>Fetch the slot we plan to put the generated cap into.\<close>
(cspace_cap, _) \<leftarrow> throw_on_none $ get_index caps 1;
target_slot \<leftarrow> lookup_slot_for_cnode_op cspace_cap index (unat depth);
ensure_empty target_slot;
returnOk $ MakePool (set_available_range untyped_cap {}) untyped_cap_ref
(cap_objects untyped_cap) target_slot base
odE \<sqinter> throw"
definition
decode_asid_pool_invocation :: "cdl_cap \<Rightarrow> cdl_cap_ref \<Rightarrow> (cdl_cap \<times> cdl_cap_ref) list \<Rightarrow>
cdl_asid_pool_intent \<Rightarrow> cdl_asid_pool_invocation except_monad"
where
"decode_asid_pool_invocation target target_ref caps intent \<equiv> case intent of
AsidPoolAssignIntent \<Rightarrow>
doE
(pd_cap, pd_cap_ref) \<leftarrow> throw_on_none $ get_index caps 0;
(case pd_cap of
PageDirectoryCap _ _ _ \<Rightarrow> returnOk ()
| _ \<Rightarrow> throw);
base \<leftarrow> (case target of
AsidPoolCap p base \<Rightarrow> returnOk $ base
| _ \<Rightarrow> throw);
offset \<leftarrow> liftE $ select {x. x < 2 ^ asid_low_bits};
returnOk $ Assign (base, offset) pd_cap_ref (cap_object target, offset)
odE \<sqinter> throw"
definition
invoke_asid_control :: "cdl_asid_control_invocation \<Rightarrow> unit k_monad"
where
"invoke_asid_control params \<equiv>
case params of
MakePool untyped_cap untyped_cap_ref untyped_covers target_slot base \<Rightarrow>
do
\<comment> \<open>Untype the region. A choice may be made about whether to detype
objects with Untyped addresses.\<close>
modify (detype untyped_covers);
set_cap untyped_cap_ref untyped_cap;
targets \<leftarrow> generate_object_ids 1 AsidPoolType untyped_covers;
\<comment> \<open>Retype the region.\<close>
retype_region 0 AsidPoolType targets;
assert (targets \<noteq> []);
\<comment> \<open>Insert the cap.\<close>
frame \<leftarrow> return $ pick (hd targets);
insert_cap_child (AsidPoolCap frame base) untyped_cap_ref target_slot;
\<comment> \<open>Update the asid table.\<close>
asid_table \<leftarrow> gets cdl_asid_table;
asid_table' \<leftarrow> return $ asid_table (base \<mapsto> AsidPoolCap frame 0);
modify (\<lambda>s. s \<lparr>cdl_asid_table := asid_table'\<rparr>)
od"
definition
invoke_asid_pool :: "cdl_asid_pool_invocation \<Rightarrow> unit k_monad"
where
"invoke_asid_pool params \<equiv>
case params of
Assign asid pd_cap_ref ap_target_slot \<Rightarrow> do
pd_cap \<leftarrow> get_cap pd_cap_ref;
case pd_cap of
PageDirectoryCap pd_id _ _ \<Rightarrow> do
set_cap pd_cap_ref (PageDirectoryCap pd_id Real (Some asid));
set_cap ap_target_slot (PageDirectoryCap pd_id Fake None)
od
| _ \<Rightarrow> fail
od"
end