1%
2% Copyright 2014, General Dynamics C4 Systems
3%
4% This software may be distributed and modified according to the terms of
5% the GNU General Public License version 2. Note that NO WARRANTY is provided.
6% See "LICENSE_GPLv2.txt" for details.
7%
8% @TAG(GD_GPL)
9%
10
11This module provides the invocation handling for the kernel's two interrupt-handling capability types: the interrupt controller, and the IRQ handlers. It also provides a function that dispatches received interrupts to the appropriate handlers.
12
13\begin{impdetails}
14
15We use the C preprocessor to select a target architecture.
16
17> {-# LANGUAGE CPP #-}
18
19\end{impdetails}
20
21> module SEL4.Object.Interrupt (
22>     decodeIRQControlInvocation, decodeIRQHandlerInvocation,
23>     performIRQControl, invokeIRQHandler,
24>     deletingIRQHandler, deletedIRQHandler,
25>     initInterruptController, handleInterrupt,
26>     setIRQState, isIRQActive
27>   ) where
28
29> {-# BOOT-IMPORTS: SEL4.Machine SEL4.Model SEL4.Object.Structures #-}
30> {-# BOOT-EXPORTS: setIRQState isIRQActive #-}
31
32> import Prelude hiding (Word)
33
34The architecture-specific definitions are imported qualified with the "Arch" prefix.
35
36> import qualified SEL4.Object.Interrupt.TARGET as Arch
37
38\begin{impdetails}
39
40> import SEL4.Machine
41> import SEL4.Model
42> import SEL4.API.Failures
43> import SEL4.API.Invocation
44> import SEL4.API.InvocationLabels
45> import SEL4.API.Types
46> import SEL4.Object.Structures
47> import SEL4.Object.Notification
48> import {-# SOURCE #-} SEL4.Object.CNode
49> import {-# SOURCE #-} SEL4.Kernel.CSpace
50> import {-# SOURCE #-} SEL4.Kernel.Thread
51> import {-# SOURCE #-} SEL4.Kernel.Init
52
53> import Data.Bits
54> import Data.Array
55> import Data.Helpers
56
57\end{impdetails}
58
59\subsection{Interrupt Capability Invocations}
60
61\subsubsection{Interrupt Controller Capabilities}
62
63There is a single, global interrupt controller object; a capability to it is provided to the initial thread at boot time. Interrupt controller capabilities may be used to generate handler capabilities for specific interrupts (see \autoref{sec:object.interrupt.invoke.handler}), or to change architecture-specific interrupt controller parameters.
64
65> decodeIRQControlInvocation :: Word -> [Word] -> PPtr CTE -> [Capability] ->
66>         KernelF SyscallError IRQControlInvocation
67> decodeIRQControlInvocation label args srcSlot extraCaps =
68>     case (invocationType label, args, extraCaps) of
69>         (IRQIssueIRQHandler, irqW:index:depth:_, cnode:_) -> do
70>             Arch.checkIRQ irqW
71>             let irq = toEnum (fromIntegral irqW) :: IRQ
72>             irqActive <- withoutFailure $ isIRQActive irq
73>             when irqActive $ throw RevokeFirst
74>
75>             destSlot <- lookupTargetSlot cnode
76>                 (CPtr index) (fromIntegral depth)
77>             ensureEmptySlot destSlot
78>
79>             return $ IssueIRQHandler irq destSlot srcSlot
80>         (IRQIssueIRQHandler,_,_) -> throw TruncatedMessage
81>         _ -> liftM ArchIRQControl $ Arch.decodeIRQControlInvocation label args srcSlot extraCaps
82
83> performIRQControl :: IRQControlInvocation -> KernelP ()
84> performIRQControl (IssueIRQHandler irq handlerSlot controlSlot) =
85>   withoutPreemption $ do
86>     setIRQState (IRQSignal) irq
87>     cteInsert (IRQHandlerCap irq) controlSlot handlerSlot
88> performIRQControl (ArchIRQControl invok) =
89>     Arch.performIRQControl invok
90
91\subsubsection{IRQ Handler Capabilities}
92\label{sec:object.interrupt.invoke.handler}
93
94An IRQ handler capability allows a thread possessing it to set an endpoint which will be notified of incoming interrupts, and to acknowledge received interrupts.
95
96> decodeIRQHandlerInvocation :: Word -> IRQ -> [(Capability, PPtr CTE)] ->
97>         KernelF SyscallError IRQHandlerInvocation
98> decodeIRQHandlerInvocation label irq extraCaps =
99>     case (invocationType label,extraCaps) of
100>         (IRQAckIRQ,_) -> return $ AckIRQ irq
101>         (IRQSetIRQHandler,(cap,slot):_) -> case cap of
102>                 NotificationCap { capNtfnCanSend = True } ->
103>                     return $ SetIRQHandler irq cap slot
104>                 _ -> throw $ InvalidCapability 0
105>         (IRQSetIRQHandler,_) -> throw TruncatedMessage
106>         (IRQClearIRQHandler,_) -> return $ ClearIRQHandler irq
107>         _ -> throw IllegalOperation
108
109> toBool :: Word -> Bool
110> toBool w = w /= 0
111
112%FIXME x64 naming: this should be called perform, not invoke, same for CNode
113
114> invokeIRQHandler :: IRQHandlerInvocation -> Kernel ()
115> invokeIRQHandler (AckIRQ irq) =
116>     doMachineOp $ maskInterrupt False irq
117> invokeIRQHandler (SetIRQHandler irq cap slot) = do
118>     irqSlot <- getIRQSlot irq
119>     cteDeleteOne irqSlot
120>     cteInsert cap slot irqSlot
121> invokeIRQHandler (ClearIRQHandler irq) = do
122>     irqSlot <- getIRQSlot irq
123>     cteDeleteOne irqSlot
124
125\subsection{Kernel Functions}
126
127\subsubsection{Deleting IRQ Handlers}
128
129When the last IRQ handler capability for a given IRQ is deleted, the capability management code calls these functions, 'deletingIRQHandler' before deletion and 'deletedIRQHandler' after deletion. These mask the IRQ, delete the handler capability, and mark the IRQ as inactive (allowing a new IRQ handler cap to be generated).
130
131> deletingIRQHandler :: IRQ -> Kernel ()
132> deletingIRQHandler irq = do
133>     slot <- getIRQSlot irq
134>     cap <- getSlotCap slot
135>     assert (isNotificationCap cap || isNullCap cap)
136>         "Cap in IRQ handler slot should be Notification or Null."
137>     cteDeleteOne slot
138
139> deletedIRQHandler :: IRQ -> Kernel ()
140> deletedIRQHandler irq =
141>     setIRQState IRQInactive irq
142
143\subsubsection{Initialisation}
144
145This function is called during bootstrap to set up the initial state of the interrupt controller. It allocates a frame and converts its contents to capability slots, which are used as a table endpoints that are notified of incoming interrupts. It also sets the global interrupt controller state, which contains a pointer to each slot and a Boolean flag indicating whether a handler capability has been generated for each IRQ. An interrupt controller capability is provided to the initial thread.
146
147> initInterruptController :: Capability -> Word -> KernelInit Capability
148> initInterruptController rootCNCap biCapIRQC= do
149>     frame <- allocFrame
150>     doKernelOp $ do
151>         assert (length [minBound..(maxBound::IRQ)]
152>                `shiftL` (objBits (makeObject :: CTE)) <= bit pageBits)
153>             "Interrupt vector slots must fit in one frame"
154>         placeNewObject (ptrFromPAddr frame) (makeObject :: CTE)
155>               (pageBits - objBits (makeObject :: CTE))
156>         doMachineOp $ mapM_ (maskInterrupt True) [minBound .. maxBound]
157>         let irqTable = funArray $ const IRQInactive
158>         setInterruptState $ InterruptState (ptrFromPAddr frame) irqTable
159>         timerIRQ <- doMachineOp configureTimer
160>         setIRQState IRQTimer timerIRQ
161>         Arch.initInterruptController
162>         slot <- locateSlotCap rootCNCap biCapIRQC
163>         insertInitCap slot IRQControlCap
164>     return IRQControlCap
165
166\subsubsection{Handling Interrupts}
167\label{sec:object.interrupt.kernel.handling}
168
169This function is called when the kernel receives an interrupt event.
170
171In the case of an interrupt above maxIRQ, we mask, ack and pretend it didn't
172happen.  We assume that mask and ack operations for this IRQ are safe in
173hardware, since the hardware returned it. The situation can arise when maxIRQ
174is set to an incorrect value.
175
176> handleInterrupt :: IRQ -> Kernel ()
177> handleInterrupt irq = do
178>     if (irq > maxIRQ) then doMachineOp $ (do
179>          maskInterrupt True irq
180>          ackInterrupt irq)
181>      else do
182>       st <- getIRQState irq
183>       case st of
184>           IRQSignal -> do
185>               slot <- getIRQSlot irq
186>               cap <- getSlotCap slot
187>               case cap of
188>                   NotificationCap { capNtfnCanSend = True } ->
189>                       sendSignal (capNtfnPtr cap) (capNtfnBadge cap)
190>                   _ -> doMachineOp $ debugPrint $
191>                       "Undelivered interrupt: " ++ show irq
192>               doMachineOp $ maskInterrupt True irq
193>           IRQTimer -> do
194>               timerTick
195>               doMachineOp resetTimer
196>           IRQReserved -> Arch.handleReservedIRQ irq
197>           IRQInactive -> fail $ "Received disabled IRQ " ++ show irq
198>       doMachineOp $ ackInterrupt irq
199
200\subsection{Accessing the Global State}
201
202The following functions are used within this module to access the global interrupt controller state.
203
204> isIRQActive :: IRQ -> Kernel Bool
205> isIRQActive irq = liftM (/=IRQInactive) $ getIRQState irq
206
207> setIRQState :: IRQState -> IRQ -> Kernel ()
208> setIRQState irqState irq = do
209>     st <- getInterruptState
210>     let table = intStateIRQTable st
211>     setInterruptState $ st { intStateIRQTable = table//[(irq, irqState)] }
212>     doMachineOp $ maskInterrupt (irqState==IRQInactive) irq
213
214> getIRQState :: IRQ -> Kernel IRQState
215> getIRQState irq = liftM ((!irq) . intStateIRQTable) getInterruptState
216
217> getIRQSlot :: IRQ -> Kernel (PPtr CTE)
218> getIRQSlot irq = do
219>     node <- liftM intStateIRQNode getInterruptState
220>     locateSlotBasic node (fromIntegral $ fromEnum irq)
221
222
223