never executed always true always false
1 {-# LANGUAGE DuplicateRecordFields #-}
2 {-# LANGUAGE OverloadedStrings #-}
3 {-# LANGUAGE QuasiQuotes #-}
4 {-# LANGUAGE RecordWildCards #-}
5 {-# LANGUAGE TypeFamilies #-}
6
7 {- |
8 Module : NITTA.Model.ProcessorUnits.Divider
9 Description : Integral divider processor unit with pipeline
10 Copyright : (c) Aleksandr Penskoi, 2021
11 License : BSD3
12 Maintainer : aleksandr.penskoi@gmail.com
13 Stability : experimental
14 -}
15 module NITTA.Model.ProcessorUnits.Divider (
16 Divider (..),
17 divider,
18 Ports (..),
19 IOPorts (..),
20 ) where
21
22 import Control.Monad
23 import Data.Default
24 import Data.List (partition)
25 import Data.List qualified as L
26 import Data.Maybe
27 import Data.Set qualified as S
28 import Data.String.Interpolate
29 import Data.String.ToString
30 import NITTA.Intermediate.Functions qualified as F
31 import NITTA.Intermediate.Types
32 import NITTA.Model.Problems
33 import NITTA.Model.ProcessorUnits.Types
34 import NITTA.Model.Time
35 import NITTA.Project
36 import NITTA.Utils
37 import NITTA.Utils.ProcessDescription
38 import Numeric.Interval.NonEmpty (singleton, sup, (...))
39
40 data InputDesc
41 = Numer
42 | Denom
43 deriving (Show, Eq)
44
45 data OutputDesc
46 = Quotient
47 | Remain
48 deriving (Show, Eq)
49
50 data Divider v x t = Divider
51 { jobs :: [Job v x t]
52 , remains :: [F v x]
53 , process_ :: Process t (StepInfo v x t)
54 , pipeline :: t
55 , mock :: Bool
56 }
57
58 instance (Show v, Show t) => Show (Divider v x t) where
59 show Divider{jobs} = show jobs
60
61 divider pipeline mock =
62 Divider
63 { jobs = []
64 , remains = []
65 , process_ = def
66 , pipeline
67 , mock
68 }
69
70 instance Time t => Default (Divider v x t) where
71 def = divider 4 True
72
73 instance Default x => DefaultX (Divider v x t) x
74
75 instance Ord t => WithFunctions (Divider v x t) (F v x) where
76 functions Divider{process_, remains, jobs} =
77 functions process_
78 ++ remains
79 ++ map function jobs
80
81 data Job v x t
82 = WaitArguments
83 { function :: F v x
84 , arguments :: [(InputDesc, v)]
85 }
86 | WaitResults
87 { function :: F v x
88 , readyAt :: t
89 , restrict :: Maybe t
90 , results :: [(OutputDesc, S.Set v)]
91 }
92 deriving (Eq, Show)
93
94 instance Ord v => Variables (Job v x t) v where
95 variables WaitArguments{arguments} = S.fromList $ map snd arguments
96 variables WaitResults{results} = S.unions $ map snd results
97
98 isWaitArguments WaitArguments{} = True
99 isWaitArguments _ = False
100
101 isWaitResults WaitResults{} = True
102 isWaitResults _ = False
103
104 instance VarValTime v x t => ProcessorUnit (Divider v x t) v x t where
105 tryBind f pu@Divider{remains}
106 | Just (F.Division (I _n) (I _d) (O _q) (O _r)) <- castF f =
107 Right pu{remains = f : remains}
108 | otherwise = Left $ "Unknown functional block: " ++ show f
109 process = process_
110 parallelismType _ = Pipeline
111
112 instance (Var v, Time t) => Locks (Divider v x t) v where
113 locks Divider{jobs, remains} = L.nub $ byArguments ++ byResults
114 where
115 byArguments
116 | Just wa@WaitArguments{function} <- L.find isWaitArguments jobs =
117 [ Lock{lockBy, locked}
118 | lockBy <- S.elems $ variables wa
119 , locked <- S.elems $ unionsMap variables remains
120 ]
121 ++ [ Lock{lockBy, locked}
122 | lockBy <- S.elems $ variables wa
123 , locked <- S.elems $ outputs function
124 ]
125 | otherwise = concatMap locks remains
126 byResults
127 | Just wr <- firstWaitResults jobs =
128 let blocked = filter (\j -> isWaitResults j && j /= wr) jobs
129 in [ Lock{lockBy, locked}
130 | lockBy <- S.elems $ variables wr
131 , locked <- S.elems $ unionsMap variables blocked
132 ]
133 | otherwise = []
134
135 instance BreakLoopProblem (Divider v x t) v x
136 instance ConstantFoldingProblem (Divider v x t) v x
137 instance OptimizeAccumProblem (Divider v x t) v x
138 instance ResolveDeadlockProblem (Divider v x t) v x
139
140 function2WaitArguments f
141 | Just F.Division{F.denom = I denom, F.numer = I numer} <- castF f =
142 WaitArguments
143 { function = f
144 , arguments = [(Denom, denom), (Numer, numer)]
145 }
146 | otherwise = error $ "internal divider error: " <> show f
147
148 function2WaitResults readyAt f
149 | Just F.Division{F.quotient = O quotient, F.remain = O remain} <- castF f =
150 WaitResults
151 { function = f
152 , readyAt
153 , restrict = Nothing
154 , results = filterEmptyResults [(Quotient, quotient), (Remain, remain)]
155 }
156 | otherwise = error "internal error"
157
158 filterEmptyResults rs = filter (not . null . snd) rs
159
160 firstWaitResults jobs =
161 let jobs' = filter isWaitResults jobs
162 in if null jobs'
163 then Nothing
164 else Just $ minimumOn readyAt jobs'
165
166 instance VarValTime v x t => EndpointProblem (Divider v x t) v t where
167 endpointOptions pu@Divider{remains, jobs} =
168 let executeNewFunction
169 | any isWaitArguments jobs = []
170 | otherwise = concatMap (map target . S.elems . inputs) remains
171 waitingArguments =
172 maybe [] (map target . S.elems . variables) $ L.find isWaitArguments jobs
173 waitResults
174 | Just WaitResults{readyAt, results, restrict} <- firstWaitResults jobs =
175 let at = max readyAt (nextTick pu) ... fromMaybe maxBound restrict
176 in map (sources at . snd) results
177 | otherwise = []
178 in concat [executeNewFunction, waitingArguments, waitResults]
179 where
180 target v = EndpointSt (Target v) $ TimeConstraint (nextTick pu ... maxBound) (singleton 1)
181 sources at vs = EndpointSt (Source vs) $ TimeConstraint at (singleton 1)
182
183 endpointDecision pu@Divider{jobs, remains, pipeline} d@EndpointSt{epRole = Target v, epAt}
184 | ([f], remains') <- partition (S.member v . inputs) remains =
185 let pu' =
186 pu
187 { jobs = function2WaitArguments f : jobs
188 , remains = remains'
189 }
190 in endpointDecision pu' d
191 | ([WaitArguments{function, arguments}], jobs') <- partition (S.member v . variables) jobs =
192 let (tag, arguments') = case partition ((== v) . snd) arguments of
193 ([(tag', _v)], other) -> (tag', other)
194 _ -> error "Divider: endpointDecision: internal error"
195 nextTick' = sup epAt + 1
196 in case arguments' of
197 [] ->
198 let job' = function2WaitResults (nextTick' + pipeline + 1) function
199 restrictResults =
200 map
201 ( \case
202 wa@WaitResults{restrict = Nothing} -> wa{restrict = Just (nextTick' + pipeline)}
203 other -> other
204 )
205 in pu
206 { jobs = job' : restrictResults jobs'
207 , process_ = execSchedule pu $ do
208 scheduleEndpoint_ d $ scheduleInstructionUnsafe epAt $ Load tag
209 scheduleInstructionUnsafe_ (singleton nextTick') Do
210 }
211 _arguments' ->
212 pu
213 { jobs = WaitArguments{function, arguments = arguments'} : jobs'
214 , process_ = execSchedule pu $ do
215 scheduleEndpoint_ d $ scheduleInstructionUnsafe epAt $ Load tag
216 }
217 endpointDecision pu@Divider{jobs} d@EndpointSt{epRole = Source vs, epAt}
218 | ([job@WaitResults{results, function}], jobs') <- partition ((vs `S.isSubsetOf`) . variables) jobs =
219 let ((tag, allVs), results') = case partition ((vs `S.isSubsetOf`) . snd) results of
220 ([(tag_, allVs_)], other) -> ((tag_, allVs_), other)
221 _ -> error "Divider: endpointDecision: internal error"
222 allVs' = allVs S.\\ vs
223 results'' = filterEmptyResults $ (tag, allVs') : results'
224 jobs'' =
225 if null results''
226 then jobs'
227 else job{results = results''} : jobs'
228 in pu
229 { jobs = jobs''
230 , process_ = execSchedule pu $ do
231 scheduleEndpoint_ d $ scheduleInstructionUnsafe epAt $ Out tag
232 when (null jobs') $ do
233 scheduleFunctionFinish_ [] function $ 0 ... sup epAt
234 }
235 endpointDecision _pu d = error [i|incorrect decision #{ d } for Divider|]
236
237 instance Controllable (Divider v x t) where
238 data Instruction (Divider v x t)
239 = Load InputDesc
240 | Do
241 | Out OutputDesc
242 deriving (Show)
243
244 data Microcode (Divider v x t) = Microcode
245 { selSignal :: Bool
246 , wrSignal :: Bool
247 , oeSignal :: Bool
248 }
249 deriving (Show, Eq, Ord)
250
251 zipSignalTagsAndValues DividerPorts{..} Microcode{..} =
252 [ (sel, Bool selSignal)
253 , (wr, Bool wrSignal)
254 , (oe, Bool oeSignal)
255 ]
256
257 usedPortTags DividerPorts{sel, wr, oe} = [sel, wr, oe]
258
259 takePortTags (sel : wr : oe : _) _ = DividerPorts sel wr oe
260 takePortTags _ _ = error "can not take port tags, tags are over"
261
262 instance Default (Microcode (Divider v x t)) where
263 def =
264 Microcode
265 { selSignal = False
266 , wrSignal = False
267 , oeSignal = False
268 }
269 instance UnambiguouslyDecode (Divider v x t) where
270 decodeInstruction (Load Numer) = def{wrSignal = True, selSignal = False}
271 decodeInstruction (Load Denom) = def{wrSignal = True, selSignal = True}
272 decodeInstruction Do = def{wrSignal = True, oeSignal = True}
273 decodeInstruction (Out Quotient) = def{oeSignal = True, selSignal = False}
274 decodeInstruction (Out Remain) = def{oeSignal = True, selSignal = True}
275
276 instance Connected (Divider v x t) where
277 data Ports (Divider v x t) = DividerPorts {sel, wr, oe :: SignalTag}
278 deriving (Show)
279
280 instance IOConnected (Divider v x t) where
281 data IOPorts (Divider v x t) = DividerIO
282 deriving (Show)
283
284 instance (Val x, Show t) => TargetSystemComponent (Divider v x t) where
285 moduleName _ _ = "pu_div"
286 software _ _ = Empty
287 hardware _tag Divider{mock} =
288 Aggregate
289 Nothing
290 [ if mock
291 then FromLibrary "div/div_mock.v"
292 else FromLibrary "div/div.v"
293 , FromLibrary "div/pu_div.v"
294 ]
295 hardwareInstance
296 tag
297 _pu@Divider{mock, pipeline}
298 UnitEnv
299 { sigClk
300 , sigRst
301 , valueIn = Just (dataIn, attrIn)
302 , valueOut = Just (dataOut, attrOut)
303 , ctrlPorts = Just DividerPorts{sel, wr, oe}
304 } =
305 [__i|
306 pu_div \#
307 ( .DATA_WIDTH( #{ dataWidth (def :: x) } )
308 , .ATTR_WIDTH( #{ attrWidth (def :: x) } )
309 , .INVALID( 0 )
310 , .PIPELINE( #{ pipeline } )
311 , .SCALING_FACTOR_POWER( #{ fractionalBitSize (def :: x) } )
312 , .MOCK_DIV( #{ bool2verilog mock } )
313 ) #{ tag }
314 ( .clk( #{ sigClk } )
315 , .rst( #{ sigRst } )
316 , .signal_sel( #{ sel } )
317 , .signal_wr( #{ wr } )
318 , .data_in( #{ dataIn } )
319 , .attr_in( #{ attrIn } )
320 , .signal_oe( #{ oe } )
321 , .data_out( #{ dataOut } )
322 , .attr_out( #{ attrOut } )
323 );
324 |]
325 hardwareInstance _title _pu _env = error "internal error"
326
327 instance IOTestBench (Divider v x t) v x
328
329 instance VarValTime v x t => Testable (Divider v x t) v x where
330 testBenchImplementation prj@Project{pName, pUnit} =
331 Immediate (toString $ moduleName pName pUnit <> "_tb.v") $
332 snippetTestBench
333 prj
334 SnippetTestBenchConf
335 { tbcSignals = ["sel", "wr", "oe"]
336 , tbcPorts =
337 DividerPorts
338 { sel = SignalTag "sel"
339 , wr = SignalTag "wr"
340 , oe = SignalTag "oe"
341 }
342 , tbcMC2verilogLiteral = \Microcode{selSignal, wrSignal, oeSignal} ->
343 [i|oe <= #{ bool2verilog oeSignal }; sel <= #{ bool2verilog selSignal }; wr <= #{ bool2verilog wrSignal }; |]
344 }