315 lines
13 KiB
Plaintext
315 lines
13 KiB
Plaintext
(*
|
|
* Copyright 2014, General Dynamics C4 Systems
|
|
*
|
|
* SPDX-License-Identifier: GPL-2.0-only
|
|
*)
|
|
|
|
chapter \<open>Abstract datatype for the abstract specification\<close>
|
|
|
|
theory ADT_AI
|
|
imports
|
|
ArchADT_AI
|
|
begin
|
|
|
|
context begin interpretation Arch .
|
|
|
|
requalify_consts
|
|
empty_context
|
|
init_A_st
|
|
ptable_lift
|
|
ptable_rights
|
|
addrFromPPtr
|
|
ptrFromPAddr
|
|
|
|
end
|
|
|
|
text \<open>
|
|
The general refinement calculus (see theory Simulation) requires
|
|
the definition of a so-called ``abstract datatype'' for each refinement layer.
|
|
This theory defines this datatype for the abstract specification.
|
|
Along the path, the theory extends the abstract specification of the kernel
|
|
with respect to user-mode transitions.
|
|
\<close>
|
|
|
|
text \<open>
|
|
We constrain idle thread behaviour, so we distinguish three main
|
|
machine control states:
|
|
\<close>
|
|
datatype mode = UserMode | KernelMode | IdleMode
|
|
|
|
text \<open>
|
|
The global state contains the current user's register context of the machine
|
|
as well as the internal kernel state, the mode and the current event (if any).
|
|
\<close>
|
|
type_synonym 'k global_state = "(user_context \<times> 'k) \<times> mode \<times> event option"
|
|
|
|
text \<open>
|
|
As observable state, we take the global abstract state.
|
|
\<close>
|
|
type_synonym 'a observable = "('a state) global_state"
|
|
|
|
text \<open>
|
|
From the kernel's perspective,
|
|
the user memory is a mapping from addresses to bytes.
|
|
A virtual-memory view will later on be built on top of that.
|
|
\<close>
|
|
type_synonym user_mem = "machine_word \<Rightarrow> word8 option"
|
|
|
|
(* This is a temperary solution to model the user device memory *)
|
|
type_synonym device_state = "machine_word \<Rightarrow> word8 option"
|
|
|
|
text \<open>
|
|
A user state consists of a register context and (physical) user memory.
|
|
\<close>
|
|
type_synonym user_state = "user_context \<times> user_mem \<times> device_state"
|
|
|
|
text \<open>Virtual-memory mapping: translates virtual to physical addresses\<close>
|
|
type_synonym vm_mapping = "machine_word \<rightharpoonup> machine_word"
|
|
|
|
text \<open>Memory rights for each virtual adress\<close>
|
|
type_synonym mem_rights = "machine_word \<Rightarrow> vm_rights"
|
|
|
|
text \<open>
|
|
A user transition is characterized by a function
|
|
that takes the following arguments:
|
|
a current thread identifier,
|
|
a virtual-memory mapping
|
|
(i.e., a partial function from virtual to physical addresses),
|
|
a memory-rights mapping
|
|
(i.e., a partial function from virtual addresses to rights).
|
|
|
|
The function is then a non-deterministic state monad on user state,
|
|
returning an optional kernel-entry event.
|
|
|
|
Note that the current-thread identifiers are identical in both specs
|
|
(i.e. @{term "Structures_A.cur_thread :: 'z state \<Rightarrow> obj_ref"}
|
|
in the abstract kernel model and
|
|
@{text "KernelStateData_H.ksCurThread \<Colon> kernel_state \<Rightarrow> machine_word"}
|
|
in the executable specification).
|
|
\<close>
|
|
type_synonym user_transition =
|
|
"obj_ref \<Rightarrow> vm_mapping \<Rightarrow> mem_rights \<Rightarrow> (user_state, event option) nondet_monad"
|
|
|
|
text \<open>Abbreviation for user context plus additional state\<close>
|
|
type_synonym 'k uc_state = "user_context \<times> 'k"
|
|
|
|
text \<open>
|
|
The following definition models machine and kernel entry/exit behaviour
|
|
abstractly.
|
|
Furthermore, it constrains the behaviour of user threads as well as
|
|
the idle thread.
|
|
|
|
The first parameter is used to check of pending interrupts, potentially
|
|
modifying the machine state embedded in the kernel state.
|
|
The second parameter lifts a user-thread transition into
|
|
the kernel state (i.e. the new user memory should be injected into the
|
|
kernel state) and the third parameter provides a kernel specification (it
|
|
will later be used with the abstract specification, the executable
|
|
specification, as well as the C implementation).
|
|
|
|
Despite the fact that the global automaton does not distinguish different
|
|
kinds of transitions to the outside world, the definition groups them into
|
|
6 kinds:
|
|
1. Kernel transition: The kernel specification is started in kernel mode and
|
|
uses the event part of the state as input.
|
|
The next control state will either be user mode or idle mode
|
|
(idle thread running).
|
|
2. Normal user-mode executions.
|
|
The computed new user states are then lifted into the kernel state
|
|
using the first parameter to the definition below.
|
|
3. and 4. Event generation in user mode.
|
|
In user mode, events may be generated by the user and
|
|
any interrupt can be generated at any time.
|
|
5. and 6. Finally, events generated by the idle thread.
|
|
These can only be interrupts. If there is no interrupt, we stay in idle mode.
|
|
\<close>
|
|
definition
|
|
global_automaton ::
|
|
"('k uc_state \<times> (bool \<times> 'k uc_state)) set
|
|
\<Rightarrow> ('k uc_state \<times> (event option \<times> 'k uc_state)) set
|
|
\<Rightarrow> (event \<Rightarrow> ('k uc_state \<times> mode \<times> 'k uc_state) set)
|
|
\<Rightarrow> ('k global_state \<times> 'k global_state) set"
|
|
where
|
|
"global_automaton get_active_irq do_user_op kernel_call \<equiv>
|
|
\<comment> \<open> Kernel transition \<close>
|
|
{ ( (s, KernelMode, Some e),
|
|
(s', m, None) ) |s s' e m. (s, m, s') \<in> kernel_call e } \<union>
|
|
\<comment> \<open> User to user transition, no kernel entry \<close>
|
|
{ ( (s, UserMode, None),
|
|
(s', UserMode, None) ) |s s'. (s, None, s') \<in> do_user_op} \<union>
|
|
\<comment> \<open> User to kernel transition, potentially includes Interrupt from user mode \<close>
|
|
{ ( (s, UserMode, None),
|
|
(s', KernelMode, Some e) ) |s s' e. (s, Some e, s') \<in> do_user_op} \<union>
|
|
\<comment> \<open> User to kernel transition, Interrupt from user mode \<close>
|
|
{ ( (s, UserMode, None),
|
|
(s', KernelMode, Some Interrupt) ) |s s'. (s, True, s') \<in> get_active_irq} \<union>
|
|
\<comment> \<open> Idling in idle mode \<close>
|
|
{ ( (s, IdleMode, None),
|
|
(s', IdleMode, None) ) |s s'. (s, False, s') \<in> get_active_irq} \<union>
|
|
\<comment> \<open> Interrupt while in idle mode \<close>
|
|
{ ( (s, IdleMode, None),
|
|
(s', KernelMode, Some Interrupt) ) |s s'. (s, True, s') \<in> get_active_irq}"
|
|
|
|
text \<open>
|
|
After kernel initialisation, the machine is in UserMode, running the initial thread.
|
|
\<close>
|
|
definition
|
|
Init_A :: "'a::state_ext state global_state set"
|
|
where
|
|
"Init_A \<equiv> {((empty_context, init_A_st), UserMode, None)}"
|
|
|
|
definition
|
|
"user_memory_update um \<equiv> modify (\<lambda>ms.
|
|
ms\<lparr>underlying_memory := (\<lambda>a. case um a of Some x \<Rightarrow> x
|
|
| None \<Rightarrow> underlying_memory ms a)\<rparr>)"
|
|
definition
|
|
"device_memory_update um \<equiv> modify (\<lambda>ms.
|
|
ms\<lparr>device_state := (device_state ms ++ um ) \<rparr>)"
|
|
|
|
definition
|
|
"option_to_0 x \<equiv> case x of None \<Rightarrow> 0 | Some y \<Rightarrow> y"
|
|
|
|
text \<open>
|
|
The below definition gives the kernel monad computation that checks for
|
|
active interrupts, given the present user_context. This is necessarily
|
|
a computation in the kernel monad because checking interrupts will update
|
|
the interrupt state.
|
|
\<close>
|
|
definition
|
|
check_active_irq :: "(bool,'z :: state_ext) s_monad"
|
|
where
|
|
"check_active_irq \<equiv> do
|
|
irq \<leftarrow> do_machine_op $ getActiveIRQ False;
|
|
return (irq \<noteq> None)
|
|
od"
|
|
|
|
definition
|
|
check_active_irq_A :: "(('z :: state_ext) state uc_state \<times> bool \<times> ('z :: state_ext) state uc_state) set"
|
|
where
|
|
"check_active_irq_A \<equiv> {((tc, s), (irq, (tc, s'))). (irq , s') \<in> fst (check_active_irq s)}"
|
|
|
|
text \<open>
|
|
The definition below lifts a user transition into the kernel monad.
|
|
Note that the user memory (as seen by the kernel) is
|
|
converted to true physical addresses and
|
|
restricted to those addresses, the current thread is permitted to access.
|
|
Furthermore, user memory is updated if and only if
|
|
the current thread has write permission.
|
|
|
|
NOTE: An unpermitted write access would generate a page fault on the machine.
|
|
The global transitions, however, model page faults non-deterministically.
|
|
\<close>
|
|
|
|
definition
|
|
do_user_op :: "user_transition \<Rightarrow> user_context \<Rightarrow> (event option \<times> user_context,'z::state_ext) s_monad"
|
|
where
|
|
"do_user_op uop tc \<equiv>
|
|
do t \<leftarrow> gets cur_thread;
|
|
conv \<leftarrow> gets (ptable_lift t);
|
|
rights \<leftarrow> gets (ptable_rights t);
|
|
um \<leftarrow> gets (\<lambda>s. (user_mem s) \<circ> ptrFromPAddr);
|
|
dm \<leftarrow> gets (\<lambda>s. (device_mem s) \<circ> ptrFromPAddr);
|
|
ds \<leftarrow> gets (device_state \<circ> machine_state);
|
|
(e,tc',um',ds') \<leftarrow> select (fst
|
|
(uop t (restrict_map conv {pa. rights pa \<noteq> {}}) rights
|
|
(tc, restrict_map um {pa. \<exists>va. conv va = Some pa \<and> AllowRead \<in> rights va}
|
|
,(ds \<circ> ptrFromPAddr) |` {pa. \<exists>va. conv va = Some pa \<and> AllowRead \<in> rights va} )
|
|
));
|
|
do_machine_op (user_memory_update
|
|
((um' |` {pa. \<exists>va. conv va = Some pa \<and> AllowWrite \<in> rights va} \<circ> addrFromPPtr) |` (- dom ds)));
|
|
do_machine_op (device_memory_update
|
|
((ds' |` {pa. \<exists>va. conv va = Some pa \<and> AllowWrite \<in> rights va} \<circ> addrFromPPtr) |` (dom ds)));
|
|
return (e, tc')
|
|
od"
|
|
|
|
|
|
definition
|
|
monad_to_transition ::
|
|
"(user_context \<Rightarrow> ('s, event option \<times> user_context) nondet_monad) \<Rightarrow>
|
|
('s uc_state \<times> event option \<times> 's uc_state) set"
|
|
where
|
|
"monad_to_transition m \<equiv> {((tc,s),(e,tc',s')). ((e,tc'),s') \<in> fst (m tc s)}"
|
|
|
|
definition
|
|
do_user_op_A :: "user_transition \<Rightarrow>
|
|
('z state uc_state \<times> event option \<times> ('z::state_ext state) uc_state) set"
|
|
where
|
|
"do_user_op_A uop \<equiv> monad_to_transition (do_user_op uop)"
|
|
|
|
|
|
text \<open>
|
|
Kernel calls are described completely by the abstract and concrete spec.
|
|
We model kernel entry by allowing an arbitrary user (register) context.
|
|
The mode after a kernel call is either user or idle
|
|
(see also thm in Refine.thy).
|
|
\<close>
|
|
|
|
(* FIXME: The IPC buffer pointer and TLS_BASE are stored in registers
|
|
in restore_user_context, which is currently invisible to verification.
|
|
The effect should be modelled in the ADT. *)
|
|
definition
|
|
kernel_entry :: "event \<Rightarrow> user_context \<Rightarrow> (user_context,'z::state_ext_sched) s_monad"
|
|
where
|
|
"kernel_entry e tc \<equiv> do
|
|
t \<leftarrow> gets cur_thread;
|
|
thread_set (\<lambda>tcb. tcb \<lparr> tcb_arch := arch_tcb_context_set tc (tcb_arch tcb) \<rparr>) t;
|
|
call_kernel e;
|
|
t' \<leftarrow> gets cur_thread;
|
|
thread_get (arch_tcb_context_get o tcb_arch) t'
|
|
od"
|
|
|
|
|
|
definition
|
|
kernel_call_A
|
|
:: "event \<Rightarrow> ((user_context \<times> ('a::state_ext_sched state)) \<times> mode \<times> (user_context \<times> 'a state)) set"
|
|
where
|
|
"kernel_call_A e \<equiv>
|
|
{(s, m, s'). s' \<in> fst (split (kernel_entry e) s) \<and>
|
|
m = (if ct_running (snd s') then UserMode else IdleMode)}"
|
|
|
|
text \<open>Putting together the final abstract datatype\<close>
|
|
|
|
(* NOTE: the extensible abstract specification leaves the type of the extension
|
|
unspecified; later on, we will instantiate this type with det_ext from the
|
|
deterministic abstract specification as well as with unit. The former is
|
|
used for refinement between the deterministic specification and C. The
|
|
latter is used for refinement between the non-deterministic specification
|
|
and C. *)
|
|
|
|
definition
|
|
"observable_memory ms fs \<equiv> ms \<lparr>underlying_memory := option_to_0 \<circ> fs\<rparr>"
|
|
|
|
definition
|
|
"abs_state s \<equiv> s\<lparr>machine_state:= observable_memory (machine_state s) (user_mem s)\<rparr>"
|
|
|
|
definition
|
|
ADT_A :: "user_transition \<Rightarrow> (('a::state_ext_sched state) global_state, 'a observable, unit) data_type"
|
|
where
|
|
"ADT_A uop \<equiv>
|
|
\<lparr> Init = \<lambda>s. Init_A, Fin = \<lambda>((tc,s),m,e). ((tc, abs_state s),m,e),
|
|
Step = (\<lambda>u. global_automaton check_active_irq_A (do_user_op_A uop) kernel_call_A) \<rparr>"
|
|
|
|
|
|
text \<open>
|
|
Lifting a state relation on kernel states to global states.
|
|
\<close>
|
|
definition
|
|
"lift_state_relation sr \<equiv>
|
|
{ (((tc,s),m,e), ((tc,s'),m,e))|s s' m e tc. (s,s') \<in> sr }"
|
|
|
|
lemma lift_state_relationD:
|
|
"(((tc, s), m, e), ((tc', s'), m', e')) \<in> lift_state_relation R \<Longrightarrow>
|
|
(s,s') \<in> R \<and> tc' = tc \<and> m' = m \<and> e' = e"
|
|
by (simp add: lift_state_relation_def)
|
|
|
|
lemma lift_state_relationI:
|
|
"(s,s') \<in> R \<Longrightarrow> (((tc, s), m, e), ((tc, s'), m, e)) \<in> lift_state_relation R"
|
|
by (fastforce simp: lift_state_relation_def)
|
|
|
|
lemma in_lift_state_relation_eq:
|
|
"(((tc, s), m, e), (tc', s'), m', e') \<in> lift_state_relation R \<longleftrightarrow>
|
|
(s, s') \<in> R \<and> tc' = tc \<and> m' = m \<and> e' = e"
|
|
by (auto simp add: lift_state_relation_def)
|
|
|
|
end
|