never executed always true always false
1 {-# LANGUAGE DataKinds #-}
2 {-# LANGUAGE DeriveDataTypeable #-}
3 {-# LANGUAGE InstanceSigs #-}
4 {-# LANGUAGE QuasiQuotes #-}
5 {-# LANGUAGE RecordWildCards #-}
6 {-# LANGUAGE StandaloneDeriving #-}
7 {-# LANGUAGE TypeFamilies #-}
8
9 module NITTA.Model.ProcessorUnits.LogicalUnit (
10 LogicalUnit (..),
11 logicalUnit,
12 Ports (LOGICALUNITPorts),
13 IOPorts (..),
14 )
15 where
16
17 import Control.Monad (when)
18 import Data.Bits (Bits (testBit))
19 import Data.Default (Default, def)
20 import Data.Foldable as DF (Foldable (null), find)
21 import Data.List (elemIndex, partition, (\\))
22 import Data.Map qualified as M
23 import Data.Maybe
24 import Data.Set qualified as S
25 import Data.String.Interpolate
26 import Data.String.ToString
27 import Data.Text qualified as T
28 import Data.Typeable (Typeable)
29 import NITTA.Intermediate.Functions qualified as F
30 import NITTA.Intermediate.Types
31 import NITTA.Model.Problems
32 import NITTA.Model.ProcessorUnits.Types
33 import NITTA.Model.Time
34 import NITTA.Project
35 import NITTA.Utils
36 import NITTA.Utils.ProcessDescription
37 import Numeric.Interval.NonEmpty hiding (elem, notElem)
38 import Prettyprinter
39
40 data LogicalUnit v x t = LogicalUnit
41 { remain :: [F v x]
42 , targets :: [v]
43 , sources :: [v]
44 , currentWork :: Maybe (F v x)
45 , logicalunitFunctions :: [F v x]
46 , selBitNum :: Int
47 , maxNumArgs :: Int
48 , process_ :: Process t (StepInfo v x t)
49 }
50 deriving (Typeable)
51
52 logicalUnit :: Time t => LogicalUnit v x t
53 logicalUnit =
54 LogicalUnit
55 { remain = []
56 , targets = []
57 , sources = []
58 , logicalunitFunctions = []
59 , currentWork = Nothing
60 , selBitNum = 4
61 , maxNumArgs = 16
62 , process_ = def
63 }
64
65 instance VarValTime v x t => Pretty (LogicalUnit v x t) where
66 pretty LogicalUnit{remain, targets, sources, currentWork, logicalunitFunctions, process_} =
67 [__i|
68 LogicalUnit:
69 remain: #{ remain }
70 targets: #{ map toString targets }
71 sources: #{ map toString sources }
72 currentWork: #{ currentWork }
73 logicalunitFunctions: #{ logicalunitFunctions }
74 #{ nest 4 $ pretty process_ }
75 |]
76
77 instance VarValTime v x t => Show (LogicalUnit v x t) where
78 show = show . pretty
79
80 instance Default (Microcode (LogicalUnit v x t)) where
81 def =
82 Microcode
83 { oeSignal = False
84 , wrSignal = False
85 , selSignal = Nothing
86 }
87
88 instance Connected (LogicalUnit v x t) where
89 data Ports (LogicalUnit v x t) = LOGICALUNITPorts
90 { oe :: SignalTag
91 , wr :: SignalTag
92 , sel :: [SignalTag]
93 }
94 deriving (Show)
95
96 instance IOConnected (LogicalUnit v x t) where
97 data IOPorts (LogicalUnit v x t) = LogicalUnitIO
98 deriving (Show)
99
100 selWidth :: LogicalUnit v x t -> Int
101 selWidth l = calcSelWidth (length (logicalunitFunctions l))
102 calcSelWidth n = max 1 $ ceiling (logBase (2 :: Double) (fromIntegral $ max 1 n))
103
104 getFunctionIndex :: LogicalUnit v x t -> Int
105 getFunctionIndex LogicalUnit{currentWork, logicalunitFunctions} =
106 fromMaybe (-1) (currentWork >>= \cw -> elemIndex cw logicalunitFunctions)
107
108 instance Controllable (LogicalUnit v x t) where
109 data Instruction (LogicalUnit v x t)
110 = Load
111 | Out Int
112 deriving (Show)
113
114 data Microcode (LogicalUnit v x t) = Microcode
115 { oeSignal :: Bool
116 , wrSignal :: Bool
117 , selSignal :: Maybe Int
118 }
119 deriving (Show, Eq, Ord)
120
121 zipSignalTagsAndValues LOGICALUNITPorts{..} Microcode{..} =
122 [ (oe, Bool oeSignal)
123 , (wr, Bool wrSignal)
124 ]
125 ++ sel'
126 where
127 sel' =
128 map
129 ( \(linkId, ix) ->
130 ( linkId
131 , maybe Undef (Bool . (`testBit` ix)) selSignal
132 )
133 )
134 $ zip (reverse sel) [0 ..]
135
136 usedPortTags LOGICALUNITPorts{oe, wr, sel} = oe : wr : sel
137
138 takePortTags (oe : wr : xs) l = LOGICALUNITPorts oe wr sel
139 where
140 sel = take (selBitNum l) xs
141 takePortTags _ _ = error "can not take port tags, tags are over"
142
143 instance UnambiguouslyDecode (LogicalUnit v x t) where
144 decodeInstruction Load = def{wrSignal = True}
145 decodeInstruction (Out op) = def{oeSignal = True, selSignal = Just op}
146
147 softwareFile tag pu = moduleName tag pu <> T.pack "." <> tag <> T.pack ".dump"
148 maxArgsLen LogicalUnit{logicalunitFunctions} =
149 if null logicalunitFunctions
150 then 0
151 else maximum [S.size (inputs f) | F f _ <- logicalunitFunctions]
152
153 maxAddrLen pu = maxArgsLen pu + selBitNum pu
154
155 instance VarValTime v x t => TargetSystemComponent (LogicalUnit v x t) where
156 moduleName _title _pu = T.pack "pu_logical_unit"
157 hardware _tag _pu = FromLibrary "pu_logical_unit.v"
158
159 software tag pu@LogicalUnit{logicalunitFunctions, selBitNum} =
160 let
161 entries = concatMap getLogicalUnitEntries (zip [0 ..] logicalunitFunctions)
162 memoryDump = T.unlines $ map (T.pack . padEntry (maxAddrLen pu)) entries
163 in
164 Immediate (toString $ softwareFile tag pu) memoryDump
165 where
166 getLogicalUnitEntries (funcIdx, f)
167 | Just (F.TruthTable logicalunitMap _ (O _)) <- castF f =
168 let
169 selBits = intToBits selBitNum funcIdx
170 numArgs = maybe 0 length (listToMaybe $ M.keys logicalunitMap)
171 totalCombinations = 2 ^ maxArgsLen pu
172 existingCombinations = M.size logicalunitMap
173 missingCount = totalCombinations - existingCombinations
174 in
175 map
176 ( \(inp, out) ->
177 ( boolToBits (selBits ++ inp)
178 , if out then '1' else '0'
179 )
180 )
181 (M.toList logicalunitMap)
182 ++ replicate
183 missingCount
184 ( boolToBits selBits ++ replicate numArgs '0'
185 , '0'
186 )
187 | otherwise = []
188
189 intToBits :: Int -> Int -> [Bool]
190 intToBits wdth n = [testBit n i' | i' <- [wdth - 1, wdth - 2 .. 0]]
191
192 boolToBits = map (\b -> if b then '1' else '0')
193 padEntry len (addr, out) = addr ++ replicate (len - length addr) '0' ++ [out]
194
195 hardwareInstance
196 tag
197 _pu
198 UnitEnv
199 { sigClk
200 , ctrlPorts = Just LOGICALUNITPorts{..}
201 , valueIn = Just (dataIn, attrIn)
202 , valueOut = Just (dataOut, attrOut)
203 } =
204 [__i|
205 pu_logical_unit \#
206 ( .ATTR_WIDTH( #{ attrWidth (def :: x) } )
207 , .DATA_WIDTH( #{ dataWidth (def :: x) } )
208 , .SEL_WIDTH( #{ (selBitNum _pu)} )
209 , .MAX_NUM_ARGS( #{ maxArgsLen _pu } )
210 , .LOGICALUNIT_DUMP( "{{ impl.paths.nest }}/#{ softwareFile tag _pu }" )
211 ) #{ tag }
212 ( .clk( #{ sigClk } )
213
214 , .signal_oe( #{ oe } )
215 , .signal_wr( #{ wr } )
216 , .signal_sel( { #{ T.intercalate (T.pack ", ") $ map showText sel } } )
217
218 , .data_in( #{ dataIn } )
219 , .attr_in( #{ attrIn } )
220 , .data_out( #{ dataOut } )
221 , .attr_out( #{ attrOut } )
222 );
223 |]
224 hardwareInstance _title _pu _env = error "internal error"
225
226 instance VarValTime v x t => ProcessorUnit (LogicalUnit v x t) v x t where
227 tryBind f pu@LogicalUnit{remain, logicalunitFunctions}
228 | Just F.TruthTable{} <- castF f = Right pu{remain = f : remain ++ remain, logicalunitFunctions = f : logicalunitFunctions}
229 | Just F.LogicAnd{} <- castF f = Right pu{remain = f : remain, logicalunitFunctions = f : logicalunitFunctions}
230 | Just F.LogicOr{} <- castF f = Right pu{remain = f : remain, logicalunitFunctions = f : logicalunitFunctions}
231 | Just F.LogicNot{} <- castF f = Right pu{remain = f : remain, logicalunitFunctions = f : logicalunitFunctions}
232 | otherwise = Left $ "The function is unsupported by LogicalUnit: " ++ show f
233 process = process_
234
235 execution :: LogicalUnit v x t -> F v x -> LogicalUnit v x t
236 execution pu@LogicalUnit{targets = [], sources = [], remain} f =
237 pu
238 { remain = filter (/= f) remain
239 , currentWork = Just f
240 , targets = S.elems $ inputs f
241 , sources = S.elems $ outputs f
242 }
243 execution _ _ = error "LogicalUnit: internal execution error."
244
245 instance VarValTime v x t => EndpointProblem (LogicalUnit v x t) v t where
246 endpointOptions pu@LogicalUnit{targets}
247 | not $ DF.null targets =
248 let at = nextTick pu ... maxBound
249 duration = 1 ... maxBound
250 in map (\v -> EndpointSt (Target v) $ TimeConstraint at duration) targets
251 endpointOptions LogicalUnit{sources, currentWork = Just f, process_}
252 | not $ DF.null sources =
253 let doneAt = inputsPushedAt process_ f + 3
254 at = max doneAt (nextTick process_) ... maxBound
255 duration = 1 ... maxBound
256 allSources = sources
257 in [EndpointSt (Source $ S.fromList allSources) $ TimeConstraint at duration]
258 endpointOptions pu@LogicalUnit{remain} = concatMap (endpointOptions . execution pu) remain
259
260 endpointDecision pu@LogicalUnit{targets} d@EndpointSt{epRole = Target v, epAt}
261 | not $ null targets
262 , let allTargets = targets
263 , ([_], targets') <- partition (== v) allTargets
264 , let process_' = execSchedule pu $ do
265 scheduleEndpoint d $ scheduleInstructionUnsafe epAt Load =
266 pu
267 { targets = targets'
268 , process_ = process_'
269 }
270 endpointDecision pu@LogicalUnit{targets = [], sources, currentWork = Just f, process_} d@EndpointSt{epRole = Source v, epAt}
271 | not $ null sources
272 , let allSources = sources
273 , let sources' = allSources \\ S.elems v
274 , sources' /= allSources
275 , let a = inf $ stepsInterval $ relatedEndpoints process_ $ variables f
276 , let process_' = execSchedule pu $ do
277 endpoints <- scheduleEndpoint d $ scheduleInstructionUnsafe epAt (Out (getFunctionIndex pu))
278 when (null sources') $ do
279 scheduleFunctionFinish_ [] f $ a ... sup epAt
280 return endpoints =
281 pu
282 { sources = sources'
283 , process_ = process_'
284 , currentWork = Just f
285 }
286 endpointDecision pu@LogicalUnit{targets = [], sources = [], remain} d
287 | let v = oneOf $ variables d
288 , Just f <- find (\f -> v `S.member` variables f) remain =
289 endpointDecision (execution pu f) d
290 endpointDecision pu d = error [i|incorrect decision #{ d } for #{ pretty pu }|]
291
292 instance Ord t => WithFunctions (LogicalUnit v x t) (F v x) where
293 functions LogicalUnit{process_, remain, currentWork} =
294 functions process_
295 ++ remain
296 ++ maybeToList currentWork
297
298 instance BreakLoopProblem (LogicalUnit v x t) v x
299
300 instance ConstantFoldingProblem (LogicalUnit v x t) v x
301
302 instance OptimizeAccumProblem (LogicalUnit v x t) v x
303
304 instance OptimizeLogicalUnitProblem (LogicalUnit v x t) v x
305
306 instance ResolveDeadlockProblem (LogicalUnit v x t) v x
307
308 instance Var v => Locks (LogicalUnit v x t) v where
309 locks LogicalUnit{remain, sources, targets} =
310 [ Lock{lockBy, locked}
311 | locked <- sources
312 , lockBy <- targets
313 ]
314 ++ [ Lock{lockBy, locked}
315 | locked <- concatMap (S.elems . variables) remain
316 , lockBy <- sources ++ targets
317 ]
318 ++ concatMap locks remain
319
320 instance IOTestBench (LogicalUnit v x t) v x
321
322 instance Default x => DefaultX (LogicalUnit v x t) x
323
324 instance Time t => Default (LogicalUnit v x t) where
325 def = logicalUnit
326
327 instance VarValTime v x t => Testable (LogicalUnit v x t) v x where
328 testBenchImplementation prj@Project{pName, pUnit} =
329 let logicalunitDef :: LogicalUnit v x t
330 logicalunitDef = def
331 tbcSignalsConst = [T.pack "oe", T.pack "wr", T.pack $ "[" ++ show (selBitNum logicalunitDef - 1) ++ ":0] sel"]
332 showMicrocode Microcode{oeSignal, wrSignal, selSignal} =
333 [i|oe <= #{ bool2verilog oeSignal };|]
334 <> [i| wr <= #{ bool2verilog wrSignal };|]
335 <> case selSignal of
336 Just sel -> [i| sel <= #{ selWidth logicalunitDef }'d#{ sel };|]
337 Nothing -> [i| sel <= {#{ selWidth logicalunitDef }{1'bx}};|]
338 in Immediate (toString $ moduleName pName pUnit <> T.pack "_tb.v") $
339 snippetTestBench
340 prj
341 SnippetTestBenchConf
342 { tbcSignals = tbcSignalsConst
343 , tbcPorts =
344 LOGICALUNITPorts
345 { oe = SignalTag (T.pack "oe")
346 , wr = SignalTag (T.pack "wr")
347 , sel =
348 [ (SignalTag . T.pack) ("sel[" <> show p <> "]")
349 | p <- [selBitNum logicalunitDef - 1, selBitNum logicalunitDef - 2 .. 0]
350 ]
351 }
352 , tbcMC2verilogLiteral = showMicrocode
353 }