From 08f2731b97abb6d502422a701276d38e316021ab Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Tue, 7 May 2019 21:20:19 +0100 Subject: Add configuration options for all simulators --- src/VeriFuzz/Config.hs | 147 +++++++++++++++++++++++++++++++++++++++----- src/VeriFuzz/Report.hs | 26 ++++++-- src/VeriFuzz/Sim/Quartus.hs | 14 +++-- src/VeriFuzz/Sim/Vivado.hs | 27 ++++---- src/VeriFuzz/Sim/XST.hs | 27 ++++---- src/VeriFuzz/Sim/Yosys.hs | 30 +++++---- 6 files changed, 211 insertions(+), 60 deletions(-) (limited to 'src/VeriFuzz') diff --git a/src/VeriFuzz/Config.hs b/src/VeriFuzz/Config.hs index 523c743..8f1c869 100644 --- a/src/VeriFuzz/Config.hs +++ b/src/VeriFuzz/Config.hs @@ -34,6 +34,10 @@ module VeriFuzz.Config -- ** Synthesiser Description , SynthDescription(..) -- * Useful Lenses + , fromXST + , fromYosys + , fromVivado + , fromQuartus , configProbability , configProperty , configSimulators @@ -81,8 +85,13 @@ import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text.IO as T import Hedgehog.Internal.Seed (Seed) +import Shelly (toTextIgnore) import Toml (TomlCodec, (.=)) import qualified Toml +import VeriFuzz.Sim.Quartus +import VeriFuzz.Sim.Vivado +import VeriFuzz.Sim.XST +import VeriFuzz.Sim.Yosys -- $conf -- @@ -157,9 +166,13 @@ import qualified Toml -- -- [[synthesiser]] -- name = "yosys" +-- yosys.description = "yosys" +-- yosys.output = "syn_yosys.v" -- -- [[synthesiser]] -- name = "vivado" +-- vivado.description = "vivado" +-- vivado.output = "syn_vivado.v" -- -- | Probability of different expressions nodes. @@ -233,10 +246,23 @@ data Property = Property { _propSize :: {-# UNPACK #-} !Int } deriving (Eq, Show) -data SimDescription = SimDescription { _simName :: {-# UNPACK #-} !Text } +data SimDescription = SimDescription { simName :: {-# UNPACK #-} !Text } deriving (Eq, Show) -data SynthDescription = SynthDescription { _synthName :: {-# UNPACK #-} !Text } +data SynthDescription = SynthDescription { synthName :: {-# UNPACK #-} !Text + , synthYosysBin :: !(Maybe Text) + , synthYosysDesc :: !(Maybe Text) + , synthYosysOutput :: !(Maybe Text) + , synthXstBin :: !(Maybe Text) + , synthXstDesc :: !(Maybe Text) + , synthXstOutput :: !(Maybe Text) + , synthVivadoBin :: !(Maybe Text) + , synthVivadoDesc :: !(Maybe Text) + , synthVivadoOutput :: !(Maybe Text) + , synthQuartusBin :: !(Maybe Text) + , synthQuartusDesc :: !(Maybe Text) + , synthQuartusOutput :: !(Maybe Text) + } deriving (Eq, Show) data Config = Config { _configProbability :: {-# UNPACK #-} !Probability @@ -261,12 +287,79 @@ defaultValue -> Toml.Codec r w a b defaultValue x = Toml.dimap Just (fromMaybe x) . Toml.dioptional +fromXST :: XST -> SynthDescription +fromXST (XST a b c) = + SynthDescription + "xst" + Nothing + Nothing + Nothing + (toTextIgnore <$> a) + (Just b) + (Just $ toTextIgnore c) + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + +fromYosys :: Yosys -> SynthDescription +fromYosys (Yosys a b c) = + SynthDescription + "yosys" + (toTextIgnore <$> a) + (Just b) + (Just $ toTextIgnore c) + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + +fromVivado :: Vivado -> SynthDescription +fromVivado (Vivado a b c) = + SynthDescription + "vivado" + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + (toTextIgnore <$> a) + (Just b) + (Just $ toTextIgnore c) + Nothing + Nothing + Nothing + +fromQuartus :: Quartus -> SynthDescription +fromQuartus (Quartus a b c) = + SynthDescription + "quartus" + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + (toTextIgnore <$> a) + (Just b) + (Just $ toTextIgnore c) + defaultConfig :: Config -defaultConfig = Config - (Probability defModItem defStmnt defExpr defEvent) - (Property 20 Nothing 3 2 5) - [] - [SynthDescription "yosys", SynthDescription "vivado"] +defaultConfig = Config (Probability defModItem defStmnt defExpr defEvent) + (Property 20 Nothing 3 2 5) + [] + [fromYosys defaultYosys, fromVivado defaultVivado] where defModItem = ProbModItem 5 -- Assign @@ -403,14 +496,40 @@ simulator = Toml.textBy pprint parseIcarus "name" pprint (SimDescription a) = a synthesiser :: TomlCodec SynthDescription -synthesiser = Toml.textBy pprint parseIcarus "name" +synthesiser = + SynthDescription + <$> Toml.textBy id parseSynth "name" + .= synthName + <*> Toml.dioptional (Toml.text $ twoKey "yosys" "bin") + .= synthYosysBin + <*> Toml.dioptional (Toml.text $ twoKey "yosys" "description") + .= synthYosysDesc + <*> Toml.dioptional (Toml.text $ twoKey "yosys" "output") + .= synthYosysOutput + <*> Toml.dioptional (Toml.text $ twoKey "xst" "bin") + .= synthXstBin + <*> Toml.dioptional (Toml.text $ twoKey "xst" "description") + .= synthXstDesc + <*> Toml.dioptional (Toml.text $ twoKey "xst" "output") + .= synthXstOutput + <*> Toml.dioptional (Toml.text $ twoKey "vivado" "bin") + .= synthVivadoBin + <*> Toml.dioptional (Toml.text $ twoKey "vivado" "description") + .= synthVivadoDesc + <*> Toml.dioptional (Toml.text $ twoKey "vivado" "output") + .= synthVivadoOutput + <*> Toml.dioptional (Toml.text $ twoKey "quartus" "bin") + .= synthQuartusBin + <*> Toml.dioptional (Toml.text $ twoKey "quartus" "description") + .= synthQuartusDesc + <*> Toml.dioptional (Toml.text $ twoKey "quartus" "output") + .= synthQuartusOutput where - parseIcarus s@"yosys" = Right $ SynthDescription s - parseIcarus s@"vivado" = Right $ SynthDescription s - parseIcarus s@"quartus" = Right $ SynthDescription s - parseIcarus s@"xst" = Right $ SynthDescription s - parseIcarus s = Left $ "Could not match '" <> s <> "' with a synthesiser." - pprint (SynthDescription a) = a + parseSynth s@"yosys" = Right s + parseSynth s@"vivado" = Right s + parseSynth s@"quartus" = Right s + parseSynth s@"xst" = Right s + parseSynth s = Left $ "Could not match '" <> s <> "' with a synthesiser." configCodec :: TomlCodec Config configCodec = diff --git a/src/VeriFuzz/Report.hs b/src/VeriFuzz/Report.hs index 15f695d..c65df5a 100644 --- a/src/VeriFuzz/Report.hs +++ b/src/VeriFuzz/Report.hs @@ -32,7 +32,9 @@ where import Control.Lens import Data.ByteString (ByteString) +import Data.Maybe (fromMaybe) import Prelude hiding (FilePath) +import Shelly (fromText) import VeriFuzz.Config import VeriFuzz.Result import VeriFuzz.Sim.Icarus @@ -158,9 +160,25 @@ descriptionToSim s = error $ "Could not find implementation for simulator '" <> show s <> "'" descriptionToSynth :: SynthDescription -> SynthTool -descriptionToSynth (SynthDescription "yosys" ) = defaultYosysSynth -descriptionToSynth (SynthDescription "vivado" ) = defaultVivadoSynth -descriptionToSynth (SynthDescription "xst" ) = defaultXSTSynth -descriptionToSynth (SynthDescription "quartus") = defaultQuartusSynth +descriptionToSynth s@(SynthDescription "yosys" _ _ _ _ _ _ _ _ _ _ _ _) = + YosysSynth + . Yosys (fromText <$> synthYosysBin s) (fromMaybe (yosysDesc defaultYosys) $ synthYosysDesc s) + . maybe (yosysOutput defaultYosys) fromText + $ synthYosysOutput s +descriptionToSynth s@(SynthDescription "vivado" _ _ _ _ _ _ _ _ _ _ _ _) = + VivadoSynth + . Vivado (fromText <$> synthVivadoBin s) (fromMaybe (vivadoDesc defaultVivado) $ synthVivadoDesc s) + . maybe (vivadoOutput defaultVivado) fromText + $ synthVivadoOutput s +descriptionToSynth s@(SynthDescription "xst" _ _ _ _ _ _ _ _ _ _ _ _) = + XSTSynth + . XST (fromText <$> synthXstBin s) (fromMaybe (xstDesc defaultXST) $ synthXstDesc s) + . maybe (xstOutput defaultXST) fromText + $ synthXstOutput s +descriptionToSynth s@(SynthDescription "quartus" _ _ _ _ _ _ _ _ _ _ _ _) = + QuartusSynth + . Quartus (fromText <$> synthQuartusBin s) (fromMaybe (quartusDesc defaultQuartus) $ synthQuartusDesc s) + . maybe (quartusOutput defaultQuartus) fromText + $ synthQuartusOutput s descriptionToSynth s = error $ "Could not find implementation for synthesiser '" <> show s <> "'" diff --git a/src/VeriFuzz/Sim/Quartus.hs b/src/VeriFuzz/Sim/Quartus.hs index 5f3c18c..88bb6c9 100644 --- a/src/VeriFuzz/Sim/Quartus.hs +++ b/src/VeriFuzz/Sim/Quartus.hs @@ -16,6 +16,7 @@ module VeriFuzz.Sim.Quartus ) where +import Data.Text (Text, unpack) import Prelude hiding (FilePath) import Shelly import Shelly.Lifted (liftSh) @@ -24,23 +25,24 @@ import VeriFuzz.Verilog.AST import VeriFuzz.Verilog.CodeGen data Quartus = Quartus { quartusBin :: !(Maybe FilePath) + , quartusDesc :: {-# UNPACK #-} !Text , quartusOutput :: {-# UNPACK #-} !FilePath } deriving (Eq) -instance Show Quartus where - show _ = "quartus" - instance Tool Quartus where - toText _ = "quartus" + toText (Quartus _ t _) = t + +instance Show Quartus where + show t = unpack $ toText t instance Synthesiser Quartus where runSynth = runSynthQuartus synthOutput = quartusOutput - setSynthOutput (Quartus a _) = Quartus a + setSynthOutput (Quartus a b _) = Quartus a b defaultQuartus :: Quartus -defaultQuartus = Quartus Nothing "syn_quartus.v" +defaultQuartus = Quartus Nothing "quartus" "syn_quartus.v" runSynthQuartus :: Quartus -> SourceInfo -> ResultSh () runSynthQuartus sim (SourceInfo top src) = do diff --git a/src/VeriFuzz/Sim/Vivado.hs b/src/VeriFuzz/Sim/Vivado.hs index bff4d7c..c17334e 100644 --- a/src/VeriFuzz/Sim/Vivado.hs +++ b/src/VeriFuzz/Sim/Vivado.hs @@ -16,6 +16,7 @@ module VeriFuzz.Sim.Vivado ) where +import Data.Text (Text, unpack) import Prelude hiding (FilePath) import Shelly import Shelly.Lifted (liftSh) @@ -24,24 +25,25 @@ import VeriFuzz.Sim.Template import VeriFuzz.Verilog.AST import VeriFuzz.Verilog.CodeGen -data Vivado = Vivado { vivadoPath :: {-# UNPACK #-} !FilePath +data Vivado = Vivado { vivadoBin :: !(Maybe FilePath) + , vivadoDesc :: {-# UNPACK #-} !Text , vivadoOutput :: {-# UNPACK #-} !FilePath } deriving (Eq) -instance Show Vivado where - show _ = "vivado" - instance Tool Vivado where - toText _ = "vivado" + toText (Vivado _ t _) = t + +instance Show Vivado where + show t = unpack $ toText t instance Synthesiser Vivado where runSynth = runSynthVivado synthOutput = vivadoOutput - setSynthOutput (Vivado a _) = Vivado a + setSynthOutput (Vivado a b _) = Vivado a b defaultVivado :: Vivado -defaultVivado = Vivado "vivado" "syn_vivado.v" +defaultVivado = Vivado Nothing "vivado" "syn_vivado.v" runSynthVivado :: Vivado -> SourceInfo -> ResultSh () runSynthVivado sim (SourceInfo top src) = do @@ -52,10 +54,11 @@ runSynthVivado sim (SourceInfo top src) = do writefile "rtl.v" $ genSource src run_ "sed" ["s/^module/(* use_dsp=\"no\" *) module/;", "-i", "rtl.v"] logger "Vivado: run" - execute_ SynthFail - dir - "vivado" - (vivadoPath sim) - ["-mode", "batch", "-source", toTextIgnore vivadoTcl] + let exec_ n = execute_ + SynthFail + dir + "vivado" + (maybe (fromText n) ( fromText n) $ vivadoBin sim) + exec_ "vivado" ["-mode", "batch", "-source", toTextIgnore vivadoTcl] liftSh $ logger "Vivado: done" where vivadoTcl = fromText ("vivado_" <> top) <.> "tcl" diff --git a/src/VeriFuzz/Sim/XST.hs b/src/VeriFuzz/Sim/XST.hs index 92dcaa1..e1e8243 100644 --- a/src/VeriFuzz/Sim/XST.hs +++ b/src/VeriFuzz/Sim/XST.hs @@ -18,6 +18,7 @@ module VeriFuzz.Sim.XST ) where +import Data.Text (Text, unpack) import Prelude hiding (FilePath) import Shelly import Shelly.Lifted (liftSh) @@ -27,17 +28,17 @@ import VeriFuzz.Sim.Template import VeriFuzz.Verilog.AST import VeriFuzz.Verilog.CodeGen -data XST = XST { xstPath :: {-# UNPACK #-} !FilePath - , netgenPath :: {-# UNPACK #-} !FilePath - , xstOutput :: {-# UNPACK #-} !FilePath +data XST = XST { xstBin :: !(Maybe FilePath) + , xstDesc :: {-# UNPACK #-} !Text + , xstOutput :: {-# UNPACK #-} !FilePath } deriving (Eq) -instance Show XST where - show _ = "xst" - instance Tool XST where - toText _ = "xst" + toText (XST _ t _) = t + +instance Show XST where + show t = unpack $ toText t instance Synthesiser XST where runSynth = runSynthXST @@ -45,21 +46,25 @@ instance Synthesiser XST where setSynthOutput (XST a b _) = XST a b defaultXST :: XST -defaultXST = XST "xst" "netgen" "syn_xst.v" +defaultXST = XST Nothing "xst" "syn_xst.v" runSynthXST :: XST -> SourceInfo -> ResultSh () runSynthXST sim (SourceInfo top src) = do dir <- liftSh pwd - let exec = execute_ SynthFail dir "xst" + let exec n = execute_ + SynthFail + dir + "xst" + (maybe (fromText n) ( fromText n) $ xstBin sim) liftSh $ do writefile xstFile $ xstSynthConfig top writefile prjFile [st|verilog work "rtl.v"|] writefile "rtl.v" $ genSource src logger "XST: run" - exec (xstPath sim) ["-ifn", toTextIgnore xstFile] + exec "xst" ["-ifn", toTextIgnore xstFile] liftSh $ logger "XST: netgen" exec - (netgenPath sim) + "netgen" [ "-w" , "-ofmt" , "verilog" diff --git a/src/VeriFuzz/Sim/Yosys.hs b/src/VeriFuzz/Sim/Yosys.hs index 50c9759..b2ad5cb 100644 --- a/src/VeriFuzz/Sim/Yosys.hs +++ b/src/VeriFuzz/Sim/Yosys.hs @@ -21,7 +21,7 @@ module VeriFuzz.Sim.Yosys where import Control.Lens -import Data.Text +import Data.Text (Text, unpack) import Prelude hiding (FilePath) import Shelly import Shelly.Lifted (liftSh) @@ -32,35 +32,39 @@ import VeriFuzz.Verilog.AST import VeriFuzz.Verilog.CodeGen import VeriFuzz.Verilog.Mutate -data Yosys = Yosys { yosysPath :: {-# UNPACK #-} !FilePath - , yosysDescription :: {-# UNPACK #-} !Text - , yosysOutput :: {-# UNPACK #-} !FilePath +data Yosys = Yosys { yosysBin :: {-# UNPACK #-} !(Maybe FilePath) + , yosysDesc :: {-# UNPACK #-} !Text + , yosysOutput :: {-# UNPACK #-} !FilePath } deriving (Eq) instance Tool Yosys where - toText (Yosys _ t _) = t + toText (Yosys _ t _) = t + +instance Show Yosys where + show t = unpack $ toText t instance Synthesiser Yosys where runSynth = runSynthYosys synthOutput = yosysOutput setSynthOutput (Yosys a b _) = Yosys a b -instance Show Yosys where - show _ = "yosys" - defaultYosys :: Yosys -defaultYosys = Yosys "yosys" "syn_yosys.v" "yosys" +defaultYosys = Yosys Nothing "yosys" "syn_yosys.v" + +yosysPath :: Yosys -> FilePath +yosysPath sim = maybe (fromText "yosys") ( fromText "yosys") $ yosysBin sim runSynthYosys :: Yosys -> SourceInfo -> ResultSh () runSynthYosys sim (SourceInfo _ src) = ( SynthFail) . liftSh $ do dir <- pwd writefile inpf $ genSource src logger "Yosys: synthesis" - logCommand_ dir "yosys" - $ timeout - (yosysPath sim) - ["-p", "read -formal " <> inp <> "; synth; write_verilog -noattr " <> out] + logCommand_ dir "yosys" $ timeout + (yosysPath sim) + [ "-p" + , "read -formal " <> inp <> "; synth; write_verilog -noattr " <> out + ] logger "Yosys: synthesis done" where inpf = "rtl.v" -- cgit