never executed always true always false

    1 {-# LANGUAGE AllowAmbiguousTypes #-}
    2 {-# LANGUAGE DuplicateRecordFields #-}
    3 {-# LANGUAGE InstanceSigs #-}
    4 {-# LANGUAGE OverloadedStrings #-}
    5 {-# LANGUAGE QuasiQuotes #-}
    6 {-# LANGUAGE RecordWildCards #-}
    7 {-# LANGUAGE TypeFamilies #-}
    8 
    9 {- |
   10 Module      : NITTA.Model.ProcessorUnits.Accum
   11 Description : Accumulator processor unit implementation
   12 Copyright   : (c) Aleksandr Penskoi, 2019
   13 License     : BSD3
   14 Maintainer  : aleksandr.penskoi@gmail.com
   15 Stability   : experimental
   16 -}
   17 module NITTA.Model.ProcessorUnits.Accum (
   18     Accum,
   19     Ports (..),
   20     IOPorts (..),
   21 ) where
   22 
   23 import Control.Monad (when)
   24 import Data.Bifunctor
   25 import Data.Default
   26 import Data.List qualified as L
   27 import Data.Maybe (fromMaybe)
   28 import Data.Set qualified as S
   29 import Data.String.Interpolate
   30 import Data.String.ToString
   31 import Data.Text qualified as T
   32 import NITTA.Intermediate.Functions qualified as F
   33 import NITTA.Intermediate.Types
   34 import NITTA.Model.Problems
   35 import NITTA.Model.ProcessorUnits.Types
   36 import NITTA.Model.Time
   37 import NITTA.Project
   38 import NITTA.Utils
   39 import NITTA.Utils.ProcessDescription
   40 import Numeric.Interval.NonEmpty (inf, singleton, sup, (...))
   41 import Prettyprinter
   42 
   43 {- | Type that contains expression:
   44 
   45 @a + b = c@ is exression and it equals:
   46     @[[(False, "a"), (False, "b")], [(False, "c")]]@
   47 
   48 @a + b = c; d - e = f@ is one expression too and it equals:
   49     @[[(False, "a"), (False, "b")], [(False, "c")], [(False, "d"), (True, "d")], [(False, "f")]]@
   50 -}
   51 data Job v x = Job
   52     { tasks :: [[(Bool, v)]]
   53     -- ^ Contains future parts expression to eval (c + d = e)
   54     , func :: F v x
   55     -- ^ Func of this expression
   56     , state :: JobState
   57     }
   58 
   59 data JobState
   60     = Initialize
   61     | WaitArguments
   62     | Calculate
   63     | WaitResults
   64     | ArgumentAfterResult
   65     deriving (Show)
   66 
   67 taskVars lst = S.fromList $ map snd lst
   68 
   69 instance Var v => Show (Job v x) where
   70     show Job{tasks, func, state} =
   71         [i|Job{tasks=#{ show' tasks }, func=#{ func }, state=#{ state }}|]
   72         where
   73             show' = map (map (second toString))
   74 
   75 data Accum v x t = Accum
   76     { remainJobs :: [Job v x]
   77     -- ^ List of jobs (expressions)
   78     , currentJob :: Maybe (Job v x)
   79     -- ^ Current job
   80     , process_ :: Process t (StepInfo v x t)
   81     -- ^ Process
   82     }
   83 
   84 instance VarValTime v x t => Pretty (Accum v x t) where
   85     pretty a =
   86         [__i|
   87             Accum:
   88                 remainJobs: #{ remainJobs a }
   89                 currentJob: #{ currentJob a }
   90                 #{ indent 4 $ pretty $ process_ a }
   91             |]
   92 
   93 instance VarValTime v x t => Show (Accum v x t) where
   94     show = show . pretty
   95 
   96 instance VarValTime v x t => Default (Accum v x t) where
   97     def =
   98         Accum
   99             { remainJobs = []
  100             , currentJob = Nothing
  101             , process_ = def
  102             }
  103 
  104 instance Default x => DefaultX (Accum v x t) x
  105 
  106 registerAcc f@F.Acc{actions} pu@Accum{remainJobs} =
  107     pu
  108         { remainJobs =
  109             Job
  110                 { tasks = concat $ actionGroups actions
  111                 , func = packF f
  112                 , state = Initialize
  113                 }
  114                 : remainJobs
  115         }
  116 
  117 actionGroups [] = []
  118 actionGroups as =
  119     let (pushs, as') = span F.isPush as
  120         (pulls, as'') = span F.isPull as'
  121      in [ map
  122             ( \case
  123                 (F.Push sign (I v)) -> (sign == F.Minus, v)
  124                 _ -> error "actionGroups: internal error"
  125             )
  126             pushs
  127         , concatMap
  128             ( \case
  129                 (F.Pull (O vs)) -> map (True,) $ S.elems vs
  130                 _ -> error "actionGroups: internal error"
  131             )
  132             pulls
  133         ]
  134             : actionGroups as''
  135 
  136 targetTask tasks
  137     | even $ length tasks = Just $ head tasks
  138     | otherwise = Nothing
  139 
  140 sourceTask tasks
  141     | odd $ length tasks = Just $ head tasks
  142     | otherwise = Nothing
  143 
  144 instance VarValTime v x t => ProcessorUnit (Accum v x t) v x t where
  145     tryBind f pu
  146         | Just (F.Add a b c) <- castF f =
  147             Right $ registerAcc (F.Acc [F.Push F.Plus a, F.Push F.Plus b, F.Pull c]) pu
  148         | Just (F.Sub a b c) <- castF f =
  149             Right $ registerAcc (F.Acc [F.Push F.Plus a, F.Push F.Minus b, F.Pull c]) pu
  150         | Just (F.Neg a b) <- castF f =
  151             Right $ registerAcc (F.Acc [F.Push F.Minus a, F.Pull b]) pu
  152         | Just f'@F.Acc{} <- castF f =
  153             Right $ registerAcc f' pu
  154         | otherwise = Left $ "The function is unsupported by Accum: " ++ show f
  155 
  156     process = process_
  157 
  158 instance VarValTime v x t => EndpointProblem (Accum v x t) v t where
  159     endpointOptions pu@Accum{currentJob = Just Job{tasks, state}}
  160         | Just task <- targetTask tasks =
  161             let from = case state of
  162                     ArgumentAfterResult -> nextTick pu + 1
  163                     Initialize -> nextTick pu `withShift` 1
  164                     _ -> nextTick pu
  165              in map
  166                     (\v -> EndpointSt (Target v) $ TimeConstraint (from ... maxBound) (singleton 1))
  167                     $ S.elems
  168                     $ taskVars task
  169         | Just task <- sourceTask tasks =
  170             let from = case state of
  171                     Calculate -> nextTick pu + 2
  172                     WaitResults -> nextTick pu + 1
  173                     _ -> nextTick pu
  174              in [EndpointSt (Source $ taskVars task) $ TimeConstraint (from ... maxBound) (1 ... maxBound)]
  175     endpointOptions pu@Accum{remainJobs, currentJob = Nothing} =
  176         concatMap (\j -> endpointOptions pu{currentJob = Just j}) remainJobs
  177     endpointOptions pu = error [i|incorrect state for #{ pretty pu }|]
  178 
  179     endpointDecision pu@Accum{remainJobs, currentJob = Nothing} d
  180         | ([job], jobs') <- L.partition ((oneOf (variables d) `S.member`) . taskVars . head . tasks) remainJobs =
  181             endpointDecision
  182                 pu
  183                     { remainJobs = jobs'
  184                     , currentJob = Just job
  185                     }
  186                 d
  187     endpointDecision
  188         pu@Accum{currentJob = Just job@Job{tasks, state}}
  189         d@EndpointSt{epRole = Target v, epAt}
  190             | Just task <- targetTask tasks =
  191                 let ((neg, _v), task') = case L.partition ((== v) . snd) task of
  192                         ([negAndVar], ts) -> (negAndVar, ts)
  193                         _ -> error "Accum: endpointDecision: internal error"
  194                     instr = case state of
  195                         Initialize -> ResetAndLoad neg
  196                         _ -> Load neg
  197                     process_' = execSchedule pu $ do
  198                         scheduleEndpoint d $ scheduleInstructionUnsafe epAt instr
  199                  in pu
  200                         { process_ = process_'
  201                         , currentJob = case (task', tail tasks) of
  202                             ([], []) -> Nothing
  203                             ([], tasks') -> Just job{tasks = tasks', state = Calculate}
  204                             (_task', tasks') -> Just job{tasks = task' : tasks', state = WaitArguments}
  205                         }
  206     endpointDecision
  207         pu@Accum{currentJob = Just job@Job{tasks, func}, process_}
  208         d@EndpointSt{epRole = Source vs, epAt}
  209             | Just task <- sourceTask tasks =
  210                 let (_, task') = L.partition ((`S.member` vs) . snd) task
  211                     process_' = execSchedule pu $ do
  212                         endpoints <- scheduleEndpoint d $ scheduleInstructionUnsafe (epAt - 1) Out
  213                         when (null task' && length tasks == 1) $ do
  214                             let endpoints' = relatedEndpoints process_ $ variables func
  215                                 a = inf $ stepsInterval endpoints'
  216                                 low = endpoints ++ map pID endpoints'
  217                             high <- scheduleFunction (a ... sup epAt) func
  218                             establishVerticalRelations high low
  219                  in pu
  220                         { process_ = process_'
  221                         , currentJob = case (task', tail tasks) of
  222                             ([], []) -> Nothing
  223                             ([], tasks') -> Just job{tasks = tasks', state = ArgumentAfterResult}
  224                             (_task', tasks') -> Just job{tasks = task' : tasks', state = WaitResults}
  225                         }
  226     endpointDecision pu d = error [i|incorrect decision #{ d } for #{ pretty pu }|]
  227 
  228 instance Connected (Accum v x t) where
  229     data Ports (Accum v x t) = AccumPorts {resetAcc, load, neg, oe :: SignalTag}
  230         deriving (Show)
  231 
  232 instance IOConnected (Accum v x t) where
  233     data IOPorts (Accum v x t) = AccumIO deriving (Show)
  234 
  235 instance Controllable (Accum v x t) where
  236     data Instruction (Accum v x t) = ResetAndLoad Bool | Load Bool | Out deriving (Show)
  237 
  238     data Microcode (Accum v x t) = Microcode
  239         { oeSignal :: Bool
  240         , resetAccSignal :: Bool
  241         , loadSignal :: Bool
  242         , negSignal :: Maybe Bool
  243         }
  244         deriving (Show, Eq, Ord)
  245 
  246     zipSignalTagsAndValues AccumPorts{..} Microcode{..} =
  247         [ (resetAcc, Bool resetAccSignal)
  248         , (load, Bool loadSignal)
  249         , (oe, Bool oeSignal)
  250         , (neg, maybe Undef Bool negSignal)
  251         ]
  252 
  253     usedPortTags AccumPorts{resetAcc, load, neg, oe} = [resetAcc, load, neg, oe]
  254 
  255     takePortTags (resetAcc : load : neg : oe : _) _ = AccumPorts resetAcc load neg oe
  256     takePortTags _ _ = error "can not take port tags, tags are over"
  257 
  258 instance Default (Microcode (Accum v x t)) where
  259     def =
  260         Microcode
  261             { oeSignal = False
  262             , resetAccSignal = False
  263             , loadSignal = False
  264             , negSignal = Nothing
  265             }
  266 
  267 instance UnambiguouslyDecode (Accum v x t) where
  268     decodeInstruction (ResetAndLoad neg) = def{resetAccSignal = True, loadSignal = True, negSignal = Just neg}
  269     decodeInstruction (Load neg) = def{resetAccSignal = False, loadSignal = True, negSignal = Just neg}
  270     decodeInstruction Out = def{oeSignal = True}
  271 
  272 instance Var v => Locks (Accum v x t) v where
  273     locks Accum{currentJob = Nothing, remainJobs} = concatMap (locks . func) remainJobs
  274     locks Accum{currentJob = Just Job{tasks = []}} = error "Accum locks: internal error"
  275     locks Accum{currentJob = Just Job{tasks = t : ts}, remainJobs} =
  276         let current =
  277                 [ Lock{locked, lockBy}
  278                 | locked <- S.elems $ unionsMap taskVars ts
  279                 , lockBy <- S.elems $ taskVars t
  280                 ]
  281             remain =
  282                 [ Lock{locked, lockBy}
  283                 | locked <- S.elems $ unionsMap (variables . func) remainJobs
  284                 , lockBy <- S.elems $ taskVars t
  285                 ]
  286          in current ++ remain
  287 
  288 instance VarValTime v x t => TargetSystemComponent (Accum v x t) where
  289     moduleName _ _ = "pu_accum"
  290     hardware _tag _pu = FromLibrary "pu_accum.v"
  291     software _ _ = Empty
  292     hardwareInstance
  293         tag
  294         _pu
  295         UnitEnv
  296             { sigClk
  297             , sigRst
  298             , ctrlPorts = Just AccumPorts{..}
  299             , valueIn = Just (dataIn, attrIn)
  300             , valueOut = Just (dataOut, attrOut)
  301             } =
  302             [__i|
  303                 pu_accum \#
  304                         ( .DATA_WIDTH( #{ dataWidth (def :: x) } )
  305                         , .ATTR_WIDTH( #{ attrWidth (def :: x) } )
  306                         ) #{ tag }
  307                     ( .clk( #{ sigClk } )
  308                     , .rst( #{ sigRst } )
  309                     , .signal_resetAcc( #{ resetAcc } )
  310                     , .signal_load( #{ load } )
  311                     , .signal_neg( #{ neg } )
  312                     , .signal_oe( #{ oe } )
  313                     , .data_in( #{ dataIn } )
  314                     , .attr_in( #{ attrIn } )
  315                     , .data_out( #{ dataOut } )
  316                     , .attr_out( #{ attrOut } )
  317                     );
  318             |]
  319     hardwareInstance _title _pu _env = error "internal error"
  320 
  321 instance Ord t => WithFunctions (Accum v x t) (F v x) where
  322     functions Accum{process_, remainJobs} =
  323         functions process_ ++ map func remainJobs
  324 
  325 instance VarValTime v x t => Testable (Accum v x t) v x where
  326     testBenchImplementation prj@Project{pName, pUnit} =
  327         let tbcSignalsConst = ["resetAcc", "load", "oe", "neg"]
  328 
  329             showMicrocode Microcode{resetAccSignal, loadSignal, oeSignal, negSignal} =
  330                 ([i|resetAcc <= #{ bool2verilog resetAccSignal };|] :: String)
  331                     <> [i| load <= #{ bool2verilog loadSignal };|]
  332                     <> [i| oe <= #{ bool2verilog oeSignal };|]
  333                     <> [i| neg <= #{ bool2verilog $ fromMaybe False negSignal };|]
  334 
  335             conf =
  336                 SnippetTestBenchConf
  337                     { tbcSignals = tbcSignalsConst
  338                     , tbcPorts =
  339                         AccumPorts
  340                             { resetAcc = SignalTag "resetAcc"
  341                             , load = SignalTag "load"
  342                             , oe = SignalTag "oe"
  343                             , neg = SignalTag "neg"
  344                             }
  345                     , tbcMC2verilogLiteral = T.pack . showMicrocode
  346                     }
  347          in Immediate (toString $ moduleName pName pUnit <> "_tb.v") $ snippetTestBench prj conf
  348 
  349 instance IOTestBench (Accum v x t) v x
  350 
  351 instance BreakLoopProblem (Accum v x t) v x
  352 instance ConstantFoldingProblem (Accum v x t) v x
  353 instance OptimizeAccumProblem (Accum v x t) v x
  354 instance ResolveDeadlockProblem (Accum v x t) v x