never executed always true always false
    1 {-# LANGUAGE AllowAmbiguousTypes #-}
    2 {-# LANGUAGE OverloadedStrings #-}
    3 {-# LANGUAGE QuasiQuotes #-}
    4 
    5 {- |
    6 Module      : NITTA.Project
    7 Description :
    8 Copyright   : (c) Aleksandr Penskoi, 2021
    9 License     : BSD3
   10 Maintainer  : aleksandr.penskoi@gmail.com
   11 Stability   : experimental
   12 -}
   13 module NITTA.Project (
   14     module NITTA.Project.Template,
   15     module NITTA.Project.TestBench,
   16     module NITTA.Project.Types,
   17     module NITTA.Project.VerilogSnippets,
   18     writeProject,
   19     runTestbench,
   20 ) where
   21 
   22 import Control.Exception
   23 import Control.Monad.Identity (runIdentity)
   24 import Data.HashMap.Strict qualified as HM
   25 import Data.List qualified as L
   26 import Data.Maybe
   27 import Data.String
   28 import Data.String.Interpolate (__i)
   29 import Data.String.ToString
   30 import Data.Text qualified as T
   31 import Data.Text.IO qualified as T
   32 import NITTA.Intermediate.Types
   33 import NITTA.Model.ProcessorUnits.Types
   34 import NITTA.Project.Context
   35 import NITTA.Project.Template
   36 import NITTA.Project.TestBench
   37 import NITTA.Project.Types
   38 import NITTA.Project.VerilogSnippets
   39 import NITTA.Utils.Base
   40 import System.Directory
   41 import System.Exit
   42 import System.FilePath.Posix
   43 import System.Log.Logger
   44 import System.Process.ListLike (CreateProcess (..), proc)
   45 import System.Process.Text
   46 import Text.Ginger hiding (length)
   47 import Text.Regex
   48 
   49 -- | Write project with all available parts.
   50 writeProject prj@Project{pTargetProjectPath} = do
   51     infoM "NITTA" $ "write target project to: \"" <> pTargetProjectPath <> "\"..."
   52     writeTargetSystem prj
   53     writeTestBench prj
   54     writeRenderedTemplates prj
   55     noticeM "NITTA" $ "write target project to: \"" <> pTargetProjectPath <> "\"...ok"
   56 
   57 writeTargetSystem prj@Project{pName, pTargetProjectPath, pInProjectNittaPath, pUnit} = do
   58     createDirectoryIfMissing True $ pTargetProjectPath </> pInProjectNittaPath
   59     writeImplementation prj $ hardware pName pUnit
   60     writeImplementation prj $ software pName pUnit
   61     copyLibraryFiles prj
   62 
   63 writeTestBench prj@Project{pTargetProjectPath, pInProjectNittaPath} = do
   64     createDirectoryIfMissing True $ pTargetProjectPath </> pInProjectNittaPath
   65     writeImplementation prj $ testBenchImplementation prj
   66 
   67 runTestbench prj@Project{pTargetProjectPath, pUnit, pTestCntx = Cntx{cntxProcess, cntxCycleNumber}} = do
   68     infoM "NITTA" $ "run logical synthesis(" <> pTargetProjectPath <> ")..."
   69     let files = verilogProjectFiles prj
   70     wd <- getCurrentDirectory
   71 
   72     (compileExitCode, compileOut, compileErr) <- do
   73         res <- try $ readCreateProcessWithExitCode (createIVerilogProcess pTargetProjectPath files) ""
   74         case res of
   75             Left (_ :: IOException) ->
   76                 error
   77                     ( [__i|iverilog is not available on your system
   78                            try to install it:
   79                                 MacOS: $ brew install icarus-verilog
   80                                 Ubuntu: $ sudo apt-get install iverilog 
   81                         |] ::
   82                         String
   83                     )
   84             Right val -> return val
   85 
   86     let isCompileOk = compileExitCode == ExitSuccess && T.null compileErr
   87 
   88     (simExitCode, simOut, simErr) <-
   89         readCreateProcessWithExitCode (proc "vvp" ["a.out"]){cwd = Just pTargetProjectPath} ""
   90     let isSimOk = simExitCode == ExitSuccess && not ("FAIL" `T.isInfixOf` simOut)
   91 
   92     let tbStatus = isCompileOk && isSimOk
   93         tbCompilerDump = dump compileOut compileErr
   94         tbSimulationDump = dump simOut simErr
   95 
   96     if tbStatus
   97         then noticeM "NITTA" $ "run testbench (" <> pTargetProjectPath <> ")...ok"
   98         else do
   99             noticeM "NITTA" $ "run testbench (" <> pTargetProjectPath <> ")...fail"
  100             noticeM "NITTA" "-----------------------------------------------------------"
  101             noticeM "NITTA" "testbench compiler dump:"
  102             noticeM "NITTA" $ T.unpack tbCompilerDump
  103             noticeM "NITTA" "-----------------------------------------------------------"
  104             noticeM "NITTA" "testbench simulation dump:"
  105             noticeM "NITTA" $ T.unpack tbSimulationDump
  106     return
  107         TestbenchReport
  108             { tbStatus
  109             , tbPath = joinPath [wd, pTargetProjectPath]
  110             , tbFiles = files
  111             , tbFunctions = map showText $ functions pUnit
  112             , tbSynthesisSteps = map showText $ steps $ process pUnit
  113             , tbCompilerDump
  114             , tbSimulationDump
  115             , tbFunctionalSimulationLog = map cycleCntx $ take cntxCycleNumber cntxProcess
  116             , tbLogicalSimulationLog = log2hms $ extractLogValues (defX pUnit) $ T.unpack simOut
  117             }
  118     where
  119         createIVerilogProcess workdir files = (proc "iverilog" files){cwd = Just workdir}
  120         dump "" "" = ""
  121         dump out err = "stdout:\n" <> out <> "stderr:\n" <> err
  122 
  123 extractLogValues x0 text = mapMaybe f $ lines text
  124     where
  125         f s = case matchRegex (verilogAssertRE x0) $ toString s of
  126             Just [c, _t, x, _e, v] -> Just (read c, fromString $ toString v, read x)
  127             _ -> Nothing
  128 
  129 log2hms lst0 = cntxProcess
  130     where
  131         cntxProcess = inner (0 :: Int) lst0
  132         inner n lst
  133             | (xs, ys) <- L.partition (\(c, _v, _x) -> c == n) lst
  134             , not $ null xs =
  135                 let cycleCntx = HM.fromList $ map (\(_c, v, x) -> (v, x)) xs
  136                  in cycleCntx : inner (n + 1) ys
  137             | otherwise = []
  138 
  139 -- | Ginger is powerfull but slow down testing two times.
  140 enableGingerForImplementation = True
  141 
  142 -- | Write 'Implementation' to the file system.
  143 writeImplementation prj@Project{pTargetProjectPath = prjPath, pInProjectNittaPath = nittaPath} impl = writeImpl nittaPath impl
  144     where
  145         writeImpl p (Immediate fn src0) | enableGingerForImplementation = do
  146             let src = T.unpack src0
  147                 implCtx = implementationContext prj p
  148             template <-
  149                 either (error . formatParserError (Just src)) return <$> runIdentity $
  150                     parseGinger (const $ return Nothing) Nothing src
  151             T.writeFile (joinPath [prjPath, p, fn]) $ runGinger implCtx template
  152         writeImpl p (Immediate fn src0) =
  153             T.writeFile (joinPath [prjPath, p, fn]) $ T.replace "{{ nitta.paths.nest }}" (T.pack p) src0
  154         writeImpl p (Aggregate p' subInstances) = do
  155             let path = joinPath $ maybe [p] (\x -> [p, x]) p'
  156             createDirectoryIfMissing True $ joinPath [prjPath, path]
  157             mapM_ (writeImpl path) subInstances
  158         writeImpl _ (FromLibrary _) = return ()
  159         writeImpl _ Empty = return ()
  160 
  161 -- | Copy library files to target path.
  162 copyLibraryFiles prj = mapM_ (copyLibraryFile prj) $ libraryFiles prj
  163     where
  164         copyLibraryFile Project{pTargetProjectPath, pInProjectNittaPath, pLibPath} file = do
  165             let fullNittaPath = joinPath [pTargetProjectPath, pInProjectNittaPath]
  166             source <- makeAbsolute $ normalise $ joinPath [pLibPath, file]
  167             target <- makeAbsolute $ normalise $ joinPath [fullNittaPath, "lib", file]
  168             directory <- makeAbsolute $ normalise $ joinPath [fullNittaPath, "lib", takeDirectory file]
  169 
  170             createDirectoryIfMissing True directory
  171             copyFile source target
  172 
  173         libraryFiles Project{pName, pUnit} =
  174             L.nub $ args "" $ hardware pName pUnit
  175             where
  176                 args p (Aggregate (Just p') subInstances) = concatMap (args $ joinPath [p, p']) subInstances
  177                 args p (Aggregate Nothing subInstances) = concatMap (args p) subInstances
  178                 args _ (FromLibrary fn) = [fn]
  179                 args _ _ = []