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 OptimizeLogicalUnitProblem (Divider v x t) v x
139 instance ResolveDeadlockProblem (Divider v x t) v x
140
141 function2WaitArguments f
142 | Just F.Division{F.denom = I denom, F.numer = I numer} <- castF f =
143 WaitArguments
144 { function = f
145 , arguments = [(Denom, denom), (Numer, numer)]
146 }
147 | otherwise = error $ "internal divider error: " <> show f
148
149 function2WaitResults readyAt f
150 | Just F.Division{F.quotient = O quotient, F.remain = O remain} <- castF f =
151 WaitResults
152 { function = f
153 , readyAt
154 , restrict = Nothing
155 , results = filterEmptyResults [(Quotient, quotient), (Remain, remain)]
156 }
157 | otherwise = error "internal error"
158
159 filterEmptyResults rs = filter (not . null . snd) rs
160
161 firstWaitResults jobs =
162 let jobs' = filter isWaitResults jobs
163 in if null jobs'
164 then Nothing
165 else Just $ minimumOn readyAt jobs'
166
167 instance VarValTime v x t => EndpointProblem (Divider v x t) v t where
168 endpointOptions pu@Divider{remains, jobs} =
169 let executeNewFunction
170 | any isWaitArguments jobs = []
171 | otherwise = concatMap (map target . S.elems . inputs) remains
172 waitingArguments =
173 maybe [] (map target . S.elems . variables) $ L.find isWaitArguments jobs
174 waitResults
175 | Just WaitResults{readyAt, results, restrict} <- firstWaitResults jobs =
176 let at = max readyAt (nextTick pu) ... fromMaybe maxBound restrict
177 in map (sources at . snd) results
178 | otherwise = []
179 in concat [executeNewFunction, waitingArguments, waitResults]
180 where
181 target v = EndpointSt (Target v) $ TimeConstraint (nextTick pu ... maxBound) (singleton 1)
182 sources at vs = EndpointSt (Source vs) $ TimeConstraint at (singleton 1)
183
184 endpointDecision pu@Divider{jobs, remains, pipeline} d@EndpointSt{epRole = Target v, epAt}
185 | ([f], remains') <- partition (S.member v . inputs) remains =
186 let pu' =
187 pu
188 { jobs = function2WaitArguments f : jobs
189 , remains = remains'
190 }
191 in endpointDecision pu' d
192 | ([WaitArguments{function, arguments}], jobs') <- partition (S.member v . variables) jobs =
193 let (tag, arguments') = case partition ((== v) . snd) arguments of
194 ([(tag', _v)], other) -> (tag', other)
195 _ -> error "Divider: endpointDecision: internal error"
196 nextTick' = sup epAt + 1
197 in case arguments' of
198 [] ->
199 let job' = function2WaitResults (nextTick' + pipeline + 1) function
200 restrictResults =
201 map
202 ( \case
203 wa@WaitResults{restrict = Nothing} -> wa{restrict = Just (nextTick' + pipeline)}
204 other -> other
205 )
206 in pu
207 { jobs = job' : restrictResults jobs'
208 , process_ = execSchedule pu $ do
209 scheduleEndpoint_ d $ scheduleInstructionUnsafe epAt $ Load tag
210 scheduleInstructionUnsafe_ (singleton nextTick') Do
211 }
212 _arguments' ->
213 pu
214 { jobs = WaitArguments{function, arguments = arguments'} : jobs'
215 , process_ = execSchedule pu $ do
216 scheduleEndpoint_ d $ scheduleInstructionUnsafe epAt $ Load tag
217 }
218 endpointDecision pu@Divider{jobs} d@EndpointSt{epRole = Source vs, epAt}
219 | ([job@WaitResults{results, function}], jobs') <- partition ((vs `S.isSubsetOf`) . variables) jobs =
220 let ((tag, allVs), results') = case partition ((vs `S.isSubsetOf`) . snd) results of
221 ([(tag_, allVs_)], other) -> ((tag_, allVs_), other)
222 _ -> error "Divider: endpointDecision: internal error"
223 allVs' = allVs S.\\ vs
224 results'' = filterEmptyResults $ (tag, allVs') : results'
225 jobs'' =
226 if null results''
227 then jobs'
228 else job{results = results''} : jobs'
229 in pu
230 { jobs = jobs''
231 , process_ = execSchedule pu $ do
232 scheduleEndpoint_ d $ scheduleInstructionUnsafe epAt $ Out tag
233 when (null jobs') $ do
234 scheduleFunctionFinish_ [] function $ 0 ... sup epAt
235 }
236 endpointDecision _pu d = error [i|incorrect decision #{ d } for Divider|]
237
238 instance Controllable (Divider v x t) where
239 data Instruction (Divider v x t)
240 = Load InputDesc
241 | Do
242 | Out OutputDesc
243 deriving (Show)
244
245 data Microcode (Divider v x t) = Microcode
246 { selSignal :: Bool
247 , wrSignal :: Bool
248 , oeSignal :: Bool
249 }
250 deriving (Show, Eq, Ord)
251
252 zipSignalTagsAndValues DividerPorts{..} Microcode{..} =
253 [ (sel, Bool selSignal)
254 , (wr, Bool wrSignal)
255 , (oe, Bool oeSignal)
256 ]
257
258 usedPortTags DividerPorts{sel, wr, oe} = [sel, wr, oe]
259
260 takePortTags (sel : wr : oe : _) _ = DividerPorts sel wr oe
261 takePortTags _ _ = error "can not take port tags, tags are over"
262
263 instance Default (Microcode (Divider v x t)) where
264 def =
265 Microcode
266 { selSignal = False
267 , wrSignal = False
268 , oeSignal = False
269 }
270 instance UnambiguouslyDecode (Divider v x t) where
271 decodeInstruction (Load Numer) = def{wrSignal = True, selSignal = False}
272 decodeInstruction (Load Denom) = def{wrSignal = True, selSignal = True}
273 decodeInstruction Do = def{wrSignal = True, oeSignal = True}
274 decodeInstruction (Out Quotient) = def{oeSignal = True, selSignal = False}
275 decodeInstruction (Out Remain) = def{oeSignal = True, selSignal = True}
276
277 instance Connected (Divider v x t) where
278 data Ports (Divider v x t) = DividerPorts {sel, wr, oe :: SignalTag}
279 deriving (Show)
280
281 instance IOConnected (Divider v x t) where
282 data IOPorts (Divider v x t) = DividerIO
283 deriving (Show)
284
285 instance (Val x, Show t) => TargetSystemComponent (Divider v x t) where
286 moduleName _ _ = "pu_div"
287 software _ _ = Empty
288 hardware _tag Divider{mock} =
289 Aggregate
290 Nothing
291 [ if mock
292 then FromLibrary "div/div_mock.v"
293 else FromLibrary "div/div.v"
294 , FromLibrary "div/pu_div.v"
295 ]
296 hardwareInstance
297 tag
298 _pu@Divider{mock, pipeline}
299 UnitEnv
300 { sigClk
301 , sigRst
302 , valueIn = Just (dataIn, attrIn)
303 , valueOut = Just (dataOut, attrOut)
304 , ctrlPorts = Just DividerPorts{sel, wr, oe}
305 } =
306 [__i|
307 pu_div \#
308 ( .DATA_WIDTH( #{ dataWidth (def :: x) } )
309 , .ATTR_WIDTH( #{ attrWidth (def :: x) } )
310 , .INVALID( 0 )
311 , .PIPELINE( #{ pipeline } )
312 , .SCALING_FACTOR_POWER( #{ fractionalBitSize (def :: x) } )
313 , .MOCK_DIV( #{ bool2verilog mock } )
314 ) #{ tag }
315 ( .clk( #{ sigClk } )
316 , .rst( #{ sigRst } )
317 , .signal_sel( #{ sel } )
318 , .signal_wr( #{ wr } )
319 , .data_in( #{ dataIn } )
320 , .attr_in( #{ attrIn } )
321 , .signal_oe( #{ oe } )
322 , .data_out( #{ dataOut } )
323 , .attr_out( #{ attrOut } )
324 );
325 |]
326 hardwareInstance _title _pu _env = error "internal error"
327
328 instance IOTestBench (Divider v x t) v x
329
330 instance VarValTime v x t => Testable (Divider v x t) v x where
331 testBenchImplementation prj@Project{pName, pUnit} =
332 Immediate (toString $ moduleName pName pUnit <> "_tb.v") $
333 snippetTestBench
334 prj
335 SnippetTestBenchConf
336 { tbcSignals = ["sel", "wr", "oe"]
337 , tbcPorts =
338 DividerPorts
339 { sel = SignalTag "sel"
340 , wr = SignalTag "wr"
341 , oe = SignalTag "oe"
342 }
343 , tbcMC2verilogLiteral = \Microcode{selSignal, wrSignal, oeSignal} ->
344 [i|oe <= #{ bool2verilog oeSignal }; sel <= #{ bool2verilog selSignal }; wr <= #{ bool2verilog wrSignal }; |]
345 }