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 OptimizeLogicalUnitProblem (Shift v x t) v x
83 instance ResolveDeadlockProblem (Shift v x t) v x
84
85 instance VarValTime v x t => ProcessorUnit (Shift v x t) v x t where
86 tryBind f pu@Shift{remain}
87 | Just f' <- castF f =
88 case f' of
89 ShiftL{} -> Right pu{remain = f : remain}
90 ShiftR{} -> Right pu{remain = f : remain}
91 | otherwise = Left $ "The function is unsupported by Shift: " ++ show f
92 process = process_
93
94 -- | This function carry out actual take functional block to work.
95 execution pu@Shift{target = Nothing, sources = [], remain} f
96 | Just f' <- castF f =
97 case f' of
98 ShiftL s (I i_) (O o) -> toPU i_ o False s
99 ShiftR s (I i_) (O o) -> toPU i_ o True s
100 where
101 toPU inp out sRight step =
102 pu
103 { target = Just inp
104 , currentWork = Just f
105 , sources = elems out
106 , remain = remain \\ [f]
107 , sRight = sRight
108 , byteShiftDiv = step `div` 8
109 , byteShiftMod = step `mod` 8
110 }
111 execution _ _ = error "Not right arguments in execution function in shift module"
112
113 instance VarValTime v x t => EndpointProblem (Shift v x t) v t where
114 endpointOptions pu@Shift{target = Just t} =
115 [EndpointSt (Target t) $ TimeConstraint (nextTick pu ... maxBound) (singleton 1)]
116 endpointOptions pu@Shift{sources, byteShiftDiv, byteShiftMod}
117 | not $ null sources
118 , byteShiftDiv == 0 =
119 let timeConstrain = TimeConstraint (startTime ... maxBound) (1 ... maxBound)
120 startTime = nextTick pu + fromIntegral byteShiftMod + 2
121 in [EndpointSt (Source $ fromList sources) timeConstrain]
122 | not $ null sources =
123 let endByteShift = nextTick pu + fromIntegral byteShiftDiv
124 timeConstrain = TimeConstraint (startTime ... maxBound) (1 ... maxBound)
125 startTime = endByteShift + fromIntegral byteShiftMod + 2
126 in [EndpointSt (Source $ fromList sources) timeConstrain]
127 endpointOptions pu@Shift{remain} = concatMap (endpointOptions . execution pu) remain
128
129 endpointDecision
130 pu@Shift
131 { target = (Just _)
132 , sRight
133 , byteShiftDiv
134 , byteShiftMod
135 }
136 d@EndpointSt
137 { epRole = Target _
138 , epAt
139 } =
140 let startByteShift = inf epAt + 1
141 numByteShiftMod = fromIntegral byteShiftMod
142 endByteShift = sup epAt + fromIntegral byteShiftDiv
143 process_' = execSchedule pu $ do
144 scheduleEndpoint d $ do
145 scheduleInstructionUnsafe_ epAt Init
146 case (byteShiftDiv, byteShiftMod) of
147 (0, _) ->
148 scheduleInstructionUnsafe
149 (inf epAt + 1 ... sup epAt + numByteShiftMod)
150 Work{shiftRight = sRight, stepByte = False, shiftType = Logic}
151 (_, 0) ->
152 scheduleInstructionUnsafe
153 (startByteShift ... endByteShift)
154 Work{shiftRight = sRight, stepByte = True, shiftType = Logic}
155 _ ->
156 do
157 _ <-
158 scheduleInstructionUnsafe
159 (startByteShift ... endByteShift)
160 Work{shiftRight = sRight, stepByte = True, shiftType = Logic}
161 scheduleInstructionUnsafe
162 (endByteShift + 1 ... endByteShift + numByteShiftMod)
163 Work{shiftRight = sRight, stepByte = False, shiftType = Logic}
164 in pu
165 { process_ = process_'
166 , target = Nothing
167 }
168 endpointDecision
169 pu@Shift
170 { target = Nothing
171 , sources
172 , currentWork = Just f
173 , process_
174 }
175 d@EndpointSt
176 { epRole = Source v
177 , epAt
178 }
179 | not $ null sources
180 , let sources' = sources \\ elems v
181 , let a = inf $ stepsInterval $ relatedEndpoints process_ $ variables f
182 , sources' /= sources =
183 let process_' = execSchedule pu $ do
184 endpoints <- scheduleEndpoint d $ scheduleInstructionUnsafe (shiftI (-1) epAt) Out
185 when (null sources') $ do
186 -- FIXME: here ([]) you can see the source of error.
187 -- Function don't connected to bind step. It should be fixed.
188 scheduleFunctionFinish_ [] f $ a ... sup epAt
189 return endpoints
190 in pu
191 { process_ = process_'
192 , sources = sources'
193 , currentWork = if null sources' then Nothing else Just f
194 }
195 endpointDecision pu@Shift{target = Nothing, sources = [], remain} d
196 | let v = oneOf $ variables d
197 , Just f <- find (\f -> v `member` variables f) remain =
198 endpointDecision (execution pu f) d
199 endpointDecision _pu d = error [i|incorrect decision #{ d } for Shift|]
200
201 data Mode = Logic | Arithmetic deriving (Show, Eq)
202
203 instance Controllable (Shift v x t) where
204 data Instruction (Shift v x t)
205 = Init
206 | Work
207 { shiftRight :: Bool
208 , stepByte :: Bool
209 , shiftType :: Mode
210 }
211 | Out
212 deriving (Show)
213
214 data Microcode (Shift v x t) = Microcode
215 { workSignal :: Bool
216 , directionSignal :: Bool
217 , modeSignal :: Bool
218 , stepSignal :: Bool
219 , initSignal :: Bool
220 , oeSignal :: Bool
221 }
222 deriving (Show, Eq, Ord)
223
224 zipSignalTagsAndValues ShiftPorts{..} Microcode{..} =
225 [ (work, Bool workSignal)
226 , (direction, Bool directionSignal)
227 , (mode, Bool modeSignal)
228 , (step, Bool stepSignal)
229 , (init, Bool initSignal)
230 , (oe, Bool oeSignal)
231 ]
232
233 usedPortTags ShiftPorts{work, direction, mode, step, init, oe} =
234 [work, direction, mode, step, init, oe]
235
236 takePortTags (work : direction : mode : step : init : oe : _) _ = ShiftPorts work direction mode step init oe
237 takePortTags _ _ = error "can not take port tags, tags are over"
238
239 instance Default (Microcode (Shift v x t)) where
240 def =
241 Microcode
242 { workSignal = False
243 , directionSignal = False
244 , modeSignal = False
245 , stepSignal = True
246 , initSignal = False
247 , oeSignal = False
248 }
249
250 instance UnambiguouslyDecode (Shift v x t) where
251 decodeInstruction Init = def{initSignal = True}
252 decodeInstruction Out = def{oeSignal = True}
253 decodeInstruction (Work toRight step mode) =
254 def
255 { workSignal = True
256 , directionSignal = not toRight
257 , modeSignal = mode == Arithmetic
258 , stepSignal = step
259 }
260
261 instance Connected (Shift v x t) where
262 data Ports (Shift v x t) = ShiftPorts {work, direction, mode, step, init, oe :: SignalTag}
263 deriving (Show)
264
265 instance IOConnected (Shift v x t) where
266 data IOPorts (Shift v x t) = ShiftIO
267
268 instance Val x => TargetSystemComponent (Shift v x t) where
269 moduleName _ _ = "pu_shift"
270 hardware _tag _pu = FromLibrary "pu_shift.v"
271 software _ _ = Empty
272 hardwareInstance
273 tag
274 _pu
275 UnitEnv
276 { sigClk
277 , ctrlPorts = Just ShiftPorts{..}
278 , valueIn = Just (dataIn, attrIn)
279 , valueOut = Just (dataOut, attrOut)
280 } =
281 [__i|
282 pu_shift \#
283 ( .DATA_WIDTH( #{ dataWidth (def :: x) } )
284 , .ATTR_WIDTH( #{ attrWidth (def :: x) } )
285 ) #{ tag }
286 ( .clk( #{ sigClk } )
287 , .signal_work( #{ work } ), .signal_direction( #{ direction } )
288 , .signal_mode( #{ mode } ), .signal_step( #{ step } )
289 , .signal_init( #{ init } ), .signal_oe( #{ oe } )
290 , .data_in( #{ dataIn } )
291 , .attr_in( #{ attrIn } )
292 , .data_out( #{ dataOut } )
293 , .attr_out( #{ attrOut } )
294 );
295 |]
296 hardwareInstance _title _pu _env = error "internal error"
297
298 instance IOTestBench (Shift v x t) v x