From 1374e08e67a9c3cedeaaddbf381b03260194a803 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Grave Date: Fri, 1 Mar 2019 12:32:21 +0000 Subject: [Fix #37] Fix types in the simulator with more general functions --- src/VeriFuzz/Icarus.hs | 16 +++++------ src/VeriFuzz/XST.hs | 28 +++++++++---------- src/VeriFuzz/Yosys.hs | 74 ++++++++++++++++++++++++++++---------------------- 3 files changed, 63 insertions(+), 55 deletions(-) (limited to 'src') diff --git a/src/VeriFuzz/Icarus.hs b/src/VeriFuzz/Icarus.hs index 3d62c23..0a807dc 100644 --- a/src/VeriFuzz/Icarus.hs +++ b/src/VeriFuzz/Icarus.hs @@ -12,7 +12,6 @@ Icarus verilog module. module VeriFuzz.Icarus where -import Control.Lens import Crypto.Hash (Digest, hash) import Crypto.Hash.Algorithms (SHA256) import Data.Binary (encode) @@ -32,18 +31,18 @@ import Prelude hiding (FilePath) import Shelly import VeriFuzz.AST import VeriFuzz.CodeGen -import VeriFuzz.General -import VeriFuzz.Internal.AST +import VeriFuzz.Internal import VeriFuzz.Mutate data Icarus = Icarus { icarusPath :: FilePath , vvpPath :: FilePath } + deriving (Eq, Show) -instance Simulator Icarus where +instance Tool Icarus where toText _ = "iverilog" -instance Simulate Icarus where +instance Simulator Icarus where runSim = runSimIcarus runSimWithFile = runSimIcarusWithFile @@ -78,20 +77,21 @@ mask = T.replace "x" "0" callback :: ByteString -> Text -> ByteString callback b t = b <> convert (mask t) -runSimIcarus :: Icarus -> ModDecl -> [ByteString] -> Sh ByteString -runSimIcarus sim m bss = do +runSimIcarus :: Icarus -> SourceInfo -> [ByteString] -> Sh ByteString +runSimIcarus sim rinfo bss = do let tb = ModDecl "main" [] [] [ Initial - $ fold (addDisplay $ assignFunc (m ^. modInPorts) <$> bss) + $ fold (addDisplay $ assignFunc (_modInPorts m) <$> bss) <> (SysTaskEnable $ Task "finish" []) ] let newtb = instantiateMod m tb let modWithTb = VerilogSrc $ Description <$> [newtb, m] writefile "main.v" $ genSource modWithTb runSimWithFile sim "main.v" bss + where m = mainModule rinfo runSimIcarusWithFile :: Icarus -> FilePath -> [ByteString] -> Sh ByteString runSimIcarusWithFile sim f _ = do diff --git a/src/VeriFuzz/XST.hs b/src/VeriFuzz/XST.hs index e8e3a72..337ad2e 100644 --- a/src/VeriFuzz/XST.hs +++ b/src/VeriFuzz/XST.hs @@ -14,34 +14,32 @@ Xst (ise) simulator implementation. module VeriFuzz.XST where -import Prelude hiding (FilePath) +import Prelude hiding (FilePath) import Shelly -import Text.Shakespeare.Text (st) -import VeriFuzz.AST +import Text.Shakespeare.Text (st) import VeriFuzz.CodeGen -import VeriFuzz.General -import VeriFuzz.Internal.AST -import VeriFuzz.Internal.Simulator +import VeriFuzz.Internal -data Xst = Xst { xstPath :: FilePath - , netgenPath :: FilePath +data Xst = Xst { xstPath :: {-# UNPACK #-} !FilePath + , netgenPath :: {-# UNPACK #-} !FilePath } + deriving (Eq, Show) -instance Simulator Xst where +instance Tool Xst where toText _ = "xst" -instance Synthesize Xst where +instance Synthesisor Xst where runSynth = runSynthXst defaultXst :: Xst defaultXst = Xst "xst" "netgen" -runSynthXst :: Xst -> ModDecl -> FilePath -> Sh () -runSynthXst sim m outf = do +runSynthXst :: Xst -> SourceInfo -> FilePath -> Sh () +runSynthXst sim (SourceInfo top src) outf = do dir <- pwd - writefile xstFile $ xstSynthConfig m + writefile xstFile $ xstSynthConfig top writefile prjFile [st|verilog work "rtl.v"|] - writefile "rtl.v" $ genSource m + writefile "rtl.v" $ genSource src echoP "XST: run" _ <- logger dir "xst" $ timeout (xstPath sim) ["-ifn", toTextIgnore xstFile] echoP "XST: netgen" @@ -62,6 +60,6 @@ runSynthXst sim m outf = do ] echoP "XST: done" where - modFile = fromText $ modName m + modFile = fromText top xstFile = modFile <.> "xst" prjFile = modFile <.> "prj" diff --git a/src/VeriFuzz/Yosys.hs b/src/VeriFuzz/Yosys.hs index fd5bb5b..d33e399 100644 --- a/src/VeriFuzz/Yosys.hs +++ b/src/VeriFuzz/Yosys.hs @@ -14,39 +14,39 @@ Yosys simulator implementation. module VeriFuzz.Yosys where -import Prelude hiding (FilePath) +import Prelude hiding (FilePath) import Shelly -import Text.Shakespeare.Text (st) +import Text.Shakespeare.Text (st) import VeriFuzz.AST import VeriFuzz.CodeGen -import VeriFuzz.General -import VeriFuzz.Internal.Simulator +import VeriFuzz.Internal import VeriFuzz.Mutate newtype Yosys = Yosys { yosysPath :: FilePath } + deriving (Eq, Show) -instance Simulator Yosys where +instance Tool Yosys where toText _ = "yosys" -instance Synthesize Yosys where +instance Synthesisor Yosys where runSynth = runSynthYosys defaultYosys :: Yosys defaultYosys = Yosys "yosys" writeSimFile - :: Yosys -- ^ Simulator instance - -> ModDecl -- ^ Current module - -> FilePath -- ^ Output sim file + :: Yosys -- ^ Simulator instance + -> VerilogSrc -- ^ Current Verilog source + -> FilePath -- ^ Output sim file -> Sh () -writeSimFile _ m file = do - writefile "rtl.v" $ genSource m +writeSimFile _ src file = do + writefile "rtl.v" $ genSource src writefile file yosysSimConfig -runSynthYosys :: Yosys -> ModDecl -> FilePath -> Sh () -runSynthYosys sim m outf = do +runSynthYosys :: Yosys -> SourceInfo -> FilePath -> Sh () +runSynthYosys sim (SourceInfo _ src) outf = do dir <- pwd - writefile inpf $ genSource m + writefile inpf $ genSource src echoP "Yosys: synthesis" _ <- logger dir "yosys" $ timeout @@ -57,20 +57,25 @@ runSynthYosys sim m outf = do inpf = "rtl.v" inp = toTextIgnore inpf out = toTextIgnore outf - -- ids = T.intercalate "," $ allVars m ^.. traverse . getIdentifier -runMaybeSynth :: (Synthesize a) => Maybe a -> ModDecl -> Sh () -runMaybeSynth (Just sim) m = - runSynth sim m $ fromText [st|syn_#{toText sim}.v|] -runMaybeSynth Nothing m = writefile "syn_rtl.v" $ genSource m +runMaybeSynth :: (Synthesisor a) => Maybe a -> SourceInfo -> Sh () +runMaybeSynth (Just sim) srcInfo = + runSynth sim srcInfo $ fromText [st|syn_#{toText sim}.v|] +runMaybeSynth Nothing (SourceInfo _ src) = + writefile "syn_rtl.v" $ genSource src runEquivYosys - :: (Synthesize a, Synthesize b) => Yosys -> a -> Maybe b -> ModDecl -> Sh () -runEquivYosys yosys sim1 sim2 m = do - writefile "top.v" . genSource . initMod $ makeTop 2 m - writefile checkFile $ yosysSatConfig sim1 sim2 m - runSynth sim1 m $ fromText [st|syn_#{toText sim1}.v|] - runMaybeSynth sim2 m + :: (Synthesisor a, Synthesisor b) + => Yosys + -> a + -> Maybe b + -> SourceInfo + -> Sh () +runEquivYosys yosys sim1 sim2 srcInfo = do + writefile "top.v" . genSource . initMod . makeTop 2 $ mainModule srcInfo + writefile checkFile $ yosysSatConfig sim1 sim2 srcInfo + runSynth sim1 srcInfo $ fromText [st|syn_#{toText sim1}.v|] + runMaybeSynth sim2 srcInfo echoP "Yosys: equivalence check" run_ (yosysPath yosys) [toTextIgnore checkFile] echoP "Yosys: equivalence done" @@ -79,15 +84,20 @@ runEquivYosys yosys sim1 sim2 m = do fromText [st|test.#{toText sim1}.#{maybe "rtl" toText sim2}.ys|] runEquiv - :: (Synthesize a, Synthesize b) => Yosys -> a -> Maybe b -> ModDecl -> Sh () -runEquiv _ sim1 sim2 m = do + :: (Synthesisor a, Synthesisor b) + => Yosys + -> a + -> Maybe b + -> SourceInfo + -> Sh () +runEquiv _ sim1 sim2 srcInfo = do root <- rootPath dir <- pwd echoP "SymbiYosys: setup" - writefile "top.v" . genSource . initMod $ makeTopAssert m - writefile "test.sby" $ sbyConfig root sim1 sim2 m - runSynth sim1 m $ fromText [st|syn_#{toText sim1}.v|] - runMaybeSynth sim2 m + writefile "top.v" . genSource . initMod . makeTopAssert $ mainModule srcInfo + writefile "test.sby" $ sbyConfig root sim1 sim2 srcInfo + runSynth sim1 srcInfo $ fromText [st|syn_#{toText sim1}.v|] + runMaybeSynth sim2 srcInfo echoP "SymbiYosys: run" - _ <- logger dir "symbiyosys" $ run "sby" ["test.sby"] + _ <- logger dir "symbiyosys" $ run "sby" ["-f", "test.sby"] echoP "SymbiYosys: done" -- cgit