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
11{-# LANGUAGE EmptyDataDecls, ForeignFunctionInterface, GeneralizedNewtypeDeriving #-}
12
13module SEL4.Machine.Hardware.ARM.Sabre where
14
15import Prelude hiding (Word)
16import SEL4.Machine.RegisterSet
17import SEL4.Machine.Hardware.ARM.Callbacks
18import SEL4.Machine.Hardware.GICInterface hiding (IRQ, maskInterrupt)
19import qualified SEL4.Machine.Hardware.GICInterface as GIC
20import qualified SEL4.Machine.Hardware.MPTimerInterface as MPT
21import Foreign.Ptr
22import Data.Bits
23
24-- Following harded coded address pair are used in getKernelDevices
25-- and will get mapped into kernel address space via mapKernelFrame
26gicControllerBase = PAddr 0x00A00000
27gicDistributorBase = PAddr 0x00A01000
28l2ccBase = PAddr 0x00A02000
29uartBase = PAddr 0x021E8000
30
31uart = (uartBase, PPtr 0xfff01000)
32l2cc = (l2ccBase, PPtr 0xfff03000)
33gicController = (gicControllerBase, PPtr 0xfff04000)
34gicDistributor = (gicDistributorBase, PPtr 0xfff05000)
35
36
37gicInterfaceBase = gicControllerBase + 0x100
38mptBase = gicControllerBase + 0x600
39
40
41kernelBase :: VPtr
42kernelBase = VPtr 0xe0000000
43
44physBase = 0x10000000
45physMappingOffset = 0xe0000000 - physBase
46
47ptrFromPAddr :: PAddr -> PPtr a
48ptrFromPAddr (PAddr addr) = PPtr $ addr + physMappingOffset
49
50addrFromPPtr :: PPtr a -> PAddr
51addrFromPPtr (PPtr ptr) = PAddr $ ptr - physMappingOffset
52
53pageColourBits :: Int
54pageColourBits = 0 -- qemu has no cache
55
56getMemoryRegions :: Ptr CallbackData -> IO [(PAddr, PAddr)]
57getMemoryRegions _ = return [(PAddr physBase, (PAddr physBase) + (0x8 `shiftL` 24))]
58
59
60userTimer = 0x020D4000
61
62getDeviceRegions :: Ptr CallbackData -> IO [(PAddr, PAddr)]
63getDeviceRegions _ = return devices
64    where devices = [(userTimer,userTimer + (1 `shiftL` 12))]
65
66type IRQ = GIC.IRQ
67
68timerIRQ = GIC.IRQ 29
69
70getKernelDevices :: Ptr CallbackData -> IO [(PAddr, PPtr Word)]
71getKernelDevices _ = return devices
72    where devices = [
73            gicController, -- interrupt controller
74            gicDistributor, -- interrupt controller
75            uart
76            ]
77
78maskInterrupt :: Ptr CallbackData -> Bool -> IRQ -> IO ()
79maskInterrupt env mask irq = do
80     callGICApi (GicState { env = env, gicDistBase = gicDistributorBase, gicIFBase = gicInterfaceBase })
81       (GIC.maskInterrupt mask irq)
82
83-- We don't need to acknowledge interrupts explicitly because we don't use
84-- the vectored interrupt controller.
85ackInterrupt :: Ptr CallbackData -> IRQ -> IO ()
86ackInterrupt env irq = do
87  callGICApi gic (GIC.ackInterrupt irq)
88      where gic = GicState { env = env,
89        gicDistBase = gicDistributorBase,
90        gicIFBase = gicInterfaceBase }
91
92foreign import ccall unsafe "qemu_run_devices"
93    runDevicesCallback :: IO ()
94
95getActiveIRQ :: Ptr CallbackData -> IO (Maybe IRQ)
96getActiveIRQ env = do
97    runDevicesCallback
98    active <- callGICApi gicdata $ GIC.getActiveIRQ
99    case active of
100        Just 0x3FF -> return Nothing
101        _ -> return active
102      where gicdata = GicState { env = env,
103        gicDistBase = gicDistributorBase,
104        gicIFBase = gicInterfaceBase }
105
106configureTimer :: Ptr CallbackData -> IO IRQ
107configureTimer env = do
108    MPT.callMPTimerApi mptdata $ MPT.mpTimerInit
109    return timerIRQ
110      where mptdata = MPT.MPTimerState { MPT.env = env,
111        MPT.mptBase = mptBase }
112
113initIRQController :: Ptr CallbackData -> IO ()
114initIRQController env = callGICApi gicdata $ GIC.initIRQController
115  where gicdata = GicState { env = env,
116    gicDistBase = gicDistributorBase,
117    gicIFBase = gicInterfaceBase }
118
119resetTimer :: Ptr CallbackData -> IO ()
120resetTimer env = do
121    MPT.callMPTimerApi mptdata $ MPT.resetTimer
122      where mptdata = MPT.MPTimerState { MPT.env = env,
123        MPT.mptBase = mptBase }
124
125isbCallback :: Ptr CallbackData -> IO ()
126isbCallback _ = return ()
127
128dsbCallback :: Ptr CallbackData -> IO ()
129dsbCallback _ = return ()
130
131dmbCallback :: Ptr CallbackData -> IO ()
132dmbCallback _ = return ()
133
134cacheCleanByVACallback :: Ptr CallbackData -> VPtr -> PAddr -> IO ()
135cacheCleanByVACallback _cptr _mva _pa = return ()
136
137cacheCleanByVA_PoUCallback :: Ptr CallbackData -> VPtr -> PAddr -> IO ()
138cacheCleanByVA_PoUCallback _cptr _mva _pa = return ()
139
140cacheInvalidateByVACallback :: Ptr CallbackData -> VPtr -> PAddr -> IO ()
141cacheInvalidateByVACallback _cptr _mva _pa = return ()
142
143cacheInvalidateByVA_ICallback :: Ptr CallbackData -> VPtr -> PAddr -> IO ()
144cacheInvalidateByVA_ICallback _cptr _mva _pa = return ()
145
146cacheInvalidate_I_PoUCallback :: Ptr CallbackData -> IO ()
147cacheInvalidate_I_PoUCallback _ = return ()
148
149cacheCleanInvalidateByVACallback ::
150    Ptr CallbackData -> VPtr -> PAddr -> IO ()
151cacheCleanInvalidateByVACallback _cptr _mva _pa = return ()
152
153branchFlushCallback :: Ptr CallbackData -> VPtr -> PAddr -> IO ()
154branchFlushCallback _cptr _mva _pa = return ()
155
156cacheClean_D_PoUCallback :: Ptr CallbackData -> IO ()
157cacheClean_D_PoUCallback _ = return ()
158
159cacheCleanInvalidate_D_PoCCallback :: Ptr CallbackData -> IO ()
160cacheCleanInvalidate_D_PoCCallback _ = return ()
161
162cacheCleanInvalidate_D_PoUCallback :: Ptr CallbackData -> IO ()
163cacheCleanInvalidate_D_PoUCallback _ = return ()
164
165cacheCleanInvalidateL2RangeCallback ::
166    Ptr CallbackData -> PAddr -> PAddr -> IO ()
167cacheCleanInvalidateL2RangeCallback _ _ _ = return ()
168
169cacheInvalidateL2RangeCallback :: Ptr CallbackData -> PAddr -> PAddr -> IO ()
170cacheInvalidateL2RangeCallback _ _ _ = return ()
171
172cacheCleanL2RangeCallback :: Ptr CallbackData -> PAddr -> PAddr -> IO ()
173cacheCleanL2RangeCallback _ _ _ = return ()
174
175-- FIXME: This is not correct now, we do not have l2cc interface abstracted.
176cacheLine :: Int
177cacheLine = 32
178
179cacheLineBits :: Int
180cacheLineBits = 5
181