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.Fram
9 Description : Buffers inside and across computational cycles
10 Copyright : (c) Aleksandr Penskoi, 2019
11 License : BSD3
12 Maintainer : aleksandr.penskoi@gmail.com
13 Stability : experimental
14 -}
15 module NITTA.Model.ProcessorUnits.Fram (
16 Fram (..),
17 Ports (..),
18 IOPorts (..),
19 framWithSize,
20 ) where
21
22 import Control.Applicative ((<|>))
23 import Control.Monad
24 import Data.Array qualified as A
25 import Data.Array.Base (numElements)
26 import Data.Bits (testBit)
27 import Data.Default
28 import Data.List qualified as L
29 import Data.Maybe
30 import Data.Set qualified as S
31 import Data.String.Interpolate
32 import Data.String.ToString
33 import Data.Text qualified as T
34 import NITTA.Intermediate.Functions
35 import NITTA.Intermediate.Types
36 import NITTA.Model.Problems
37 import NITTA.Model.ProcessorUnits.Types
38 import NITTA.Model.Time
39 import NITTA.Project
40 import NITTA.Utils
41 import NITTA.Utils.ProcessDescription
42 import Numeric.Interval.NonEmpty (inf, singleton, sup, (...))
43 import Prettyprinter
44
45 data Fram v x t = Fram
46 { memory :: A.Array Int (Cell v x t)
47 -- ^ memory cell array
48 , remainBuffers :: [(Buffer v x, Job v x t)]
49 -- ^ register queue
50 , process_ :: Process t (StepInfo v x t)
51 }
52
53 framWithSize size =
54 Fram
55 { memory = A.listArray (0, size - 1) $ repeat def
56 , remainBuffers = []
57 , process_ = def
58 }
59
60 instance VarValTime v x t => Pretty (Fram v x t) where
61 pretty Fram{memory} =
62 [__i|
63 Fram:
64 cells:
65 #{ nest 8 $ vsep $ map (\(ix, c) -> viaShow ix <> ": " <> pretty (state c)) $ A.assocs memory }
66 |]
67
68 instance (Default t, Default x) => Default (Fram v x t) where
69 def =
70 Fram
71 { memory = A.listArray (0, defaultSize - 1) $ repeat def
72 , remainBuffers = []
73 , process_ = def
74 }
75 where
76 defaultSize = 16
77
78 instance Default x => DefaultX (Fram v x t) x
79
80 instance VarValTime v x t => WithFunctions (Fram v x t) (F v x) where
81 functions Fram{remainBuffers, memory} =
82 map (packF . fst) remainBuffers ++ concatMap functions (A.elems memory)
83
84 instance VarValTime v x t => Variables (Fram v x t) v where
85 variables fram = S.unions $ map variables $ functions fram
86
87 -- | Memory cell
88 data Cell v x t = Cell
89 { state :: CellState v x t
90 , lastWrite :: Maybe t
91 , job :: Maybe (Job v x t)
92 -- ^ current job description
93 , history :: [F v x]
94 , initialValue :: x
95 }
96
97 data Job v x t = Job
98 { function :: F v x
99 , startAt :: Maybe t
100 , binds :: [ProcessStepID]
101 }
102 deriving (Show, Eq)
103
104 defJob f =
105 Job
106 { function = f
107 , startAt = Nothing
108 , binds = []
109 }
110
111 instance WithFunctions (Cell v x t) (F v x) where
112 functions Cell{history, job = Just Job{function}} = function : history
113 functions Cell{history} = history
114
115 instance Default x => Default (Cell v x t) where
116 def =
117 Cell
118 { state = NotUsed
119 , lastWrite = Nothing
120 , job = Nothing
121 , history = []
122 , initialValue = def
123 }
124
125 {- | Memory cell states. Add Loop&Buffer for optimisation.
126 @
127 bind source
128 NotUsed ----------> DoConstant ------------+----> Done
129 | ^ |
130 | | |
131 | \----------------/
132 |
133 | bind
134 +-------------------> ForBuffer <----------\
135 | | |
136 | | |
137 | target | |
138 | | /----------+
139 | | | |
140 | target v v source |
141 +-------------------> DoBuffer ------------/
142 |
143 | refactor source target
144 \-- NotBrokenLoop --> DoLoopSource ----------+---> DoLoopTarget --------> Done
145 ^ |
146 | |
147 \------------------/
148 @
149 -}
150 data CellState v x t
151 = NotUsed
152 | Done
153 | DoConstant [v]
154 | DoBuffer [v]
155 | ForBuffer
156 | NotBrokenLoop
157 | DoLoopSource [v] (Job v x t)
158 | DoLoopTarget v
159 deriving (Eq)
160
161 instance VarValTime v x t => Pretty (CellState v x t) where
162 pretty NotUsed = "NotUsed"
163 pretty Done = "Done"
164 pretty (DoConstant vs) = "DoConstant " <> viaShow (map toString vs)
165 pretty (DoBuffer vs) = "DoBuffer " <> viaShow (map toString vs)
166 pretty ForBuffer = "ForBuffer"
167 pretty NotBrokenLoop = "NotBrokenLoop"
168 pretty (DoLoopSource vs _job) = "DoLoopSource " <> viaShow (map toString vs)
169 pretty (DoLoopTarget v) = "DoLoopTarget " <> viaShow (toString v)
170
171 isFree Cell{state = NotUsed} = True
172 isFree _ = False
173
174 isForBuffer Cell{state = ForBuffer} = True
175 isForBuffer _ = False
176
177 lockableNotUsedCell Fram{memory, remainBuffers} =
178 let free = filter (isFree . snd) $ A.assocs memory
179 n = length free
180 in if null remainBuffers && n >= 1 || not (null remainBuffers) && n >= 2
181 then Just $ head free
182 else Nothing
183
184 findForBufferCell Fram{memory} =
185 case L.find (isForBuffer . snd) $ A.assocs memory of
186 x@(Just _) -> x
187 Nothing -> L.find (isFree . snd) $ A.assocs memory
188
189 oJobV Job{function}
190 | Just (LoopEnd _ (I v)) <- castF function = v
191 | otherwise = undefined
192
193 -- | Function for calculating width of array in Fram
194 addrWidth Fram{memory} = log2 $ numElements memory
195 where
196 log2 = ceiling . (logBase 2 :: Double -> Double) . fromIntegral
197
198 instance VarValTime v x t => ProcessorUnit (Fram v x t) v x t where
199 tryBind f fram
200 | not $ null (variables f `S.intersection` variables fram) =
201 Left "can not bind (self transaction)"
202 tryBind f fram@Fram{memory, remainBuffers}
203 | Just (Constant (X x) (O vs)) <- castF f
204 , Just (addr, _) <- lockableNotUsedCell fram =
205 let (binds, process_) = runSchedule fram $ scheduleFunctionBind f
206 cell =
207 Cell
208 { state = DoConstant $ S.elems vs
209 , job = Just (defJob f){binds}
210 , history = [f]
211 , lastWrite = Nothing
212 , initialValue = x
213 }
214 in Right
215 fram
216 { memory = memory A.// [(addr, cell)]
217 , process_
218 }
219 | Just (Loop (X x) (O _) (I _)) <- castF f
220 , Just (addr, _) <- lockableNotUsedCell fram =
221 let (binds, process_) = runSchedule fram $ scheduleFunctionBind f
222 cell =
223 Cell
224 { state = NotBrokenLoop
225 , job = Just (defJob f){binds}
226 , history = [f]
227 , lastWrite = Nothing
228 , initialValue = x
229 }
230 in Right
231 fram
232 { memory = memory A.// [(addr, cell)]
233 , process_
234 }
235 | Just r@Buffer{} <- castF f
236 , any (\case ForBuffer{} -> True; DoBuffer{} -> True; NotUsed{} -> True; _ -> False) $ map state $ A.elems memory =
237 let (binds, process_) = runSchedule fram $ scheduleFunctionBind f
238 job = (defJob f){binds}
239 in Right
240 fram
241 { remainBuffers = (r, job) : remainBuffers
242 , process_
243 }
244 | otherwise = Left $ "unsupport or cells over: " ++ show f
245
246 process Fram{process_} = process_
247 parallelismType _ = Full
248
249 instance Var v => Locks (Fram v x t) v where
250 -- FIXME:
251 locks _ = []
252
253 instance VarValTime v x t => BreakLoopProblem (Fram v x t) v x where
254 breakLoopOptions Fram{memory} =
255 [ BreakLoop x o i_
256 | (_, Cell{state = NotBrokenLoop, job = Just Job{function}}) <- A.assocs memory
257 , let (Loop (X x) (O o) (I i_)) = fromJust $ castF function
258 ]
259 breakLoopDecision fram@Fram{memory} bl@BreakLoop{loopO} =
260 let (addr, cell@Cell{history, job}) =
261 fromJust
262 $ L.find
263 ( \case
264 (_, Cell{job = Just Job{function}}) -> function == recLoop bl
265 _ -> False
266 )
267 $ A.assocs memory
268 Job{binds} = fromJust job
269 ((iPid, oPid), process_) = runSchedule fram $ do
270 revoke <- scheduleFunctionRevoke $ recLoop bl
271 f1 <- scheduleFunctionBind $ recLoopOut bl
272 f2 <- scheduleFunctionBind $ recLoopIn bl
273 ref <- scheduleRefactoring (singleton $ nextTick fram) bl
274 establishVerticalRelations ref (f1 ++ f2 ++ revoke)
275 establishVerticalRelations binds ref
276 return (f1, f2)
277 iJob = (defJob $ recLoopOut bl){binds = iPid, startAt = Just 0}
278 oJob = (defJob $ recLoopIn bl){binds = oPid}
279 cell' =
280 cell
281 { job = Just iJob
282 , history = [recLoopOut bl, recLoopIn bl] ++ history
283 , state = DoLoopSource (S.elems loopO) oJob
284 }
285 in fram
286 { memory = memory A.// [(addr, cell')]
287 , process_
288 }
289
290 instance ConstantFoldingProblem (Fram v x t) v x
291 instance OptimizeAccumProblem (Fram v x t) v x
292 instance OptimizeLogicalUnitProblem (Fram v x t) v x
293 instance ResolveDeadlockProblem (Fram v x t) v x
294
295 instance VarValTime v x t => EndpointProblem (Fram v x t) v t where
296 endpointOptions pu@Fram{remainBuffers, memory} =
297 let target v = EndpointSt (Target v) $ TimeConstraint (a ... maxBound) (1 ... maxBound)
298 where
299 a = nextTick pu `withShift` 1
300 source True vs = EndpointSt (Source $ S.fromList vs) $ TimeConstraint (1 + 1 + nextTick pu ... maxBound) (1 ... maxBound)
301 source False vs = EndpointSt (Source $ S.fromList vs) $ TimeConstraint (1 + nextTick pu ... maxBound) (1 ... maxBound)
302
303 fromRemain =
304 if any (\case ForBuffer{} -> True; NotUsed{} -> True; _ -> False) $ map state $ A.elems memory
305 then map ((\(Buffer (I v) (O _)) -> target v) . fst) remainBuffers
306 else []
307
308 foo Cell{state = NotUsed} = Nothing
309 foo Cell{state = Done} = Nothing
310 foo Cell{state = DoConstant vs} = Just $ source False vs
311 foo Cell{state = DoBuffer vs, lastWrite} = Just $ source (fromMaybe 0 lastWrite == nextTick pu - 1) vs
312 foo Cell{state = ForBuffer} = Nothing
313 foo Cell{state = NotBrokenLoop} = Nothing
314 foo Cell{state = DoLoopSource vs _, lastWrite} = Just $ source (fromMaybe 0 lastWrite == nextTick pu - 1) vs
315 foo Cell{state = DoLoopTarget v} = Just $ target v
316
317 fromCells = mapMaybe foo $ A.elems memory
318 in fromRemain ++ fromCells
319
320 -- Constant
321 endpointDecision fram@Fram{memory} d@EndpointSt{epRole = Source vs, epAt}
322 | Just (addr, cell@Cell{state = DoConstant vs', job = Just Job{function, binds}}) <-
323 L.find
324 ( \case
325 (_, Cell{state = DoConstant vs'}) -> (vs' L.\\ S.elems vs) /= vs'
326 _ -> False
327 )
328 $ A.assocs memory =
329 let vsRemain = vs' L.\\ S.elems vs
330 process_' = execSchedule fram $ do
331 void $ scheduleEndpoint d $ scheduleInstructionUnsafe (shiftI (-1) epAt) $ PrepareRead addr
332 when (null vsRemain) $
333 scheduleFunctionFinish_ binds function $
334 0 ... sup epAt
335 cell' = case vsRemain of
336 [] ->
337 cell
338 { job = Nothing
339 , state = Done
340 }
341 _ ->
342 cell
343 { state = DoConstant vsRemain
344 }
345 in fram
346 { memory = memory A.// [(addr, cell')]
347 , process_ = process_'
348 }
349 -- Loop
350 endpointDecision fram@Fram{memory} d@EndpointSt{epRole = Source vs, epAt}
351 | Just (addr, cell@Cell{state = DoLoopSource vs' oJob, job = Just job@Job{binds, function, startAt}}) <-
352 L.find
353 ( \case
354 (_, Cell{state = DoLoopSource vs' _}) -> (vs' L.\\ S.elems vs) /= vs'
355 _ -> False
356 )
357 $ A.assocs memory =
358 let vsRemain = vs' L.\\ S.elems vs
359 process_ = execSchedule fram $ do
360 eps <- scheduleEndpoint d $ scheduleInstructionUnsafe (shiftI (-1) epAt) $ PrepareRead addr
361 when (null vsRemain) $
362 scheduleFunctionFinish_ binds function $
363 0 ... sup epAt
364 return eps
365 cell' =
366 if not $ null vsRemain
367 then
368 cell
369 { job = Just job{startAt = startAt <|> Just (inf epAt - 1)}
370 , state = DoLoopSource vsRemain oJob
371 }
372 else
373 cell
374 { job = Just oJob{startAt = startAt <|> Just (inf epAt - 1)}
375 , state = DoLoopTarget $ oJobV oJob
376 }
377 in fram{process_, memory = memory A.// [(addr, cell')]}
378 endpointDecision fram@Fram{memory} d@EndpointSt{epRole = Target v, epAt}
379 | Just (addr, cell@Cell{job = Just Job{function, binds}}) <-
380 L.find (\case (_, Cell{state = DoLoopTarget v'}) -> v == v'; _ -> False) $ A.assocs memory =
381 let process_ = execSchedule fram $ do
382 void $ scheduleEndpoint d $ scheduleInstructionUnsafe epAt $ Write addr
383 scheduleFunctionFinish binds function epAt
384 cell' =
385 cell
386 { job = Nothing
387 , state = Done
388 }
389 in fram
390 { memory = memory A.// [(addr, cell')]
391 , process_
392 }
393 -- Buffer Target
394 endpointDecision fram@Fram{memory, remainBuffers} d@EndpointSt{epRole = Target v, epAt}
395 | Just (addr, cell@Cell{history}) <- findForBufferCell fram
396 , ([(Buffer (I _) (O vs), j@Job{function})], remainBuffers') <- L.partition (\(Buffer (I v') (O _), _) -> v' == v) remainBuffers =
397 let process_ = execSchedule fram $ do
398 scheduleEndpoint d $ scheduleInstructionUnsafe epAt $ Write addr
399 cell' =
400 cell
401 { job = Just j{startAt = Just $ inf epAt}
402 , state = DoBuffer $ S.elems vs
403 , lastWrite = Just $ sup epAt
404 , history = function : history
405 }
406 in fram
407 { memory = memory A.// [(addr, cell')]
408 , remainBuffers = remainBuffers'
409 , process_
410 }
411 endpointDecision fram@Fram{memory} d@EndpointSt{epRole = Source vs, epAt}
412 | Just (addr, cell@Cell{state = DoBuffer vs', job = Just Job{function, startAt = Just fBegin, binds}}) <-
413 L.find
414 ( \case
415 (_, Cell{state = DoBuffer vs'}) -> (vs' L.\\ S.elems vs) /= vs'
416 _ -> False
417 )
418 $ A.assocs memory =
419 let vsRemain = vs' L.\\ S.elems vs
420 process_ = execSchedule fram $ do
421 void $ scheduleEndpoint d $ scheduleInstructionUnsafe (shiftI (-1) epAt) $ PrepareRead addr
422 when (null vsRemain) $
423 scheduleFunctionFinish_ binds function $
424 fBegin ... sup epAt
425 cell' = case vsRemain of
426 [] ->
427 cell
428 { job = Nothing
429 , state = ForBuffer
430 }
431 _ ->
432 cell
433 { state = DoBuffer vsRemain
434 }
435 in fram
436 { memory = memory A.// [(addr, cell')]
437 , process_
438 }
439 endpointDecision pu d = error [i|incorrect decision #{ d } for #{ pretty pu }|]
440
441 ---------------------------------------------------------------------
442
443 instance Controllable (Fram v x t) where
444 data Instruction (Fram v x t)
445 = PrepareRead Int
446 | Write Int
447 deriving (Show)
448
449 data Microcode (Fram v x t) = Microcode
450 { oeSignal :: Bool
451 , wrSignal :: Bool
452 , addrSignal :: Maybe Int
453 }
454 deriving (Show, Eq, Ord)
455
456 zipSignalTagsAndValues FramPorts{oe, wr, addr} Microcode{oeSignal, wrSignal, addrSignal} =
457 [ (oe, Bool oeSignal)
458 , (wr, Bool wrSignal)
459 ]
460 ++ addrs
461 where
462 addrs =
463 map
464 ( \(linkId, ix) ->
465 ( linkId
466 , maybe Undef (Bool . (`testBit` ix)) addrSignal
467 )
468 )
469 $ zip (reverse addr) [0 ..]
470
471 usedPortTags FramPorts{oe, wr, addr} = oe : wr : addr
472
473 takePortTags (oe : wr : xs) pu = FramPorts oe wr addr
474 where
475 addr = take (addrWidth pu) xs
476 takePortTags _ _ = error "can not take port tags, tags are over"
477
478 instance Connected (Fram v x t) where
479 data Ports (Fram v x t) = FramPorts
480 { oe, wr :: SignalTag
481 , addr :: [SignalTag]
482 }
483 deriving (Show)
484
485 instance IOConnected (Fram v x t) where
486 data IOPorts (Fram v x t) = FramIO
487 deriving (Show)
488
489 instance Default (Microcode (Fram v x t)) where
490 def = Microcode False False Nothing
491
492 instance UnambiguouslyDecode (Fram v x t) where
493 decodeInstruction (PrepareRead addr) = Microcode True False $ Just addr
494 decodeInstruction (Write addr) = Microcode False True $ Just addr
495
496 instance VarValTime v x t => Testable (Fram v x t) v x where
497 testBenchImplementation prj@Project{pName, pUnit} =
498 let tbcSignalsConst = ["oe", "wr", "[3:0] addr"]
499 showMicrocode Microcode{oeSignal, wrSignal, addrSignal} =
500 [i|oe <= #{ bool2verilog oeSignal };|]
501 <> [i| wr <= #{ bool2verilog wrSignal };|]
502 <> [i| addr <= #{ maybe "0" show addrSignal };|]
503 in Immediate (toString $ moduleName pName pUnit <> "_tb.v") $
504 snippetTestBench
505 prj
506 SnippetTestBenchConf
507 { tbcSignals = tbcSignalsConst
508 , tbcPorts =
509 FramPorts
510 { oe = SignalTag "oe"
511 , wr = SignalTag "wr"
512 , addr = map SignalTag ["addr[3]", "addr[2]", "addr[1]", "addr[0]"]
513 }
514 , tbcMC2verilogLiteral = showMicrocode
515 }
516
517 softwareFile tag pu = moduleName tag pu <> "." <> tag <> ".dump"
518
519 instance VarValTime v x t => TargetSystemComponent (Fram v x t) where
520 moduleName _ _ = "pu_fram"
521 hardware _tag _pu = FromLibrary "pu_fram.v"
522 software tag fram@Fram{memory} =
523 Immediate
524 (toString $ softwareFile tag fram)
525 $ T.unlines
526 $ map
527 (\Cell{initialValue = initialValue} -> hdlValDump initialValue)
528 $ A.elems memory
529 hardwareInstance
530 tag
531 fram@Fram{memory}
532 UnitEnv
533 { sigClk
534 , ctrlPorts = Just FramPorts{..}
535 , valueIn = Just (dataIn, attrIn)
536 , valueOut = Just (dataOut, attrOut)
537 } =
538 [__i|
539 pu_fram \#
540 ( .DATA_WIDTH( #{ dataWidth (def :: x) } )
541 , .ATTR_WIDTH( #{ attrWidth (def :: x) } )
542 , .RAM_SIZE( #{ numElements memory } )
543 , .FRAM_DUMP( "{{ impl.paths.nest }}/#{ softwareFile tag fram }" )
544 ) #{ tag }
545 ( .clk( #{ sigClk } )
546 , .signal_addr( { #{ T.intercalate ", " $ map showText addr } } )
547 , .signal_wr( #{ wr } )
548 , .data_in( #{ dataIn } )
549 , .attr_in( #{ attrIn } )
550 , .signal_oe( #{ oe } )
551 , .data_out( #{ dataOut } )
552 , .attr_out( #{ attrOut } )
553 );
554 |]
555 hardwareInstance _title _pu _env = error "internal error"
556
557 instance IOTestBench (Fram v x t) v x