never executed always true always false
1 {-# LANGUAGE DuplicateRecordFields #-}
2 {-# LANGUAGE OverloadedStrings #-}
3 {-# LANGUAGE QuasiQuotes #-}
4 {-# LANGUAGE RecordWildCards #-}
5 {-# LANGUAGE StandaloneDeriving #-}
6 {-# LANGUAGE TypeFamilies #-}
7
8 {- |
9 Module : NITTA.Model.ProcessorUnits.Broken
10 Description : Process Unit for negative tests
11 Copyright : (c) Aleksandr Penskoi, 2020
12 License : BSD3
13 Maintainer : aleksandr.penskoi@gmail.com
14 Stability : experimental
15 -}
16 module NITTA.Model.ProcessorUnits.Broken (
17 Broken (..),
18 Ports (..),
19 IOPorts (..),
20 ) where
21
22 import Control.Monad
23 import Data.Default
24 import Data.List (find, (\\))
25 import Data.Set (elems, fromList, member)
26 import Data.String.Interpolate
27 import Data.String.ToString
28 import Data.Text qualified as T
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 (sup, (...))
38 import Numeric.Interval.NonEmpty qualified as I
39 import Prettyprinter
40
41 data Broken v x t = Broken
42 { remain :: [F v x]
43 , targets :: [v]
44 , sources :: [v]
45 , doneAt :: Maybe t
46 , currentWork :: Maybe (t, F v x)
47 , currentWorkEndpoints :: [ProcessStepID]
48 , process_ :: Process t (StepInfo v x t)
49 , brokeVerilog :: Bool
50 -- ^ generate verilog code with syntax error
51 , wrongVerilogSimulationValue :: Bool
52 -- ^ use process unit HW implementation with error
53 , wrongControlOnPush :: Bool
54 -- ^ wrong control sequence for data push (receiving data to PU)
55 , wrongControlOnPull :: Bool
56 -- ^ wrong control sequence for data pull (sending data from PU)
57 , lostEndpointTarget :: Bool
58 -- ^ lost target endpoint due synthesis
59 , lostEndpointSource :: Bool
60 -- ^ lost source endpoint due synthesis
61 , wrongAttr :: Bool
62 , lostFunctionInVerticalRelation :: Bool
63 , lostEndpointInVerticalRelation :: Bool
64 , lostInstructionInVerticalRelation :: Bool
65 , unknownDataOut :: Bool
66 }
67
68 instance VarValTime v x t => Pretty (Broken v x t) where
69 pretty Broken{..} =
70 [__i|
71 Broken:
72 remain:#{ remain }
73 targets:#{ map toString targets }
74 sources:#{ map toString sources }
75 currentWork: #{ currentWork }
76 currentWorkEndpoints: #{ currentWorkEndpoints }
77 brokeVerilog: #{ brokeVerilog }
78 wrongVerilogSimulationValue: #{ wrongVerilogSimulationValue }
79 wrongControlOnPush: #{ wrongControlOnPush }
80 wrongControlOnPull: #{ wrongControlOnPull }
81 lostEndpointTarget: #{ lostEndpointTarget }
82 lostEndpointSource: #{ lostEndpointSource }
83 wrongAttr: #{ wrongAttr }
84 unknownDataOut: #{ unknownDataOut }
85 #{ indent 4 $ pretty $ process_ }
86 |]
87
88 instance Var v => Locks (Broken v x t) v where
89 locks Broken{remain, sources, targets} =
90 [ Lock{lockBy, locked}
91 | locked <- sources
92 , lockBy <- targets
93 ]
94 ++ [ Lock{lockBy, locked}
95 | locked <- concatMap (elems . variables) remain
96 , lockBy <- sources ++ targets
97 ]
98
99 instance BreakLoopProblem (Broken v x t) v x
100 instance ConstantFoldingProblem (Broken v x t) v x
101 instance OptimizeAccumProblem (Broken v x t) v x
102 instance OptimizeLogicalUnitProblem (Broken v x t) v x
103 instance ResolveDeadlockProblem (Broken v x t) v x
104
105 instance VarValTime v x t => ProcessorUnit (Broken v x t) v x t where
106 tryBind f pu@Broken{remain}
107 | Just F.BrokenBuffer{} <- castF f = Right pu{remain = f : remain}
108 | otherwise = Left $ "The function is unsupported by Broken: " ++ show f
109 process = process_
110
111 execution pu@Broken{targets = [], sources = [], remain, process_} f
112 | Just (F.BrokenBuffer (I x) (O y)) <- castF f =
113 pu
114 { targets = [x]
115 , sources = elems y
116 , currentWork = Just (nextTick process_, f)
117 , remain = remain \\ [f]
118 }
119 execution _ _ = error "Broken: internal execution error."
120
121 instance VarValTime v x t => EndpointProblem (Broken v x t) v t where
122 endpointOptions Broken{targets = [_], lostEndpointTarget = True} = []
123 endpointOptions pu@Broken{targets = [v]} =
124 let start = nextTick pu `withShift` 1 ... maxBound
125 dur = 1 ... maxBound
126 in [EndpointSt (Target v) $ TimeConstraint start dur]
127 endpointOptions Broken{doneAt = Just _, lostEndpointSource = True} = []
128 endpointOptions pu@Broken{sources, doneAt = Just at}
129 | not $ null sources =
130 let start = max at (nextTick pu + 1) ... maxBound
131 dur = 1 ... maxBound
132 in [EndpointSt (Source $ fromList sources) $ TimeConstraint start dur]
133 endpointOptions pu@Broken{remain, lostEndpointTarget = True}
134 | not $ null remain = concatMap (endpointOptions . execution pu) $ tail remain
135 endpointOptions pu@Broken{remain} = concatMap (endpointOptions . execution pu) remain
136
137 endpointDecision pu@Broken{targets = [v], currentWorkEndpoints, wrongControlOnPush} d@EndpointSt{epRole = Target v', epAt}
138 | v == v' =
139 let workAt = epAt + I.singleton (if wrongControlOnPush then 1 else 0)
140 (newEndpoints, process_') = runSchedule pu $ do
141 scheduleEndpoint d $ scheduleInstructionUnsafe workAt Load
142 in pu
143 { process_ = process_'
144 , targets = []
145 , currentWorkEndpoints = newEndpoints ++ currentWorkEndpoints
146 , doneAt = Just $ sup epAt + 3
147 }
148 endpointDecision
149 pu@Broken
150 { targets = [v]
151 , currentWorkEndpoints
152 , wrongControlOnPush
153 , lostEndpointInVerticalRelation
154 , lostInstructionInVerticalRelation
155 }
156 d@EndpointSt{epRole = Target v', epAt}
157 | v == v'
158 , let (newEndpoints, process_') = runSchedule pu $ do
159 let ins =
160 if lostInstructionInVerticalRelation
161 then return []
162 else scheduleInstructionUnsafe (shiftI (if wrongControlOnPush then 1 else 0) epAt) Load
163
164 if lostEndpointInVerticalRelation
165 then return []
166 else scheduleEndpoint d ins =
167 pu
168 { process_ = process_'
169 , targets = []
170 , currentWorkEndpoints = newEndpoints ++ currentWorkEndpoints
171 , doneAt = Just $ sup epAt + 3
172 }
173 endpointDecision
174 pu@Broken
175 { targets = []
176 , sources
177 , doneAt
178 , currentWork = Just (a, f)
179 , currentWorkEndpoints
180 , wrongControlOnPull
181 , lostFunctionInVerticalRelation
182 , lostEndpointInVerticalRelation
183 , lostInstructionInVerticalRelation
184 }
185 EndpointSt{epRole = epRole@(Source v), epAt}
186 | not $ null sources
187 , let sources' = sources \\ elems v
188 , sources' /= sources
189 , let (newEndpoints, process_') = runSchedule pu $ do
190 let doAt = shiftI (if wrongControlOnPull then 0 else -1) epAt
191 -- Inlined: endpoints <- scheduleEndpoint d $ scheduleInstructionUnsafe doAt Out
192 endpoints <- do
193 high <- scheduleStep epAt $ EndpointRoleStep epRole
194 low <- scheduleInstructionUnsafe doAt Out
195 establishVerticalRelations
196 (if lostEndpointInVerticalRelation then [] else high)
197 (if lostInstructionInVerticalRelation then [] else low)
198 return high
199 when (null sources') $ do
200 high <- scheduleFunction (a ... sup epAt) f
201 let low = endpoints ++ currentWorkEndpoints
202 establishVerticalRelations
203 (if lostFunctionInVerticalRelation then [] else high)
204 (if lostEndpointInVerticalRelation then [] else low)
205 return endpoints =
206 pu
207 { process_ = process_'
208 , sources = sources'
209 , doneAt = if null sources' then Nothing else doneAt
210 , currentWork = if null sources' then Nothing else Just (a, f)
211 , currentWorkEndpoints = if null sources' then [] else newEndpoints ++ currentWorkEndpoints
212 }
213 endpointDecision pu@Broken{targets = [], sources = [], remain} d
214 | let v = oneOf $ variables d
215 , Just f <- find (\f -> v `member` variables f) remain =
216 endpointDecision (execution pu f) d
217 endpointDecision pu d = error [i|incorrect decision #{ d } for #{ pretty pu }|]
218
219 instance Controllable (Broken v x t) where
220 data Instruction (Broken v x t)
221 = Load
222 | Out
223 deriving (Show)
224
225 data Microcode (Broken v x t) = Microcode
226 { wrSignal :: Bool
227 , oeSignal :: Bool
228 }
229 deriving (Show, Eq, Ord)
230
231 zipSignalTagsAndValues BrokenPorts{..} Microcode{..} =
232 [ (wr, Bool wrSignal)
233 , (oe, Bool oeSignal)
234 ]
235
236 usedPortTags BrokenPorts{wr, oe} = [wr, oe]
237
238 takePortTags (wr : oe : _) _ = BrokenPorts wr oe
239 takePortTags _ _ = error "can not take port tags, tags are over"
240
241 instance Default (Microcode (Broken v x t)) where
242 def =
243 Microcode
244 { wrSignal = False
245 , oeSignal = False
246 }
247
248 instance Time t => Default (Broken v x t) where
249 def =
250 Broken
251 { remain = []
252 , targets = []
253 , sources = []
254 , doneAt = Nothing
255 , currentWork = Nothing
256 , currentWorkEndpoints = []
257 , process_ = def
258 , brokeVerilog = False
259 , wrongVerilogSimulationValue = False
260 , wrongControlOnPush = False
261 , wrongControlOnPull = False
262 , lostEndpointTarget = False
263 , lostEndpointSource = False
264 , wrongAttr = False
265 , lostFunctionInVerticalRelation = False
266 , lostEndpointInVerticalRelation = False
267 , lostInstructionInVerticalRelation = False
268 , unknownDataOut = False
269 }
270
271 instance Default x => DefaultX (Broken v x t) x
272
273 instance UnambiguouslyDecode (Broken v x t) where
274 decodeInstruction Load = def{wrSignal = True}
275 decodeInstruction Out = def{oeSignal = True}
276
277 instance Connected (Broken v x t) where
278 data Ports (Broken v x t) = BrokenPorts
279 { wr :: SignalTag
280 , oe :: SignalTag
281 }
282 deriving (Show)
283
284 instance IOConnected (Broken v x t) where
285 data IOPorts (Broken v x t) = BrokenIO
286 deriving (Show)
287
288 instance VarValTime v x t => TargetSystemComponent (Broken v x t) where
289 moduleName _title _pu = "pu_broken"
290 software _ _ = Empty
291 hardware _tag _pu = Aggregate Nothing [FromLibrary "pu_broken.v"]
292
293 hardwareInstance
294 tag
295 pu@Broken{brokeVerilog, wrongVerilogSimulationValue, wrongAttr, unknownDataOut}
296 UnitEnv
297 { sigClk
298 , ctrlPorts = Just BrokenPorts{..}
299 , valueIn = Just (dataIn, attrIn)
300 , valueOut = Just (dataOut, attrOut)
301 } =
302 [__i|
303 /*
304 #{ pretty pu }
305 */
306 pu_broken \#
307 ( .DATA_WIDTH( #{ dataWidth (def :: x) } )
308 , .ATTR_WIDTH( #{ attrWidth (def :: x) } )
309 , .IS_BROKEN( #{ bool2verilog wrongVerilogSimulationValue } )
310 , .WRONG_ATTR( #{ bool2verilog wrongAttr } )
311 , .UNKNOWN_DATA_OUT( #{ bool2verilog unknownDataOut } )
312 ) #{ tag }
313 ( .clk( #{ sigClk } )
314
315 , .signal_wr( #{ wr } )
316 , .data_in( #{ dataIn } ), .attr_in( #{ attrIn } )
317
318 , .signal_oe( #{ oe } )
319 , .data_out( #{ dataOut } ), .attr_out( #{ attrOut } )
320 #{ if brokeVerilog then "WRONG VERILOG" else "" :: T.Text }
321 );
322 |]
323 hardwareInstance _title _pu _env = error "internal error"
324
325 instance IOTestBench (Broken v x t) v x
326
327 instance Ord t => WithFunctions (Broken v x t) (F v x) where
328 functions Broken{process_, remain, currentWork} =
329 functions process_
330 ++ remain
331 ++ case currentWork of
332 Just (_, f) -> [f]
333 Nothing -> []
334
335 instance VarValTime v x t => Testable (Broken v x t) v x where
336 testBenchImplementation prj@Project{pName, pUnit} =
337 Immediate (toString $ moduleName pName pUnit <> "_tb.v") $
338 snippetTestBench
339 prj
340 SnippetTestBenchConf
341 { tbcSignals = ["oe", "wr"]
342 , tbcPorts =
343 BrokenPorts
344 { oe = SignalTag "oe"
345 , wr = SignalTag "wr"
346 }
347 , tbcMC2verilogLiteral = \Microcode{oeSignal, wrSignal} ->
348 [i|oe <= #{ bool2verilog oeSignal }; wr <= #{ bool2verilog wrSignal };|]
349 }