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 defines the machine-specific interrupt handling routines.
12
13\begin{impdetails}
14
15> {-# LANGUAGE CPP #-}
16
17\end{impdetails}
18
19> module SEL4.Object.Interrupt.ARM where
20
21\begin{impdetails}
22
23> import Prelude hiding (Word)
24> import SEL4.Machine
25> import SEL4.Model
26> import SEL4.Object.Structures
27> import SEL4.API.Failures
28> import SEL4.API.Types
29> import SEL4.API.InvocationLabels
30> import SEL4.API.Invocation.ARM as ArchInv
31> import SEL4.API.InvocationLabels.ARM as ArchLabels
32> import {-# SOURCE #-} SEL4.Object.Interrupt (setIRQState, isIRQActive)
33> import {-# SOURCE #-} SEL4.Kernel.CSpace
34> import {-# SOURCE #-} SEL4.Object.CNode
35> import qualified SEL4.Machine.Hardware.ARM as Arch
36#ifdef CONFIG_ARM_HYPERVISOR_SUPPORT
37> import SEL4.Object.VCPU.TARGET (vgicMaintenance)
38> import SEL4.Machine.Hardware.ARM.PLATFORM (irqVGICMaintenance, irqSMMU)
39#endif
40
41\end{impdetails}
42
43
44> decodeIRQControlInvocation :: Word -> [Word] -> PPtr CTE -> [Capability] ->
45>         KernelF SyscallError ArchInv.IRQControlInvocation
46> decodeIRQControlInvocation label args srcSlot extraCaps =
47>     case (invocationType label, args, extraCaps) of
48>         (ArchInvocationLabel ArchLabels.ARMIRQIssueIRQHandler, irqW:triggerW:index:depth:_, cnode:_) -> do
49>             checkIRQ irqW
50>             let irq = toEnum (fromIntegral irqW) :: IRQ
51>             irqActive <- withoutFailure $ isIRQActive irq
52>             when irqActive $ throw RevokeFirst
53>
54>             destSlot <- lookupTargetSlot cnode
55>                 (CPtr index) (fromIntegral depth)
56>             ensureEmptySlot destSlot
57>             return $ ArchInv.IssueIRQHandler irq destSlot srcSlot (triggerW /= 0)
58>         (ArchInvocationLabel ArchLabels.ARMIRQIssueIRQHandler,_,_) -> throw TruncatedMessage
59>         _ -> throw IllegalOperation
60
61> performIRQControl :: ArchInv.IRQControlInvocation -> KernelP ()
62> performIRQControl (ArchInv.IssueIRQHandler (IRQ irq) destSlot srcSlot trigger) = withoutPreemption $ do
63>     doMachineOp $ Arch.setIRQTrigger irq trigger
64>     -- do same thing as generic path in performIRQControl in Interrupt.lhs
65>     setIRQState IRQSignal (IRQ irq)
66>     cteInsert (IRQHandlerCap (IRQ irq)) srcSlot destSlot
67>     return ()
68
69> checkIRQ :: Word -> KernelF SyscallError ()
70> checkIRQ irq = rangeCheck irq (fromEnum minIRQ) (fromEnum maxIRQ)
71
72> handleReservedIRQ :: IRQ -> Kernel ()
73> handleReservedIRQ irq = do
74#ifdef CONFIG_ARM_HYPERVISOR_SUPPORT
75>     -- case irq of IRQ irqVGICMaintenance -> vgicMaintenance -- FIXME how to properly handle IRQ for haskell translator here?
76>     when (fromEnum irq == fromEnum irqVGICMaintenance) vgicMaintenance
77>     return ()
78#else
79>     return () -- handleReservedIRQ does nothing on ARM
80#endif
81
82> initInterruptController :: Kernel ()
83> initInterruptController = do
84#ifdef CONFIG_ARM_HYPERVISOR_SUPPORT
85>     setIRQState IRQReserved $ IRQ irqVGICMaintenance
86#endif
87#ifdef CONFIG_SMMU
88>     setIRQState IRQReserved $ IRQ irqSMMU
89#endif
90>     return ()
91
92