never executed always true always false
1 -- All extensions should be enabled explicitly due to doctest in this module.
2 {-# LANGUAGE DuplicateRecordFields #-}
3 {-# LANGUAGE FlexibleContexts #-}
4 {-# LANGUAGE FlexibleInstances #-}
5 {-# LANGUAGE ImportQualifiedPost #-}
6 {-# LANGUAGE LambdaCase #-}
7 {-# LANGUAGE MultiParamTypeClasses #-}
8 {-# LANGUAGE NamedFieldPuns #-}
9 {-# LANGUAGE OverloadedStrings #-}
10 {-# LANGUAGE QuasiQuotes #-}
11 {-# LANGUAGE RecordWildCards #-}
12 {-# LANGUAGE ScopedTypeVariables #-}
13 {-# LANGUAGE StandaloneDeriving #-}
14 {-# LANGUAGE TypeFamilies #-}
15 {-# LANGUAGE UndecidableInstances #-}
16
17 -- TODO: A promising direction for the improvement is the implementation of the
18 -- accumulator into it. It allows multiplying an arbitrary number of arguments,
19 -- which will reduce the number of data transactions on the bus when multiplying
20 -- more than two variables by one function.
21
22 -- TODO: Add assertion, which checks that all synthesis decision compliant
23 -- available options.
24
25 {- |
26 Module : NITTA.Model.ProcessorUnits.Multiplier
27 Description :
28 Copyright : (c) Aleksandr Penskoi, 2020
29 License : BSD3
30 Maintainer : aleksandr.penskoi@gmail.com
31 Stability : experimental
32
33 = Processor unit
34
35 A processor unit (PU) can be used for:
36
37 - data storage and processing;
38 - interaction with the periphery (IO);
39 - control of a NITTA processor (special case).
40
41 There are characterized by complicated behavior with:
42
43 - multifunctionality;
44 - internal parallelism;
45 - superscalar;
46 - pipelining;
47 - availability of internal resources.
48
49 The multiplier PU is one of the simplest processors because it realizes only
50 one function with sequence evaluation
51 ('NITTA.Intermediate.Functions.Multiply'). Processor behavior in a specific
52 application is determined by the applied algorithm
53 ('NITTA.Intermediate.DataFlow').
54
55 Any PU may include three components:
56
57 - hardware - set of prepared or automatically generated hardware descriptions
58 (@\/hdl\/multiplier@);
59
60 - software - set of binary files that determine:
61
62 - initial state and setting ;
63
64 - a control program;
65
66 - PU model - CAD component that implements PU support (hardware and software
67 generation, instance generation, computation process scheduling, testing
68 environment, etc.).
69
70 All three components are hardly related to each other and needed to comply
71 with each other strictly. For a deeper understanding, a PU developer should
72 understand all of its components. The multiplier model will be described
73 above.
74
75 == Processor unit model
76
77 A model purpose is "teaching" CAD how to work with the PU:
78
79 - Which functions can be evaluated by PU? (see
80 'NITTA.Model.ProcessorUnits.Types.ProcessorUnit')?
81
82 - How to control PU for evaluating specific functions (see
83 'NITTA.Model.ProcessorUnits.Types.ProcessorUnit',
84 'NITTA.Model.ProcessorUnits.Types.Controllable')?
85
86 - How to translating instructions to microcode (see
87 'NITTA.Model.ProcessorUnits.Types.UnambiguouslyDecode')?
88
89 - What are the options of PU synthesis decision available? (see
90 'NITTA.Model.Problems.Types.ProcessorUnit',
91 'NITTA.Model.Problems.Types.EndpointDT'):
92
93 - push variable to the PU ('NITTA.Model.Problems.Endpoint.Target');
94
95 - pull at least one variable from the PU ('NITTA.Model.Problems.Endpoint.Source').
96
97 The basis of a PU model is a data structure that represents:
98
99 - PU state during computation process scheduling;
100
101 - process description (full or fragment), which can be translated to microcode.
102
103 Exactly around this data structure, all algorithmic part of the PU model is
104 developed. The types of the following variables parametrize the data structure:
105
106 - @v@ - variable id (usually 'String');
107
108 - @x@ - a type of processed value (see 'NITTA.Intermediate.Value.Val');
109
110 - @t@ - time moment id (usually 'Int').
111
112 = Multiplier processor unit
113
114 The multiplier processor unit can evaluate the following function type:
115
116 - 'NITTA.Intermediate.Functions.Multiply'.
117
118 Only one function can be processed in one moment, and its execution cannot be
119 interrupted.
120
121 This module should be considered as a tutorial for the development of other
122 models of processor units. Its source code is written almost in literature
123 style, so we recommend to continue reading within the source code.
124
125 == Interaction with multiplier processor unit
126
127 We will consider the example of the computation process scheduling for one
128 function. To do this, we need to start GHCi interpreter by executing `stack
129 repl` command from the project directory. After that:
130
131 @
132 > :l NITTA.Model.ProcessorUnits.Multiplier
133 [ 1 of 30] Compiling NITTA.Intermediate.Value ( UserspenskoiDocumentsnitta-corpnittasrcNITTAIntermediate/Value.hs, interpreted )
134 [ 2 of 30] Compiling NITTA.Intermediate.Variable ( UserspenskoiDocumentsnitta-corpnittasrcNITTAIntermediate/Variable.hs, interpreted )
135 [ 3 of 30] Compiling NITTA.Intermediate.Types ( UserspenskoiDocumentsnitta-corpnittasrcNITTAIntermediate/Types.hs, interpreted )
136 [ 4 of 30] Compiling NITTA.Model.Problems.Binding ( UserspenskoiDocumentsnitta-corpnittasrcNITTAModelProblemsBinding.hs, interpreted )
137 [ 5 of 30] Compiling NITTA.Model.Types ( UserspenskoiDocumentsnitta-corpnittasrcNITTAModel/Types.hs, interpreted )
138 [ 6 of 30] Compiling NITTA.Model.Problems.Endpoint ( UserspenskoiDocumentsnitta-corpnittasrcNITTAModelProblemsEndpoint.hs, interpreted )
139 [ 7 of 30] Compiling NITTA.Model.Problems.Dataflow ( UserspenskoiDocumentsnitta-corpnittasrcNITTAModelProblemsDataflow.hs, interpreted )
140 [ 8 of 30] Compiling NITTA.Project.Types ( UserspenskoiDocumentsnitta-corpnittasrcNITTAProject/Types.hs, interpreted )
141 [ 9 of 30] Compiling NITTA.Utils.Base ( UserspenskoiDocumentsnitta-corpnittasrcNITTAUtils/Base.hs, interpreted )
142 [10 of 30] Compiling NITTA.Intermediate.Functions.Accum ( UserspenskoiDocumentsnitta-corpnittasrcNITTAIntermediateFunctionsAccum.hs, interpreted )
143 [11 of 30] Compiling NITTA.Intermediate.Functions ( UserspenskoiDocumentsnitta-corpnittasrcNITTAIntermediate/Functions.hs, interpreted )
144 [12 of 30] Compiling NITTA.Model.Problems.Refactor ( UserspenskoiDocumentsnitta-corpnittasrcNITTAModelProblemsRefactor.hs, interpreted )
145 [13 of 30] Compiling NITTA.Model.Problems.Whole ( UserspenskoiDocumentsnitta-corpnittasrcNITTAModelProblemsWhole.hs, interpreted )
146 [14 of 30] Compiling NITTA.Model.Problems ( UserspenskoiDocumentsnitta-corpnittasrcNITTAModel/Problems.hs, interpreted )
147 [15 of 30] Compiling NITTA.Utils.CodeFormat ( UserspenskoiDocumentsnitta-corpnittasrcNITTAUtils/CodeFormat.hs, interpreted )
148 [16 of 30] Compiling NITTA.Model.ProcessorUnits.Types ( UserspenskoiDocumentsnitta-corpnittasrcNITTAModelProcessorUnitsTypes.hs, interpreted )
149 [17 of 30] Compiling NITTA.Utils ( UserspenskoiDocumentsnitta-corpnittasrcNITTAUtils.hs, interpreted )
150 [18 of 30] Compiling NITTA.Project.VerilogSnippets ( UserspenskoiDocumentsnitta-corpnittasrcNITTAProject/Snippets.hs, interpreted )
151 [19 of 30] Compiling NITTA.Project.Implementation ( UserspenskoiDocumentsnitta-corpnittasrcNITTAProject/Implementation.hs, interpreted )
152 [20 of 30] Compiling NITTA.Project.Parts.Utils ( UserspenskoiDocumentsnitta-corpnittasrcNITTAProjectPartsUtils.hs, interpreted )
153 [21 of 30] Compiling NITTA.Project.TestBench ( UserspenskoiDocumentsnitta-corpnittasrcNITTAProjectPartsTestBench.hs, interpreted )
154 [22 of 30] Compiling NITTA.Project.Parts.TargetSystem ( UserspenskoiDocumentsnitta-corpnittasrcNITTAProjectPartsTargetSystem.hs, interpreted )
155 [23 of 30] Compiling NITTA.Project.Parts.Icarus ( UserspenskoiDocumentsnitta-corpnittasrcNITTAProjectPartsIcarus.hs, interpreted )
156 [24 of 30] Compiling NITTA.Model.Networks.Types ( UserspenskoiDocumentsnitta-corpnittasrcNITTAModelNetworksTypes.hs, interpreted )
157 [25 of 30] Compiling NITTA.Utils.ProcessDescription ( UserspenskoiDocumentsnitta-corpnittasrcNITTAUtils/ProcessDescription.hs, interpreted )
158 [26 of 30] Compiling NITTA.Model.Networks.Bus ( UserspenskoiDocumentsnitta-corpnittasrcNITTAModelNetworksBus.hs, interpreted )
159 [27 of 30] Compiling NITTA.Project.Parts.Quartus ( UserspenskoiDocumentsnitta-corpnittasrcNITTAProjectPartsQuartus.hs, interpreted )
160 [28 of 30] Compiling NITTA.Project.Utils ( UserspenskoiDocumentsnitta-corpnittasrcNITTAProject/Utils.hs, interpreted )
161 [29 of 30] Compiling NITTA.Project ( UserspenskoiDocumentsnitta-corpnittasrcNITTAProject.hs, interpreted )
162 [30 of 30] Compiling NITTA.Model.ProcessorUnits.Multiplier ( UserspenskoiDocumentsnitta-corpnittasrcNITTAModelProcessorUnitsMultiplier.hs, interpreted )
163 Ok, 30 modules loaded.
164 > :module +NITTA.Model.ProcessorUnits.Types NITTA.Intermediate.Functions Numeric.Interval.NonEmpty Data.Set Prettyprinter.Render.Text
165 > :set prompt "ESC[34mλ> ESC[m"
166 @
167
168 Now create the function and multiplier model initial state. Unfortunately, it
169 is not enough information for GHC deduction of its type, so let's define its
170 implicitly.
171
172 >>> :module +Prettyprinter.Render.Text
173 >>> let f = F.multiply "a" "b" ["c", "d"] :: F String Int
174 >>> f
175 a * b = c = d
176 >>> let st0 = multiplier True :: Multiplier String Int Int
177 >>> putDoc $ pretty st0
178 Multiplier:
179 remain: []
180 targets: []
181 sources: []
182 currentWork: Nothing
183 isMocked: True
184 Process:
185 steps:
186 relations:
187 nextTick: 0
188 nextUid: 0
189 >>> endpointOptions st0
190 []
191
192 Bind a function to the multiplier unit. This operation could be executed at
193 any time of working with a model, including when a computation process is
194 fully scheduled (new work can be added). The main rules are: 1) if work is
195 fully scheduled, then it is necessary to perform it, and any part of it
196 cannot be "lost" inside the model; 2) if a unit has its internal resources,
197 there should be enough to finish schedule, even it is inefficient.
198
199 >>> let Right st1 = tryBind f st0
200 >>> putDoc $ pretty st1
201 Multiplier:
202 remain: [a * b = c = d]
203 targets: []
204 sources: []
205 currentWork: Nothing
206 isMocked: True
207 Process:
208 steps:
209 relations:
210 nextTick: 0
211 nextUid: 0
212 >>> endpointOptions st1
213 [?Target a@(0..INF /P 1..INF),?Target b@(0..INF /P 1..INF)]
214
215 As we can see, after binding, we have two different options of computational
216 process scheduling that match different argument loading sequences: @a@ or
217 @b@. We can see that they are similar from an execution sequence point of
218 view: loading can be started from 0 tick or after an arbitrary delay; for
219 loading of one argument needed only one tick, but it can continue for an
220 arbitrary time. Choose the variant.
221
222 >>> let st2 = endpointDecision st1 $ EndpointSt (Target "a") (0...2)
223 >>> putDoc $ pretty st2
224 Multiplier:
225 remain: []
226 targets: ["b"]
227 sources: ["c","d"]
228 currentWork: Just a * b = c = d
229 isMocked: True
230 Process:
231 steps:
232 0) Step {pID = 0, pInterval = 0 ... 2, pDesc = Endpoint: Target a}
233 1) Step {pID = 1, pInterval = 0 ... 2, pDesc = Instruction: Load}
234 relations:
235 0) Vertical {vUp = 0, vDown = 1}
236 nextTick: 3
237 nextUid: 2
238 >>> mapM_ print $ endpointOptions st2
239 ?Target b@(3..INF /P 1..INF)
240 >>> let st3 = endpointDecision st2 $ EndpointSt (Target "b") (3...3)
241 >>> putDoc $ pretty st3
242 Multiplier:
243 remain: []
244 targets: []
245 sources: ["c","d"]
246 currentWork: Just a * b = c = d
247 isMocked: True
248 Process:
249 steps:
250 0) Step {pID = 0, pInterval = 0 ... 2, pDesc = Endpoint: Target a}
251 1) Step {pID = 1, pInterval = 0 ... 2, pDesc = Instruction: Load}
252 2) Step {pID = 2, pInterval = 3 ... 3, pDesc = Endpoint: Target b}
253 3) Step {pID = 3, pInterval = 3 ... 3, pDesc = Instruction: Load}
254 relations:
255 0) Vertical {vUp = 2, vDown = 3}
256 1) Vertical {vUp = 0, vDown = 1}
257 nextTick: 4
258 nextUid: 4
259 >>> mapM_ print $ endpointOptions st3
260 ?Source c,d@(6..INF /P 1..INF)
261
262 After loading both arguments, we can see that the next option is unloading
263 @c@ and @d@ variables. Note, these variables can be unloaded either
264 concurrently or sequentially (for details, see how the multiplier works
265 inside). Consider the second option:
266
267 >>> let st4 = endpointDecision st3 $ EndpointSt (Source $ S.fromList ["c"]) (6...6)
268 >>> putDoc $ pretty st4
269 Multiplier:
270 remain: []
271 targets: []
272 sources: ["d"]
273 currentWork: Just a * b = c = d
274 isMocked: True
275 Process:
276 steps:
277 0) Step {pID = 0, pInterval = 0 ... 2, pDesc = Endpoint: Target a}
278 1) Step {pID = 1, pInterval = 0 ... 2, pDesc = Instruction: Load}
279 2) Step {pID = 2, pInterval = 3 ... 3, pDesc = Endpoint: Target b}
280 3) Step {pID = 3, pInterval = 3 ... 3, pDesc = Instruction: Load}
281 4) Step {pID = 4, pInterval = 6 ... 6, pDesc = Endpoint: Source c}
282 5) Step {pID = 5, pInterval = 6 ... 6, pDesc = Instruction: Out}
283 relations:
284 0) Vertical {vUp = 4, vDown = 5}
285 1) Vertical {vUp = 2, vDown = 3}
286 2) Vertical {vUp = 0, vDown = 1}
287 nextTick: 7
288 nextUid: 6
289 >>> mapM_ print $ endpointOptions st4
290 ?Source d@(7..INF /P 1..INF)
291 >>> let st5 = endpointDecision st4 $ EndpointSt (Source $ S.fromList ["d"]) (7...7)
292 >>> putDoc $ pretty st5
293 Multiplier:
294 remain: []
295 targets: []
296 sources: []
297 currentWork: Nothing
298 isMocked: True
299 Process:
300 steps:
301 0) Step {pID = 0, pInterval = 0 ... 2, pDesc = Endpoint: Target a}
302 1) Step {pID = 1, pInterval = 0 ... 2, pDesc = Instruction: Load}
303 2) Step {pID = 2, pInterval = 3 ... 3, pDesc = Endpoint: Target b}
304 3) Step {pID = 3, pInterval = 3 ... 3, pDesc = Instruction: Load}
305 4) Step {pID = 4, pInterval = 6 ... 6, pDesc = Endpoint: Source c}
306 5) Step {pID = 5, pInterval = 6 ... 6, pDesc = Instruction: Out}
307 6) Step {pID = 6, pInterval = 7 ... 7, pDesc = Endpoint: Source d}
308 7) Step {pID = 7, pInterval = 7 ... 7, pDesc = Instruction: Out}
309 8) Step {pID = 8, pInterval = 0 ... 7, pDesc = Intermediate: a * b = c = d}
310 relations:
311 0) Vertical {vUp = 8, vDown = 6}
312 1) Vertical {vUp = 8, vDown = 4}
313 2) Vertical {vUp = 8, vDown = 2}
314 3) Vertical {vUp = 8, vDown = 0}
315 4) Vertical {vUp = 6, vDown = 7}
316 5) Vertical {vUp = 4, vDown = 5}
317 6) Vertical {vUp = 2, vDown = 3}
318 7) Vertical {vUp = 0, vDown = 1}
319 nextTick: 8
320 nextUid: 9
321 >>> endpointOptions st5
322 []
323
324 All options of computing process scheduling are run out. All bound functions
325 are planned. Further microcode can be generated, which can be organizing the
326 described computational process on the multiplier.
327 -}
328 module NITTA.Model.ProcessorUnits.Multiplier (
329 multiplier,
330 Multiplier,
331 Ports (..),
332 IOPorts (..),
333 ) where
334
335 import Control.Monad (when)
336 import Data.Default
337 import Data.List (find, partition, (\\))
338 import Data.Maybe
339 import Data.Set qualified as S
340 import Data.String.Interpolate
341 import Data.String.ToString
342 import NITTA.Intermediate.Functions qualified as F
343 import NITTA.Intermediate.Types
344 import NITTA.Model.Problems
345 import NITTA.Model.ProcessorUnits.Types
346 import NITTA.Model.Time
347 import NITTA.Project
348 import NITTA.Utils
349 import NITTA.Utils.ProcessDescription
350 import Numeric.Interval.NonEmpty (inf, sup, (...))
351 import Prettyprinter
352
353 {- | It is a PU model state representation, which describes each state of
354 synthesis model for that PU.
355 -}
356 data Multiplier v x t = Multiplier
357 { remain :: [F v x]
358 {- ^ List of the assigned but not processed functions. To execute a
359 function:
360
361 - removing the function from this list;
362
363 - transfering information from function to 'targets' and 'sources'
364 fields.
365
366 An assigned function can be executed in random order.
367 -}
368 , targets :: [v]
369 {- ^ List of variables, which is needed to push to the PU for current
370 function evaluation.
371 -}
372 , sources :: [v]
373 {- ^ List of variables, which is needed to pull from PU for current
374 function evaluation. Pull order is arbitrary. All pulled variables
375 correspond to the same value (same result).
376 -}
377 , currentWork :: Maybe (F v x)
378 -- ^ Current work, if some function is executed.
379 , process_ :: Process t (StepInfo v x t)
380 {- ^ Description of scheduled computation process
381 ('NITTA.Model.ProcessorUnits.Types').
382 -}
383 , isMocked :: Bool
384 {- ^ HDL implementation of PU contains a multiplier IP core from Altera.
385 Icarus Verilog can not simulate it. If `isMocked` is set, a target
386 system will be contained non-synthesizable implementation of that
387 IP-core.
388 -}
389 }
390
391 instance VarValTime v x t => Pretty (Multiplier v x t) where
392 pretty Multiplier{remain, targets, sources, currentWork, process_, isMocked} =
393 [__i|
394 Multiplier:
395 remain: #{ remain }
396 targets: #{ map toString targets }
397 sources: #{ map toString sources }
398 currentWork: #{ currentWork }
399 isMocked: #{ isMocked }
400 #{ nest 4 $ pretty process_ }
401 |]
402
403 {- | Multiplier PU model constructor. Argument defines the computation unit's
404 internal organization: using multiplier IP kernel (False) or mock (True). For
405 more information, look hardware function in 'TargetSystemComponent' class.
406 -}
407 multiplier mock =
408 Multiplier
409 { remain = []
410 , targets = []
411 , sources = []
412 , currentWork = Nothing
413 , process_ = def
414 , isMocked = mock
415 }
416
417 -- | Default initial state of multiplier PU model.
418 instance Time t => Default (Multiplier v x t) where
419 def = multiplier True
420
421 instance Default x => DefaultX (Multiplier v x t) x
422
423 {- | This class is allowed to extract all bound functions. It has a very simple
424 implementation: we take process description (all planned functions), and
425 function in progress, if it is.
426 -}
427 instance Ord t => WithFunctions (Multiplier v x t) (F v x) where
428 functions Multiplier{process_, remain, currentWork} =
429 functions process_
430 ++ remain
431 ++ maybeToList currentWork
432
433 {- | Tracking internal dependencies on the processed variables. It includes:
434
435 - dependencies between inputs and outputs of currently evaluated function;
436
437 - dependencies of all remain functions from the currently evaluated function
438 (if it is).
439 -}
440 instance Var v => Locks (Multiplier v x t) v where
441 locks Multiplier{remain, sources, targets} =
442 [ Lock{lockBy, locked}
443 | locked <- sources
444 , lockBy <- targets
445 ]
446 ++ [ Lock{lockBy, locked}
447 | locked <- concatMap (S.elems . variables) remain
448 , lockBy <- sources ++ targets
449 ]
450 ++ concatMap locks remain
451
452 {- | That type classes ('BreakLoopProblem', 'OptimizeAccumProblem',
453 'ResolveDeadlockProblem', 'ConstantFoldingProblem') describes the possibility of PU to modify an
454 algorithm. Empty implementation means that multiplier PU doesn't have such
455 possibilities.
456 -}
457 instance BreakLoopProblem (Multiplier v x t) v x
458
459 instance ConstantFoldingProblem (Multiplier v x t) v x
460 instance OptimizeAccumProblem (Multiplier v x t) v x
461 instance OptimizeLogicalUnitProblem (Multiplier v x t) v x
462 instance ResolveDeadlockProblem (Multiplier v x t) v x
463
464 {- | This type class specifies how to bind functions to the PU. If it is
465 possible, @tryBind@ function will return @Right@ value with a new PU model
466 state. If not, @Left@ value with reason description. And also specify how to
467 get computation process description.
468
469 From the CAD point of view, bind looks like:
470
471 - CAD asks PU models: "Who can evaluate this function?" and get the list of
472 possible bindings.
473
474 - CAD, based on the different metrics (see 'NITTA.Synthesis'), the best variant
475 is chosen.
476
477 Binding can be done either gradually due synthesis process at the start.
478 -}
479 instance VarValTime v x t => ProcessorUnit (Multiplier v x t) v x t where
480 tryBind f pu@Multiplier{remain}
481 | Just F.Multiply{} <- castF f = Right pu{remain = f : remain}
482 | otherwise = Left $ "The function is unsupported by Multiplier: " ++ show f
483
484 -- Unified interface for getting computation process description.
485 process = process_
486
487 -- | Execute function (set as current and remove from remain).
488 execution pu@Multiplier{targets = [], sources = [], remain} f
489 | Just (F.Multiply (I a) (I b) (O c)) <- castF f =
490 pu
491 { targets = [a, b]
492 , currentWork = Just f
493 , sources = S.elems c
494 , remain = remain \\ [f]
495 }
496 execution _ _ = error "Multiplier: internal execution error."
497
498 {- | A computational process of PU from a hardware architectural perspective can
499 be described as a sequence of pushing and pulling values. From a synthesis
500 perspective, it is represented by 'EndpointProblem', which describes when PU
501 is a 'Source' or 'Target' of data transfers.
502
503 Work with endpoint problem implemented by only two functions:
504
505 __endpointOptions__ define what the possible synthesis decision is. It
506 includes three cases:
507
508 - Not a function is executed. That means that we have options to push any
509 input variables of remain functions.
510
511 - The function is executed, and not all arguments are received. We have
512 options to push remain variables.
513
514 - The function is executed, and all arguments are received. We have options
515 to pull the result from the multiplier, which can include several
516 variables. These variables can be got one by one or all at once because the
517 value will be written to the bus and read by several processor units on the
518 hardware level.
519
520 Note: an option don't specify moment for action but specify an available
521 interval ('NITTA.Model.Types.TimeConstraint'). That describes the interval for
522 action start and restriction on process duration.
523
524 __endpointDecision__ defines how to apply synthesis decision to the PU model.
525 It includes three cases:
526
527 - Push an input variable of the executed function. We need to schedule
528 instruction for endpoint action and modify the model state.
529
530 - Pull an output variable or variables of the executed function. We need to
531 schedule instruction for endpoint action and modify the model state.
532
533 - Push an input variable of a not executed function. In this case, we need to
534 find the selected function, 'execute' it, and do a recursive call with the
535 same decision.
536 -}
537 instance VarValTime v x t => EndpointProblem (Multiplier v x t) v t where
538 endpointOptions pu@Multiplier{targets}
539 | not $ null targets =
540 let at = nextTick pu ... maxBound
541 duration = 1 ... maxBound
542 in map (\v -> EndpointSt (Target v) $ TimeConstraint at duration) targets
543 endpointOptions Multiplier{sources, currentWork = Just f, process_}
544 | not $ null sources =
545 let doneAt = inputsPushedAt process_ f + 3
546 at = max doneAt (nextTick process_) ... maxBound
547 duration = 1 ... maxBound
548 in [EndpointSt (Source $ S.fromList sources) $ TimeConstraint at duration]
549 endpointOptions pu@Multiplier{remain} = concatMap (endpointOptions . execution pu) remain
550
551 endpointDecision pu@Multiplier{targets} d@EndpointSt{epRole = Target v, epAt}
552 | not $ null targets
553 , ([_], targets') <- partition (== v) targets
554 , -- Computation process planning is carried out.
555 let process_' = execSchedule pu $ do
556 -- this is required for correct work of automatically generated tests,
557 -- that takes information about time from Process
558 scheduleEndpoint d $ scheduleInstructionUnsafe epAt Load =
559 pu
560 { process_ = process_'
561 , -- The remainder of the work is saved for the next loop
562 targets = targets'
563 }
564 endpointDecision pu@Multiplier{targets = [], sources, currentWork = Just f, process_} d@EndpointSt{epRole = Source v, epAt}
565 | not $ null sources
566 , let sources' = sources \\ S.elems v
567 , sources' /= sources
568 , let a = inf $ stepsInterval $ relatedEndpoints process_ $ variables f
569 , -- Compututation process planning is carring on.
570 let process_' = execSchedule pu $ do
571 endpoints <- scheduleEndpoint d $ scheduleInstructionUnsafe epAt Out
572 when (null sources') $ do
573 -- Set up the vertical relantions between functional unit
574 -- and related to that data sending.
575
576 -- FIXME: here ([]) you can see the source of error.
577 -- Function don't connected to bind step. It should be fixed.
578 scheduleFunctionFinish_ [] f $ a ... sup epAt
579 -- this is needed to correct work of automatically generated tests
580 -- that takes time about time from Process
581 return endpoints =
582 pu
583 { process_ = process_'
584 , -- In case if not all variables what asked - remaining are saved.
585 sources = sources'
586 , -- if all of works is done, then time when result is ready,
587 -- current work and data transfering, what is done is the current function is reset.
588 currentWork = if null sources' then Nothing else Just f
589 }
590 endpointDecision pu@Multiplier{targets = [], sources = [], remain} d
591 | let v = oneOf $ variables d
592 , Just f <- find (\f -> v `S.member` variables f) remain =
593 endpointDecision (execution pu f) d
594 -- If something went wrong.
595 endpointDecision pu d = error [i|incorrect decision #{ d } for #{ pretty pu }|]
596
597 {- | For each PU, we can specify the instruction set and microcode, which allows
598 us to control the PU at the hardware level.
599
600 - instructions set describes a computation process from a programmer point of
601 view;
602
603 - microcode describes the structure of processors that controls signals.
604
605 The implementation had the internal register, which allows us to simply push the
606 data in the unit, without any specification of argument position. It will be
607 always a sequence of the first and second arguments.
608 -}
609 instance Controllable (Multiplier v x t) where
610 data Instruction (Multiplier v x t)
611 = Load
612 | Out
613 deriving (Show)
614
615 data Microcode (Multiplier v x t) = Microcode
616 { -- \| Write to mUnit signal.
617 wrSignal :: Bool
618 , -- \| Downloading from mUnit signal.
619 oeSignal :: Bool
620 }
621 deriving (Show, Eq, Ord)
622
623 zipSignalTagsAndValues MultiplierPorts{..} Microcode{..} =
624 [ (wr, Bool wrSignal)
625 , (oe, Bool oeSignal)
626 ]
627
628 usedPortTags MultiplierPorts{wr, oe} = [wr, oe]
629
630 takePortTags (wr : oe : _) _ = MultiplierPorts wr oe
631 takePortTags _ _ = error "can not take port tags, tags are over"
632
633 {- | Default microcode state should be equal to @nop@ function, which should be a
634 safe way to do nothing (not take a bus, not change internal PU state, etc.).
635 -}
636 instance Default (Microcode (Multiplier v x t)) where
637 def =
638 Microcode
639 { wrSignal = False
640 , oeSignal = False
641 }
642
643 {- | Instruction and microcode should have exact matching, which allows us to
644 translate PU instructions to microcode value.
645 -}
646 instance UnambiguouslyDecode (Multiplier v x t) where
647 decodeInstruction Load = def{wrSignal = True}
648 decodeInstruction Out = def{oeSignal = True}
649
650 {- | Processor unit control signal ports. In
651 'NITTA.Model.Networks.Bus.BusNetwork', these ports are directly connecting to
652 @ControlUnit@.
653 -}
654 instance Connected (Multiplier v x t) where
655 data Ports (Multiplier v x t) = MultiplierPorts
656 { -- \|get data from the bus (data_in)
657 wr :: SignalTag
658 , -- \|send result to the bus
659 oe :: SignalTag
660 }
661 deriving (Show)
662
663 instance IOConnected (Multiplier v x t) where
664 data IOPorts (Multiplier v x t) = MultiplierIO
665 deriving (Show)
666
667 {- | Usage of PU requires some artifacts of a synthesis process:
668
669 - Hardware implementation, which depends from 'isMocked' value:
670
671 - Software (not needed for the multiplier because it does not have any
672 configuration and is controlled from the network level).
673
674 - Hardware instance in the upper structure element.
675 -}
676 instance VarValTime v x t => TargetSystemComponent (Multiplier v x t) where
677 moduleName _title _pu = "pu_multiplier"
678
679 hardware _tag Multiplier{isMocked} =
680 Aggregate
681 Nothing
682 [ if isMocked
683 then FromLibrary "multiplier/mult_mock.v"
684 else FromLibrary "multiplier/mult_inner.v"
685 , FromLibrary "multiplier/pu_multiplier.v"
686 ]
687
688 software _ _ = Empty
689
690 hardwareInstance
691 tag
692 _pu
693 UnitEnv
694 { sigClk
695 , sigRst
696 , ctrlPorts = Just MultiplierPorts{..}
697 , valueIn = Just (dataIn, attrIn)
698 , valueOut = Just (dataOut, attrOut)
699 } =
700 [__i|
701 pu_multiplier \#
702 ( .DATA_WIDTH( #{ dataWidth (def :: x) } )
703 , .ATTR_WIDTH( #{ attrWidth (def :: x) } )
704 , .SCALING_FACTOR_POWER( #{ fractionalBitSize (def :: x) } )
705 , .INVALID( 0 )
706 ) #{ tag }
707 ( .clk( #{ sigClk } )
708 , .rst( #{ sigRst } )
709 , .signal_wr( #{ wr } )
710 , .data_in( #{ dataIn } )
711 , .attr_in( #{ attrIn } )
712 , .signal_oe( #{ oe } )
713 , .data_out( #{ dataOut } )
714 , .attr_out( #{ attrOut } )
715 );
716 |]
717 hardwareInstance _title _pu _env = error "internal error"
718
719 {- | Empty implementation of 'NITTA.Project.TestBench.IOTestBench' class
720 means that multiplier, as expected, doesn't have any IO.
721 -}
722 instance IOTestBench (Multiplier v x t) v x
723
724 {- | The main purpose of this class is to generate autotests for PU. It allows to
725 generate testbench for the PU according to its model and scheduled computational
726 process. You can see tests in @test/Spec.hs@. Testbench contains:
727
728 - The sequence of control signals that implement the already scheduled process.
729
730 - The sequence of bus state checks in which we compare actual values with the
731 results of the functional simulation.
732 -}
733 instance VarValTime v x t => Testable (Multiplier v x t) v x where
734 testBenchImplementation prj@Project{pName, pUnit} =
735 Immediate (toString $ moduleName pName pUnit <> "_tb.v") $
736 snippetTestBench
737 prj
738 SnippetTestBenchConf
739 { -- List of control signals. It is needed to initialize
740 -- registers with the same names.
741 tbcSignals = ["oe", "wr"]
742 , -- A processor unit connects to the environment by signal
743 -- lines. In 'NITTA.Project.TestBench.tbcPorts'
744 -- describes IDs signal lines of testbench. In
745 -- 'NITTA.Project.TestBench.tbcSignalConnect' how
746 -- abstract numbers are translate to source code.
747 tbcPorts =
748 MultiplierPorts
749 { oe = SignalTag "oe"
750 , wr = SignalTag "wr"
751 }
752 , -- Map microcode to registers in the testbench.
753 tbcMC2verilogLiteral = \Microcode{oeSignal, wrSignal} ->
754 [i|oe <= #{bool2verilog oeSignal};|]
755 <> [i| wr <= #{bool2verilog wrSignal};|]
756 }