never executed always true always false
1 {-# LANGUAGE OverloadedStrings #-}
2 {-# LANGUAGE QuasiQuotes #-}
3 {-# LANGUAGE RecordWildCards #-}
4 {-# LANGUAGE StandaloneDeriving #-}
5 {-# LANGUAGE TypeFamilies #-}
6
7 {- |
8 Module : NITTA.Model.ProcessorUnits.Shift
9 Description : Shift Processor Unit
10 Copyright : (c) Daniil Prohorov, 2020
11 License : BSD3
12 Maintainer : aleksandr.penskoi@gmail.com
13 Stability : experimental
14 -}
15 module NITTA.Model.ProcessorUnits.Shift (
16 Shift,
17 Ports (..),
18 IOPorts (..),
19 shift,
20 ) where
21
22 import Control.Monad (when)
23 import Data.Default
24 import Data.List (find, (\\))
25 import Data.Set (elems, fromList, member)
26 import Data.String.Interpolate
27 import NITTA.Intermediate.Functions hiding (remain)
28 import NITTA.Intermediate.Types
29 import NITTA.Model.Problems
30 import NITTA.Model.ProcessorUnits.Types
31 import NITTA.Model.Time
32 import NITTA.Project
33 import NITTA.Utils
34 import NITTA.Utils.ProcessDescription
35 import Numeric.Interval.NonEmpty (inf, singleton, sup, (...))
36 import Prelude hiding (init)
37
38 data Shift v x t = Shift
39 { remain :: [F v x]
40 -- ^ list of FU, that will be bound later
41 , target :: Maybe v
42 -- ^ current input value, that we want to shift
43 , sources :: [v]
44 -- ^ list of output values
45 , sRight :: Bool
46 -- ^ True -> shift right; False -> shift left
47 , byteShiftDiv :: Int
48 -- ^ shift div 8 (is used for byte shift)
49 , byteShiftMod :: Int
50 -- ^ shift mod 8 (is used for bit shift)
51 , currentWork :: Maybe (F v x)
52 -- ^ current function in PU
53 , process_ :: Process t (StepInfo v x t)
54 -- ^ description of target computation process
55 }
56
57 instance Var v => Locks (Shift v x t) v where
58 locks Shift{sources, target = Just t} =
59 [ Lock{lockBy = t, locked}
60 | locked <- sources
61 ]
62 locks Shift{target = Nothing} = []
63
64 shift sRight =
65 Shift
66 { remain = []
67 , target = Nothing
68 , sources = []
69 , sRight
70 , byteShiftDiv = 0
71 , byteShiftMod = 0
72 , currentWork = Nothing
73 , process_ = def
74 }
75
76 instance Default t => Default (Shift v x t) where
77 def = shift True
78
79 instance BreakLoopProblem (Shift v x t) v x
80 instance ConstantFoldingProblem (Shift v x t) v x
81 instance OptimizeAccumProblem (Shift v x t) v x
82 instance ResolveDeadlockProblem (Shift v x t) v x
83
84 instance VarValTime v x t => ProcessorUnit (Shift v x t) v x t where
85 tryBind f pu@Shift{remain}
86 | Just f' <- castF f =
87 case f' of
88 ShiftL{} -> Right pu{remain = f : remain}
89 ShiftR{} -> Right pu{remain = f : remain}
90 | otherwise = Left $ "The function is unsupported by Shift: " ++ show f
91 process = process_
92
93 -- | This function carry out actual take functional block to work.
94 execution pu@Shift{target = Nothing, sources = [], remain} f
95 | Just f' <- castF f =
96 case f' of
97 ShiftL s (I i_) (O o) -> toPU i_ o False s
98 ShiftR s (I i_) (O o) -> toPU i_ o True s
99 where
100 toPU inp out sRight step =
101 pu
102 { target = Just inp
103 , currentWork = Just f
104 , sources = elems out
105 , remain = remain \\ [f]
106 , sRight = sRight
107 , byteShiftDiv = step `div` 8
108 , byteShiftMod = step `mod` 8
109 }
110 execution _ _ = error "Not right arguments in execution function in shift module"
111
112 instance VarValTime v x t => EndpointProblem (Shift v x t) v t where
113 endpointOptions pu@Shift{target = Just t} =
114 [EndpointSt (Target t) $ TimeConstraint (nextTick pu ... maxBound) (singleton 1)]
115 endpointOptions pu@Shift{sources, byteShiftDiv, byteShiftMod}
116 | not $ null sources
117 , byteShiftDiv == 0 =
118 let timeConstrain = TimeConstraint (startTime ... maxBound) (1 ... maxBound)
119 startTime = nextTick pu + fromIntegral byteShiftMod + 2
120 in [EndpointSt (Source $ fromList sources) timeConstrain]
121 | not $ null sources =
122 let endByteShift = nextTick pu + fromIntegral byteShiftDiv
123 timeConstrain = TimeConstraint (startTime ... maxBound) (1 ... maxBound)
124 startTime = endByteShift + fromIntegral byteShiftMod + 2
125 in [EndpointSt (Source $ fromList sources) timeConstrain]
126 endpointOptions pu@Shift{remain} = concatMap (endpointOptions . execution pu) remain
127
128 endpointDecision
129 pu@Shift
130 { target = (Just _)
131 , sRight
132 , byteShiftDiv
133 , byteShiftMod
134 }
135 d@EndpointSt
136 { epRole = Target _
137 , epAt
138 } =
139 let startByteShift = inf epAt + 1
140 numByteShiftMod = fromIntegral byteShiftMod
141 endByteShift = sup epAt + fromIntegral byteShiftDiv
142 process_' = execSchedule pu $ do
143 scheduleEndpoint d $ do
144 scheduleInstructionUnsafe_ epAt Init
145 case (byteShiftDiv, byteShiftMod) of
146 (0, _) ->
147 scheduleInstructionUnsafe
148 (inf epAt + 1 ... sup epAt + numByteShiftMod)
149 Work{shiftRight = sRight, stepByte = False, shiftType = Logic}
150 (_, 0) ->
151 scheduleInstructionUnsafe
152 (startByteShift ... endByteShift)
153 Work{shiftRight = sRight, stepByte = True, shiftType = Logic}
154 _ ->
155 do
156 _ <-
157 scheduleInstructionUnsafe
158 (startByteShift ... endByteShift)
159 Work{shiftRight = sRight, stepByte = True, shiftType = Logic}
160 scheduleInstructionUnsafe
161 (endByteShift + 1 ... endByteShift + numByteShiftMod)
162 Work{shiftRight = sRight, stepByte = False, shiftType = Logic}
163 in pu
164 { process_ = process_'
165 , target = Nothing
166 }
167 endpointDecision
168 pu@Shift
169 { target = Nothing
170 , sources
171 , currentWork = Just f
172 , process_
173 }
174 d@EndpointSt
175 { epRole = Source v
176 , epAt
177 }
178 | not $ null sources
179 , let sources' = sources \\ elems v
180 , let a = inf $ stepsInterval $ relatedEndpoints process_ $ variables f
181 , sources' /= sources =
182 let process_' = execSchedule pu $ do
183 endpoints <- scheduleEndpoint d $ scheduleInstructionUnsafe (shiftI (-1) epAt) Out
184 when (null sources') $ do
185 -- FIXME: here ([]) you can see the source of error.
186 -- Function don't connected to bind step. It should be fixed.
187 scheduleFunctionFinish_ [] f $ a ... sup epAt
188 return endpoints
189 in pu
190 { process_ = process_'
191 , sources = sources'
192 , currentWork = if null sources' then Nothing else Just f
193 }
194 endpointDecision pu@Shift{target = Nothing, sources = [], remain} d
195 | let v = oneOf $ variables d
196 , Just f <- find (\f -> v `member` variables f) remain =
197 endpointDecision (execution pu f) d
198 endpointDecision _pu d = error [i|incorrect decision #{ d } for Shift|]
199
200 data Mode = Logic | Arithmetic deriving (Show, Eq)
201
202 instance Controllable (Shift v x t) where
203 data Instruction (Shift v x t)
204 = Init
205 | Work
206 { shiftRight :: Bool
207 , stepByte :: Bool
208 , shiftType :: Mode
209 }
210 | Out
211 deriving (Show)
212
213 data Microcode (Shift v x t) = Microcode
214 { workSignal :: Bool
215 , directionSignal :: Bool
216 , modeSignal :: Bool
217 , stepSignal :: Bool
218 , initSignal :: Bool
219 , oeSignal :: Bool
220 }
221 deriving (Show, Eq, Ord)
222
223 zipSignalTagsAndValues ShiftPorts{..} Microcode{..} =
224 [ (work, Bool workSignal)
225 , (direction, Bool directionSignal)
226 , (mode, Bool modeSignal)
227 , (step, Bool stepSignal)
228 , (init, Bool initSignal)
229 , (oe, Bool oeSignal)
230 ]
231
232 usedPortTags ShiftPorts{work, direction, mode, step, init, oe} =
233 [work, direction, mode, step, init, oe]
234
235 takePortTags (work : direction : mode : step : init : oe : _) _ = ShiftPorts work direction mode step init oe
236 takePortTags _ _ = error "can not take port tags, tags are over"
237
238 instance Default (Microcode (Shift v x t)) where
239 def =
240 Microcode
241 { workSignal = False
242 , directionSignal = False
243 , modeSignal = False
244 , stepSignal = True
245 , initSignal = False
246 , oeSignal = False
247 }
248
249 instance UnambiguouslyDecode (Shift v x t) where
250 decodeInstruction Init = def{initSignal = True}
251 decodeInstruction Out = def{oeSignal = True}
252 decodeInstruction (Work toRight step mode) =
253 def
254 { workSignal = True
255 , directionSignal = not toRight
256 , modeSignal = mode == Arithmetic
257 , stepSignal = step
258 }
259
260 instance Connected (Shift v x t) where
261 data Ports (Shift v x t) = ShiftPorts {work, direction, mode, step, init, oe :: SignalTag}
262 deriving (Show)
263
264 instance IOConnected (Shift v x t) where
265 data IOPorts (Shift v x t) = ShiftIO
266
267 instance Val x => TargetSystemComponent (Shift v x t) where
268 moduleName _ _ = "pu_shift"
269 hardware _tag _pu = FromLibrary "pu_shift.v"
270 software _ _ = Empty
271 hardwareInstance
272 tag
273 _pu
274 UnitEnv
275 { sigClk
276 , ctrlPorts = Just ShiftPorts{..}
277 , valueIn = Just (dataIn, attrIn)
278 , valueOut = Just (dataOut, attrOut)
279 } =
280 [__i|
281 pu_shift \#
282 ( .DATA_WIDTH( #{ dataWidth (def :: x) } )
283 , .ATTR_WIDTH( #{ attrWidth (def :: x) } )
284 ) #{ tag }
285 ( .clk( #{ sigClk } )
286 , .signal_work( #{ work } ), .signal_direction( #{ direction } )
287 , .signal_mode( #{ mode } ), .signal_step( #{ step } )
288 , .signal_init( #{ init } ), .signal_oe( #{ oe } )
289 , .data_in( #{ dataIn } )
290 , .attr_in( #{ attrIn } )
291 , .data_out( #{ dataOut } )
292 , .attr_out( #{ attrOut } )
293 );
294 |]
295 hardwareInstance _title _pu _env = error "internal error"
296
297 instance IOTestBench (Shift v x t) v x