never executed always true always false
1 {-# LANGUAGE FunctionalDependencies #-}
2 {-# LANGUAGE OverloadedStrings #-}
3 {-# LANGUAGE QuasiQuotes #-}
4 {-# LANGUAGE TypeFamilies #-}
5
6 {- |
7 Module : NITTA.Project.TestBench
8 Description : Generation a test bench for the target system.
9 Copyright : (c) Aleksandr Penskoi, 2019
10 License : BSD3
11 Maintainer : aleksandr.penskoi@gmail.com
12 Stability : experimental
13 -}
14 module NITTA.Project.TestBench (
15 Testable (..),
16 IOTestBench (..),
17 TestEnvironment (..),
18 TestbenchReport (..),
19 testBenchTopModuleName,
20 verilogProjectFiles,
21 SnippetTestBenchConf (..),
22 snippetTestBench,
23 ) where
24
25 import Data.Default
26 import Data.HashMap.Strict qualified as HM
27 import Data.List qualified as L
28 import Data.String.Interpolate
29 import Data.String.ToString
30 import Data.String.Utils qualified as S
31 import Data.Text qualified as T
32 import Data.Typeable
33 import GHC.Generics (Generic)
34 import NITTA.Intermediate.Types
35 import NITTA.Model.Problems
36 import NITTA.Model.ProcessorUnits.Types
37
38 import NITTA.Project.Types
39 import NITTA.Project.VerilogSnippets
40 import NITTA.Utils
41 import Prettyprinter
42 import System.FilePath.Posix (joinPath, (</>))
43
44 -- | Type class for all testable parts of a target system.
45 class Testable m v x | m -> v x where
46 testBenchImplementation :: Project m v x -> Implementation
47
48 {- | Processor units with input/output ports should be tested by generation
49 external input ports signals and checking output port signals.
50 -}
51 class IOTestBench pu v x | pu -> v x where
52 testEnvironmentInitFlag :: T.Text -> pu -> Maybe T.Text
53 testEnvironmentInitFlag _title _pu = Nothing
54
55 testEnvironment :: T.Text -> pu -> UnitEnv pu -> TestEnvironment v x -> Maybe Verilog
56 testEnvironment _title _pu _env _tEnv = Nothing
57
58 -- | Information required for testbench generation.
59 data TestEnvironment v x = TestEnvironment
60 { teCntx :: Cntx v x
61 -- ^ expected data
62 , teComputationDuration :: Int
63 -- ^ duration of computational process
64 }
65
66 data TestbenchReport v x = TestbenchReport
67 { tbStatus :: Bool
68 , tbPath :: FilePath
69 , tbFiles :: [FilePath]
70 , tbFunctions :: [T.Text]
71 , tbSynthesisSteps :: [T.Text]
72 , tbCompilerDump :: T.Text
73 , tbSimulationDump :: T.Text
74 , tbFunctionalSimulationLog :: [HM.HashMap v x]
75 , tbLogicalSimulationLog :: [HM.HashMap v x]
76 }
77 deriving (Generic)
78
79 instance (ToString v, Show x) => Show (TestbenchReport v x) where
80 show
81 TestbenchReport
82 { tbPath
83 , tbFiles
84 , tbFunctions
85 , tbSynthesisSteps
86 , tbCompilerDump
87 , tbSimulationDump
88 } =
89 (show :: Doc () -> String)
90 [__i|
91 Project: #{ tbPath }
92 Files:
93 #{ nest 4 $ vsep $ map pretty tbFiles }
94 Functional blocks:
95 #{ nest 4 $ vsep $ map pretty tbFunctions }
96 Steps:
97 #{ nest 4 $ vsep $ map pretty tbSynthesisSteps }
98 compiler dump:
99 #{ nest 4 $ pretty tbCompilerDump }
100 simulation dump:
101 #{ nest 4 $ pretty tbSimulationDump }
102 |]
103
104 -- | Get name of testbench top module.
105 testBenchTopModuleName ::
106 (TargetSystemComponent m, Testable m v x) => Project m v x -> FilePath
107 testBenchTopModuleName prj = S.replace ".v" "" $ last $ verilogProjectFiles prj
108
109 -- | Generate list of project verilog files (including testbench).
110 verilogProjectFiles prj@Project{pName, pUnit, pInProjectNittaPath} =
111 map
112 (pInProjectNittaPath </>)
113 $ L.nub
114 $ filter (".v" `L.isSuffixOf`)
115 $ concatMap
116 (addPath "")
117 [hardware pName pUnit, testBenchImplementation prj]
118 where
119 addPath p (Aggregate (Just p') subInstances) = concatMap (addPath $ joinPath [p, p']) subInstances
120 addPath p (Aggregate Nothing subInstances) = concatMap (addPath $ joinPath [p]) subInstances
121 addPath p (Immediate fn _) = [joinPath [p, fn]]
122 addPath _ (FromLibrary fn) = [joinPath ["lib", fn]]
123 addPath _ Empty = []
124
125 -- | Data Type for SnippetTestBench function
126 data SnippetTestBenchConf m = SnippetTestBenchConf
127 { tbcSignals :: [T.Text]
128 , tbcPorts :: Ports m
129 , tbcMC2verilogLiteral :: Microcode m -> T.Text
130 }
131
132 -- | Function for testBench PU test
133 snippetTestBench ::
134 forall m v x t.
135 ( WithFunctions m (F v x)
136 , ProcessorUnit m v x t
137 , TargetSystemComponent m
138 , UnambiguouslyDecode m
139 , Typeable m
140 , Show (Instruction m)
141 , Default (Microcode m)
142 ) =>
143 Project m v x ->
144 SnippetTestBenchConf m ->
145 T.Text
146 snippetTestBench
147 Project{pName, pUnit, pTestCntx = Cntx{cntxProcess}, pUnitEnv}
148 SnippetTestBenchConf{tbcSignals, tbcPorts, tbcMC2verilogLiteral} =
149 let cycleCntx = head cntxProcess
150 name = moduleName pName pUnit
151 p@Process{steps} = process pUnit
152 fs = functions pUnit
153 inst =
154 hardwareInstance
155 pName
156 pUnit
157 pUnitEnv
158 { ctrlPorts = Just tbcPorts
159 , valueIn = Just ("data_in", "attr_in")
160 , valueOut = Just ("data_out", "attr_out")
161 }
162 controlSignals =
163 map
164 ( \t ->
165 let setSignals = pretty $ tbcMC2verilogLiteral (microcodeAt pUnit t)
166 x = targetVal t
167 setValueBus = [i|data_in <= #{ dataLiteral x }; attr_in <= #{ attrLiteral x };|]
168 in setSignals <> " " <> setValueBus <> " @(posedge clk);"
169 )
170 [0 .. nextTick p + 1]
171 targetVal t
172 | Just (Target v) <- endpointAt t p =
173 getCntx cycleCntx v
174 | otherwise = 0
175 busCheck = map busCheck' [0 .. nextTick p + 1]
176 where
177 busCheck' t
178 | Just (Source vs) <- endpointAt t p =
179 let v = oneOf vs
180 x = getCntx cycleCntx v
181 in [i|@(posedge clk); assertWithAttr(0, 0, data_out, attr_out, #{ dataLiteral x }, #{ attrLiteral x }, "#{ toString v }");|]
182 | otherwise =
183 [i|@(posedge clk); traceWithAttr(0, 0, data_out, attr_out);|]
184 tbcSignals' = map (\x -> [i|reg #{x};|]) tbcSignals
185 in doc2text
186 [__i|
187 module #{name}_tb();
188
189 parameter DATA_WIDTH = #{ dataWidth (def :: x) };
190 parameter ATTR_WIDTH = #{ attrWidth (def :: x) };
191
192 /*
193 Algorithm:
194 #{ nest 4 $ vsep $ map viaShow fs }
195 Process:
196 #{ nest 4 $ vsep $ map viaShow $ reverse steps }
197 Context:
198 #{ nest 4 $ viaShow cycleCntx }
199 */
200
201 reg clk, rst;
202 #{ vsep tbcSignals' }
203 reg [DATA_WIDTH-1:0] data_in;
204 reg [ATTR_WIDTH-1:0] attr_in;
205 wire [DATA_WIDTH-1:0] data_out;
206 wire [ATTR_WIDTH-1:0] attr_out;
207
208 #{ inst }
209
210 #{ snippetClkGen }
211 #{ snippetDumpFile name }
212
213 initial begin
214 @(negedge rst);
215 #{nest 4 $ vsep controlSignals}
216 $finish;
217 end
218
219 initial begin
220 @(negedge rst);
221 #{ nest 4 $ vsep busCheck }
222 $finish;
223 end
224
225 #{ verilogHelper (def :: x) }
226
227 endmodule
228 |]