From: Matthijs Kooijman Date: Wed, 5 Aug 2009 13:21:45 +0000 (+0200) Subject: Fix testbench again. X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=a8bd9c0833fcf1212f5843b9db6c754cd1086353;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git Fix testbench again. The testbench code has also been moved to a separate module. --- diff --git "a/c\316\273ash/CLasH/Translator.hs" "b/c\316\273ash/CLasH/Translator.hs" index 20dab4f..fb02355 100644 --- "a/c\316\273ash/CLasH/Translator.hs" +++ "b/c\316\273ash/CLasH/Translator.hs" @@ -31,6 +31,7 @@ import CLasH.Translator.Annotations import CLasH.Utils.Core.CoreTools import CLasH.Utils.GhcTools import CLasH.VHDL +import CLasH.VHDL.Testbench -- | Turn Haskell to VHDL, Usings Strings to indicate the Top Entity, Initial -- State and Test Inputs. @@ -104,8 +105,8 @@ moduleToVHDL env cores topbinds' init test stateful = do let all_bindings = concat (map (\x -> CoreSyn.flattenBinds (HscTypes.cm_binds x)) cores) -- Store the bindings we loaded tsBindings %= Map.fromList all_bindings - --let testexprs = case testInput of [] -> [] ; [x] -> reduceCoreListToHsList x - createDesignFiles topbinds + test_binds <- Monad.zipWithM (createTestbench Nothing) testInput topbinds + createDesignFiles (topbinds ++ test_binds) mapM (putStr . render . Ppr.ppr . snd) vhdl return vhdl diff --git "a/c\316\273ash/CLasH/VHDL.hs" "b/c\316\273ash/CLasH/VHDL.hs" index 944d33f..5465df1 100644 --- "a/c\316\273ash/CLasH/VHDL.hs" +++ "b/c\316\273ash/CLasH/VHDL.hs" @@ -37,7 +37,7 @@ import CLasH.Utils.Pretty import CLasH.Utils.Core.CoreTools import CLasH.VHDL.Constants import CLasH.VHDL.Generate --- import CLasH.VHDL.Testbench +import CLasH.VHDL.Testbench createDesignFiles :: [CoreSyn.CoreBndr] -- ^ Top binders @@ -149,123 +149,3 @@ getSignalId info = (error $ "Unnamed signal? This should not happen!") (sigName info) -} - -{- -createTestBench :: - Maybe Int -- ^ Number of cycles to simulate - -> [(CoreSyn.CoreBndr, CoreSyn.CoreExpr)] -- ^ Input stimuli - -> CoreSyn.CoreBndr -- ^ Top Entity - -> VHDLSession (AST.VHDLId, [AST.LibraryUnit]) -- ^ Testbench -createTestBench mCycles stimuli topEntity = do - ent@(AST.EntityDec id _) <- createTestBenchEntity topEntity - arch <- createTestBenchArch mCycles stimuli topEntity - return (id, [AST.LUEntity ent, AST.LUArch arch]) - - -createTestBenchEntity :: - CoreSyn.CoreBndr -- ^ Top Entity - -> VHDLSession AST.EntityDec -- ^ TB Entity -createTestBenchEntity topEntity = do - signaturemap <- getA vsSignatures - let signature = Maybe.fromMaybe - (error $ "\nTestbench.createTestBenchEntity: Generating testbench for function \n" ++ (pprString topEntity) ++ "\nwithout signature? This should not happen!") - (Map.lookup topEntity signaturemap) - let signaturename = ent_id signature - return $ AST.EntityDec (AST.unsafeIdAppend signaturename "_tb") [] - -createTestBenchArch :: - Maybe Int -- ^ Number of cycles to simulate - -> [(CoreSyn.CoreBndr, CoreSyn.CoreExpr)] -- ^ Imput stimulie - -> CoreSyn.CoreBndr -- ^ Top Entity - -> VHDLSession AST.ArchBody -createTestBenchArch mCycles stimuli topEntity = do - signaturemap <- getA vsSignatures - let signature = Maybe.fromMaybe - (error $ "\nTestbench.createTestBenchArch: Generating testbench for function \n" ++ (pprString topEntity) ++ "\nwithout signature? This should not happen!") - (Map.lookup topEntity signaturemap) - let entId = ent_id signature - iIface = ent_args signature - oIface = ent_res signature - iIds = map fst iIface - oIds = fst oIface - let iDecs = map (\(vId, tm) -> AST.SigDec vId tm Nothing) iIface - let finalIDecs = iDecs ++ - [AST.SigDec clockId std_logicTM (Just $ AST.PrimLit "'0'"), - AST.SigDec resetId std_logicTM (Just $ AST.PrimLit "'0'")] - let oDecs = AST.SigDec (fst oIface) (snd oIface) Nothing - let portmaps = mkAssocElems (map idToVHDLExpr iIds) (AST.NSimple oIds) signature - let mIns = mkComponentInst "totest" entId portmaps - (stimuliAssigns, stimuliDecs, cycles) <- createStimuliAssigns mCycles stimuli (head iIds) - let finalAssigns = (AST.CSSASm (AST.NSimple resetId AST.:<==: - AST.ConWforms [] - (AST.Wform [AST.WformElem (AST.PrimLit "'1'") (Just $ AST.PrimLit "3 ns")]) - Nothing)) : stimuliAssigns - let clkProc = createClkProc - let outputProc = createOutputProc [oIds] - return $ (AST.ArchBody - (AST.unsafeVHDLBasicId "test") - (AST.NSimple $ AST.unsafeIdAppend entId "_tb") - (map AST.BDISD (finalIDecs ++ stimuliDecs ++ [oDecs])) - (mIns : - ( (AST.CSPSm clkProc) : (AST.CSPSm outputProc) : finalAssigns ) ) ) - -createStimuliAssigns :: - Maybe Int -- ^ Number of cycles to simulate - -> [(CoreSyn.CoreBndr, CoreSyn.CoreExpr)] -- ^ Input stimuli - -> AST.VHDLId -- ^ Input signal - -> VHDLSession ([AST.ConcSm], [AST.SigDec], Int) -createStimuliAssigns mCycles [] _ = return ([], [], Maybe.maybe 0 id mCycles) - -createStimuliAssigns mCycles stimuli signal = do - let genWformElem time stim = (AST.WformElem stim (Just $ AST.PrimLit (show time ++ " ns"))) - let inputlen = length stimuli - assigns <- Monad.zipWithM createStimulans stimuli [0..inputlen] - let resvars = (map snd assigns) - sig_dec_maybes <- mapM mkSigDec resvars - let sig_decs = Maybe.catMaybes sig_dec_maybes - outps <- mapM (\x -> MonadState.lift vsType (varToVHDLExpr x)) resvars - let wformelems = zipWith genWformElem [0,10..] outps - let inassign = AST.CSSASm $ AST.NSimple signal AST.:<==: AST.ConWforms [] (AST.Wform wformelems) Nothing - return ((map fst assigns) ++ [inassign], sig_decs, inputlen) - -createStimulans :: (CoreSyn.CoreBndr, CoreSyn.CoreExpr) -> Int -> VHDLSession (AST.ConcSm, Var.Var) -createStimulans (bndr, expr) cycl = do - -- There must be a let at top level - let (CoreSyn.Let (CoreSyn.Rec binds) (Var res)) = expr - stimulansbinds <- Monad.mapM mkConcSm binds - sig_dec_maybes <- mapM (mkSigDec . fst) (filter ((/=res).fst) binds) - let sig_decs = map (AST.BDISD) (Maybe.catMaybes $ sig_dec_maybes) - let block_label = mkVHDLExtId ("testcycle_" ++ (show cycl)) - let block = AST.BlockSm block_label [] (AST.PMapAspect []) sig_decs (concat stimulansbinds) - return (AST.CSBSm block, res) - --- | generates a clock process with a period of 10ns -createClkProc :: AST.ProcSm -createClkProc = AST.ProcSm (AST.unsafeVHDLBasicId "clkproc") [] sms - where sms = -- wait for 5 ns -- (half a cycle) - [AST.WaitFor $ AST.PrimLit "5 ns", - -- clk <= not clk; - AST.NSimple clockId `AST.SigAssign` - AST.Wform [AST.WformElem (AST.Not (AST.PrimName $ AST.NSimple clockId)) Nothing]] - --- | generate the output process -createOutputProc :: [AST.VHDLId] -- ^ output signal - -> AST.ProcSm -createOutputProc outs = - AST.ProcSm (AST.unsafeVHDLBasicId "writeoutput") - [clockId] - [AST.IfSm clkPred (writeOuts outs) [] Nothing] - where clkPred = AST.PrimName (AST.NAttribute $ AST.AttribName (AST.NSimple clockId) - (AST.NSimple $ eventId) - Nothing ) `AST.And` - (AST.PrimName (AST.NSimple clockId) AST.:=: AST.PrimLit "'1'") - writeOuts :: [AST.VHDLId] -> [AST.SeqSm] - writeOuts [] = [] - writeOuts [i] = [writeOut i (AST.PrimLit "LF")] - writeOuts (i:is) = writeOut i (AST.PrimLit "HT") : writeOuts is - writeOut outSig suffix = - genExprPCall2 writeId - (AST.PrimName $ AST.NSimple outputId) - ((genExprFCall showId (AST.PrimName $ AST.NSimple outSig)) AST.:&: suffix) - --} diff --git "a/c\316\273ash/CLasH/VHDL/Testbench.hs" "b/c\316\273ash/CLasH/VHDL/Testbench.hs" new file mode 100644 index 0000000..3f77b78 --- /dev/null +++ "b/c\316\273ash/CLasH/VHDL/Testbench.hs" @@ -0,0 +1,160 @@ +-- +-- Functions to create a VHDL testbench from a list of test input. +-- +module CLasH.VHDL.Testbench where + +-- Standard modules +import qualified Control.Monad as Monad +import qualified Maybe +import qualified Data.Map as Map +import Data.Accessor +import qualified Data.Accessor.MonadState as MonadState + +-- ForSyDe +import qualified Language.VHDL.AST as AST + +-- GHC API +import CoreSyn +import qualified Var +import qualified TysWiredIn + +-- Local imports +import CLasH.Translator.TranslatorTypes +import CLasH.VHDL.Constants +import CLasH.VHDL.Generate +import CLasH.VHDL.VHDLTools +import CLasH.VHDL.VHDLTypes +import CLasH.Normalize +import CLasH.Utils.Core.BinderTools +import CLasH.Utils.Core.CoreTools +import CLasH.Utils + +createTestbench :: + Maybe Int -- ^ Number of cycles to simulate + -> CoreSyn.CoreExpr -- ^ Input stimuli + -> CoreSyn.CoreBndr -- ^ Top Entity + -> TranslatorSession CoreBndr -- ^ The id of the generated archictecture +createTestbench mCycles stimuli top = do + let stimuli' = reduceCoreListToHsList stimuli + -- Create a binder for the testbench. We use the unit type (), since the + -- testbench has no outputs and no inputs. + bndr <- mkInternalVar "testbench" TysWiredIn.unitTy + let entity = createTestbenchEntity bndr + modA tsEntities (Map.insert bndr entity) + arch <- createTestbenchArch mCycles stimuli' top + modA tsArchitectures (Map.insert bndr arch) + return bndr + +createTestbenchEntity :: + CoreSyn.CoreBndr + -> Entity +createTestbenchEntity bndr = entity + where + vhdl_id = mkVHDLBasicId $ varToString bndr + -- Create an AST entity declaration with no ports + ent_decl = AST.EntityDec vhdl_id [] + -- Create a signature with no input and no output ports + entity = Entity vhdl_id [] undefined ent_decl + +createTestbenchArch :: + Maybe Int -- ^ Number of cycles to simulate + -> [CoreSyn.CoreExpr] -- ^ Imput stimuli + -> CoreSyn.CoreBndr -- ^ Top Entity + -> TranslatorSession (Architecture, [CoreSyn.CoreBndr]) + -- ^ The architecture and any other entities used. +createTestbenchArch mCycles stimuli top = do + signature <- getEntity top + let entId = ent_id signature + iIface = ent_args signature + oIface = ent_res signature + iIds = map fst iIface + oId = fst oIface + let iDecs = map (\(vId, tm) -> AST.SigDec vId tm Nothing) iIface + let finalIDecs = iDecs ++ + [AST.SigDec clockId std_logicTM (Just $ AST.PrimLit "'0'"), + AST.SigDec resetId std_logicTM (Just $ AST.PrimLit "'0'")] + let oDecs = AST.SigDec (fst oIface) (snd oIface) Nothing + let portmaps = mkAssocElems (map idToVHDLExpr iIds) (AST.NSimple oId) signature + let mIns = mkComponentInst "totest" entId portmaps + (stimuliAssigns, stimuliDecs, cycles, used) <- createStimuliAssigns mCycles stimuli (head iIds) + let finalAssigns = (AST.CSSASm (AST.NSimple resetId AST.:<==: + AST.ConWforms [] + (AST.Wform [AST.WformElem (AST.PrimLit "'1'") (Just $ AST.PrimLit "3 ns")]) + Nothing)) : stimuliAssigns + let clkProc = createClkProc + let outputProc = createOutputProc [oId] + let arch = AST.ArchBody + (AST.unsafeVHDLBasicId "test") + (AST.NSimple $ AST.unsafeIdAppend entId "_tb") + (map AST.BDISD (finalIDecs ++ stimuliDecs ++ [oDecs])) + (mIns : + ( (AST.CSPSm clkProc) : (AST.CSPSm outputProc) : finalAssigns ) ) + return (arch, top : used) + +createStimuliAssigns :: + Maybe Int -- ^ Number of cycles to simulate + -> [CoreSyn.CoreExpr] -- ^ Input stimuli + -> AST.VHDLId -- ^ Input signal + -> TranslatorSession ( [AST.ConcSm] -- ^ Resulting statemetns + , [AST.SigDec] -- ^ Needed signals + , Int -- ^ The number of cycles to simulate + , [CoreSyn.CoreBndr]) -- ^ Any entities used +createStimuliAssigns mCycles [] _ = return ([], [], Maybe.maybe 0 id mCycles, []) + +createStimuliAssigns mCycles stimuli signal = do + let genWformElem time stim = (AST.WformElem stim (Just $ AST.PrimLit (show time ++ " ns"))) + let inputlen = length stimuli + assigns <- Monad.zipWithM createStimulans stimuli [0..inputlen] + let (stimuli_sms, resvars, useds) = unzip3 assigns + sig_dec_maybes <- mapM mkSigDec resvars + let sig_decs = Maybe.catMaybes sig_dec_maybes + outps <- mapM (\x -> MonadState.lift tsType (varToVHDLExpr x)) resvars + let wformelems = zipWith genWformElem [0,10..] outps + let inassign = AST.CSSASm $ AST.NSimple signal AST.:<==: AST.ConWforms [] (AST.Wform wformelems) Nothing + return (stimuli_sms ++ [inassign], sig_decs, inputlen, concat useds) + +createStimulans :: + CoreSyn.CoreExpr -- ^ The stimulans + -> Int -- ^ The cycle for this stimulans + -> TranslatorSession ( AST.ConcSm -- ^ The statement + , Var.Var -- ^ the variable it assigns to (assumed to be available!) + , [CoreSyn.CoreBndr]) -- ^ Any entities used by this stimulans + +createStimulans expr cycl = do + -- There must be a let at top level + (CoreSyn.Let (CoreSyn.Rec binds) (Var res)) <- normalizeExpr ("test input #" ++ show cycl) expr + (stimulansbindss, useds) <- unzipM $ Monad.mapM mkConcSm binds + sig_dec_maybes <- mapM (mkSigDec . fst) (filter ((/=res).fst) binds) + let sig_decs = map (AST.BDISD) (Maybe.catMaybes $ sig_dec_maybes) + let block_label = mkVHDLExtId ("testcycle_" ++ (show cycl)) + let block = AST.BlockSm block_label [] (AST.PMapAspect []) sig_decs (concat stimulansbindss) + return (AST.CSBSm block, res, concat useds) + +-- | generates a clock process with a period of 10ns +createClkProc :: AST.ProcSm +createClkProc = AST.ProcSm (AST.unsafeVHDLBasicId "clkproc") [] sms + where sms = -- wait for 5 ns -- (half a cycle) + [AST.WaitFor $ AST.PrimLit "5 ns", + -- clk <= not clk; + AST.NSimple clockId `AST.SigAssign` + AST.Wform [AST.WformElem (AST.Not (AST.PrimName $ AST.NSimple clockId)) Nothing]] + +-- | generate the output process +createOutputProc :: [AST.VHDLId] -- ^ output signal + -> AST.ProcSm +createOutputProc outs = + AST.ProcSm (AST.unsafeVHDLBasicId "writeoutput") + [clockId] + [AST.IfSm clkPred (writeOuts outs) [] Nothing] + where clkPred = AST.PrimName (AST.NAttribute $ AST.AttribName (AST.NSimple clockId) + (AST.NSimple $ eventId) + Nothing ) `AST.And` + (AST.PrimName (AST.NSimple clockId) AST.:=: AST.PrimLit "'1'") + writeOuts :: [AST.VHDLId] -> [AST.SeqSm] + writeOuts [] = [] + writeOuts [i] = [writeOut i (AST.PrimLit "LF")] + writeOuts (i:is) = writeOut i (AST.PrimLit "HT") : writeOuts is + writeOut outSig suffix = + genExprPCall2 writeId + (AST.PrimName $ AST.NSimple outputId) + ((genExprFCall showId (AST.PrimName $ AST.NSimple outSig)) AST.:&: suffix)