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 ResolveDeadlockProblem (Fram v x t) v x
293
294 instance VarValTime v x t => EndpointProblem (Fram v x t) v t where
295 endpointOptions pu@Fram{remainBuffers, memory} =
296 let target v = EndpointSt (Target v) $ TimeConstraint (a ... maxBound) (1 ... maxBound)
297 where
298 a = nextTick pu `withShift` 1
299 source True vs = EndpointSt (Source $ S.fromList vs) $ TimeConstraint (1 + 1 + nextTick pu ... maxBound) (1 ... maxBound)
300 source False vs = EndpointSt (Source $ S.fromList vs) $ TimeConstraint (1 + nextTick pu ... maxBound) (1 ... maxBound)
301
302 fromRemain =
303 if any (\case ForBuffer{} -> True; NotUsed{} -> True; _ -> False) $ map state $ A.elems memory
304 then map ((\(Buffer (I v) (O _)) -> target v) . fst) remainBuffers
305 else []
306
307 foo Cell{state = NotUsed} = Nothing
308 foo Cell{state = Done} = Nothing
309 foo Cell{state = DoConstant vs} = Just $ source False vs
310 foo Cell{state = DoBuffer vs, lastWrite} = Just $ source (fromMaybe 0 lastWrite == nextTick pu - 1) vs
311 foo Cell{state = ForBuffer} = Nothing
312 foo Cell{state = NotBrokenLoop} = Nothing
313 foo Cell{state = DoLoopSource vs _, lastWrite} = Just $ source (fromMaybe 0 lastWrite == nextTick pu - 1) vs
314 foo Cell{state = DoLoopTarget v} = Just $ target v
315
316 fromCells = mapMaybe foo $ A.elems memory
317 in fromRemain ++ fromCells
318
319 -- Constant
320 endpointDecision fram@Fram{memory} d@EndpointSt{epRole = Source vs, epAt}
321 | Just (addr, cell@Cell{state = DoConstant vs', job = Just Job{function, binds}}) <-
322 L.find
323 ( \case
324 (_, Cell{state = DoConstant vs'}) -> (vs' L.\\ S.elems vs) /= vs'
325 _ -> False
326 )
327 $ A.assocs memory =
328 let vsRemain = vs' L.\\ S.elems vs
329 process_' = execSchedule fram $ do
330 void $ scheduleEndpoint d $ scheduleInstructionUnsafe (shiftI (-1) epAt) $ PrepareRead addr
331 when (null vsRemain) $
332 scheduleFunctionFinish_ binds function $
333 0 ... sup epAt
334 cell' = case vsRemain of
335 [] ->
336 cell
337 { job = Nothing
338 , state = Done
339 }
340 _ ->
341 cell
342 { state = DoConstant vsRemain
343 }
344 in fram
345 { memory = memory A.// [(addr, cell')]
346 , process_ = process_'
347 }
348 -- Loop
349 endpointDecision fram@Fram{memory} d@EndpointSt{epRole = Source vs, epAt}
350 | Just (addr, cell@Cell{state = DoLoopSource vs' oJob, job = Just job@Job{binds, function, startAt}}) <-
351 L.find
352 ( \case
353 (_, Cell{state = DoLoopSource vs' _}) -> (vs' L.\\ S.elems vs) /= vs'
354 _ -> False
355 )
356 $ A.assocs memory =
357 let vsRemain = vs' L.\\ S.elems vs
358 process_ = execSchedule fram $ do
359 eps <- scheduleEndpoint d $ scheduleInstructionUnsafe (shiftI (-1) epAt) $ PrepareRead addr
360 when (null vsRemain) $
361 scheduleFunctionFinish_ binds function $
362 0 ... sup epAt
363 return eps
364 cell' =
365 if not $ null vsRemain
366 then
367 cell
368 { job = Just job{startAt = startAt <|> Just (inf epAt - 1)}
369 , state = DoLoopSource vsRemain oJob
370 }
371 else
372 cell
373 { job = Just oJob{startAt = startAt <|> Just (inf epAt - 1)}
374 , state = DoLoopTarget $ oJobV oJob
375 }
376 in fram{process_, memory = memory A.// [(addr, cell')]}
377 endpointDecision fram@Fram{memory} d@EndpointSt{epRole = Target v, epAt}
378 | Just (addr, cell@Cell{job = Just Job{function, binds}}) <-
379 L.find (\case (_, Cell{state = DoLoopTarget v'}) -> v == v'; _ -> False) $ A.assocs memory =
380 let process_ = execSchedule fram $ do
381 void $ scheduleEndpoint d $ scheduleInstructionUnsafe epAt $ Write addr
382 scheduleFunctionFinish binds function epAt
383 cell' =
384 cell
385 { job = Nothing
386 , state = Done
387 }
388 in fram
389 { memory = memory A.// [(addr, cell')]
390 , process_
391 }
392 -- Buffer Target
393 endpointDecision fram@Fram{memory, remainBuffers} d@EndpointSt{epRole = Target v, epAt}
394 | Just (addr, cell@Cell{history}) <- findForBufferCell fram
395 , ([(Buffer (I _) (O vs), j@Job{function})], remainBuffers') <- L.partition (\(Buffer (I v') (O _), _) -> v' == v) remainBuffers =
396 let process_ = execSchedule fram $ do
397 scheduleEndpoint d $ scheduleInstructionUnsafe epAt $ Write addr
398 cell' =
399 cell
400 { job = Just j{startAt = Just $ inf epAt}
401 , state = DoBuffer $ S.elems vs
402 , lastWrite = Just $ sup epAt
403 , history = function : history
404 }
405 in fram
406 { memory = memory A.// [(addr, cell')]
407 , remainBuffers = remainBuffers'
408 , process_
409 }
410 endpointDecision fram@Fram{memory} d@EndpointSt{epRole = Source vs, epAt}
411 | Just (addr, cell@Cell{state = DoBuffer vs', job = Just Job{function, startAt = Just fBegin, binds}}) <-
412 L.find
413 ( \case
414 (_, Cell{state = DoBuffer vs'}) -> (vs' L.\\ S.elems vs) /= vs'
415 _ -> False
416 )
417 $ A.assocs memory =
418 let vsRemain = vs' L.\\ S.elems vs
419 process_ = execSchedule fram $ do
420 void $ scheduleEndpoint d $ scheduleInstructionUnsafe (shiftI (-1) epAt) $ PrepareRead addr
421 when (null vsRemain) $
422 scheduleFunctionFinish_ binds function $
423 fBegin ... sup epAt
424 cell' = case vsRemain of
425 [] ->
426 cell
427 { job = Nothing
428 , state = ForBuffer
429 }
430 _ ->
431 cell
432 { state = DoBuffer vsRemain
433 }
434 in fram
435 { memory = memory A.// [(addr, cell')]
436 , process_
437 }
438 endpointDecision pu d = error [i|incorrect decision #{ d } for #{ pretty pu }|]
439
440 ---------------------------------------------------------------------
441
442 instance Controllable (Fram v x t) where
443 data Instruction (Fram v x t)
444 = PrepareRead Int
445 | Write Int
446 deriving (Show)
447
448 data Microcode (Fram v x t) = Microcode
449 { oeSignal :: Bool
450 , wrSignal :: Bool
451 , addrSignal :: Maybe Int
452 }
453 deriving (Show, Eq, Ord)
454
455 zipSignalTagsAndValues FramPorts{oe, wr, addr} Microcode{oeSignal, wrSignal, addrSignal} =
456 [ (oe, Bool oeSignal)
457 , (wr, Bool wrSignal)
458 ]
459 ++ addrs
460 where
461 addrs =
462 map
463 ( \(linkId, ix) ->
464 ( linkId
465 , maybe Undef (Bool . (`testBit` ix)) addrSignal
466 )
467 )
468 $ zip (reverse addr) [0 ..]
469
470 usedPortTags FramPorts{oe, wr, addr} = oe : wr : addr
471
472 takePortTags (oe : wr : xs) pu = FramPorts oe wr addr
473 where
474 addr = take (addrWidth pu) xs
475 takePortTags _ _ = error "can not take port tags, tags are over"
476
477 instance Connected (Fram v x t) where
478 data Ports (Fram v x t) = FramPorts
479 { oe, wr :: SignalTag
480 , addr :: [SignalTag]
481 }
482 deriving (Show)
483
484 instance IOConnected (Fram v x t) where
485 data IOPorts (Fram v x t) = FramIO
486 deriving (Show)
487
488 instance Default (Microcode (Fram v x t)) where
489 def = Microcode False False Nothing
490
491 instance UnambiguouslyDecode (Fram v x t) where
492 decodeInstruction (PrepareRead addr) = Microcode True False $ Just addr
493 decodeInstruction (Write addr) = Microcode False True $ Just addr
494
495 instance VarValTime v x t => Testable (Fram v x t) v x where
496 testBenchImplementation prj@Project{pName, pUnit} =
497 let tbcSignalsConst = ["oe", "wr", "[3:0] addr"]
498 showMicrocode Microcode{oeSignal, wrSignal, addrSignal} =
499 [i|oe <= #{ bool2verilog oeSignal };|]
500 <> [i| wr <= #{ bool2verilog wrSignal };|]
501 <> [i| addr <= #{ maybe "0" show addrSignal };|]
502 in Immediate (toString $ moduleName pName pUnit <> "_tb.v") $
503 snippetTestBench
504 prj
505 SnippetTestBenchConf
506 { tbcSignals = tbcSignalsConst
507 , tbcPorts =
508 FramPorts
509 { oe = SignalTag "oe"
510 , wr = SignalTag "wr"
511 , addr = map SignalTag ["addr[3]", "addr[2]", "addr[1]", "addr[0]"]
512 }
513 , tbcMC2verilogLiteral = showMicrocode
514 }
515
516 softwareFile tag pu = moduleName tag pu <> "." <> tag <> ".dump"
517
518 instance VarValTime v x t => TargetSystemComponent (Fram v x t) where
519 moduleName _ _ = "pu_fram"
520 hardware _tag _pu = FromLibrary "pu_fram.v"
521 software tag fram@Fram{memory} =
522 Immediate
523 (toString $ softwareFile tag fram)
524 $ T.unlines
525 $ map
526 (\Cell{initialValue = initialValue} -> hdlValDump initialValue)
527 $ A.elems memory
528 hardwareInstance
529 tag
530 fram@Fram{memory}
531 UnitEnv
532 { sigClk
533 , ctrlPorts = Just FramPorts{..}
534 , valueIn = Just (dataIn, attrIn)
535 , valueOut = Just (dataOut, attrOut)
536 } =
537 [__i|
538 pu_fram \#
539 ( .DATA_WIDTH( #{ dataWidth (def :: x) } )
540 , .ATTR_WIDTH( #{ attrWidth (def :: x) } )
541 , .RAM_SIZE( #{ numElements memory } )
542 , .FRAM_DUMP( "{{ impl.paths.nest }}/#{ softwareFile tag fram }" )
543 ) #{ tag }
544 ( .clk( #{ sigClk } )
545 , .signal_addr( { #{ T.intercalate ", " $ map showText addr } } )
546 , .signal_wr( #{ wr } )
547 , .data_in( #{ dataIn } )
548 , .attr_in( #{ attrIn } )
549 , .signal_oe( #{ oe } )
550 , .data_out( #{ dataOut } )
551 , .attr_out( #{ attrOut } )
552 );
553 |]
554 hardwareInstance _title _pu _env = error "internal error"
555
556 instance IOTestBench (Fram v x t) v x