X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FVHDL%2FTestbench.hs;h=fa2e9dc7bde21544cc4236db4a0a319309c0f06e;hb=75978cf28a619d14ae27ea2bb4a53246b6a0bcd8;hp=3f77b78aeb0c93b87cab4706b9fdbe881cb921af;hpb=a8bd9c0833fcf1212f5843b9db6c754cd1086353;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git "a/c\316\273ash/CLasH/VHDL/Testbench.hs" "b/c\316\273ash/CLasH/VHDL/Testbench.hs" index 3f77b78..fa2e9dc 100644 --- "a/c\316\273ash/CLasH/VHDL/Testbench.hs" +++ "b/c\316\273ash/CLasH/VHDL/Testbench.hs" @@ -7,14 +7,14 @@ module CLasH.VHDL.Testbench where 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 +import qualified Data.Accessor.Monad.Trans.State as MonadState --- ForSyDe +-- VHDL Imports import qualified Language.VHDL.AST as AST -- GHC API -import CoreSyn +import qualified CoreSyn +import qualified HscTypes import qualified Var import qualified TysWiredIn @@ -31,18 +31,19 @@ import CLasH.Utils createTestbench :: Maybe Int -- ^ Number of cycles to simulate + -> [HscTypes.CoreModule] -- ^ Compiled modules -> 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 + -> TranslatorSession CoreSyn.CoreBndr -- ^ The id of the generated archictecture +createTestbench mCycles cores stimuli top = do + stimuli' <- reduceCoreListToHsList cores 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) + MonadState.modify tsEntities (Map.insert bndr entity) + arch <- createTestbenchArch mCycles stimuli' top entity + MonadState.modify tsArchitectures (Map.insert bndr arch) return bndr createTestbenchEntity :: @@ -50,7 +51,7 @@ createTestbenchEntity :: -> Entity createTestbenchEntity bndr = entity where - vhdl_id = mkVHDLBasicId $ varToString bndr + vhdl_id = mkVHDLBasicId "testbench" -- Create an AST entity declaration with no ports ent_decl = AST.EntityDec vhdl_id [] -- Create a signature with no input and no output ports @@ -60,45 +61,50 @@ createTestbenchArch :: Maybe Int -- ^ Number of cycles to simulate -> [CoreSyn.CoreExpr] -- ^ Imput stimuli -> CoreSyn.CoreBndr -- ^ Top Entity + -> Entity -- ^ The signature to create an architecture for -> TranslatorSession (Architecture, [CoreSyn.CoreBndr]) -- ^ The architecture and any other entities used. -createTestbenchArch mCycles stimuli top = do +createTestbenchArch mCycles stimuli top testent= 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 (oId, oDec, oProc) = case oIface of + Just (id, ty) -> ( id + , [AST.SigDec id ty Nothing] + , [createOutputProc [id]]) + -- No output port? Just use undefined for the output id, since it won't be + -- used by mkAssocElems when there is no output port. + Nothing -> (undefined, [], []) 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")]) + (AST.Wform [AST.WformElem (AST.PrimLit "'0'") (Just $ AST.PrimLit "0 ns"), 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])) + (AST.NSimple $ ent_id testent) + (map AST.BDISD (finalIDecs ++ stimuliDecs ++ oDec)) (mIns : - ( (AST.CSPSm clkProc) : (AST.CSPSm outputProc) : finalAssigns ) ) + ( (AST.CSPSm clkProc) : (fmap AST.CSPSm oProc) ++ 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 + -> TranslatorSession ( [AST.ConcSm] + , [AST.SigDec] + , Int + , [CoreSyn.CoreBndr]) -- ^ (Resulting statements, Needed signals, The number of cycles to simulate, Any entities used) createStimuliAssigns mCycles [] _ = return ([], [], Maybe.maybe 0 id mCycles, []) createStimuliAssigns mCycles stimuli signal = do @@ -111,24 +117,31 @@ createStimuliAssigns mCycles stimuli signal = do 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) + case (concat stimuli_sms) of + [] -> return ([inassign], [], inputlen, concat useds) + stims -> return (stims ++ [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 + -> TranslatorSession ( [AST.ConcSm] + , Var.Var + , [CoreSyn.CoreBndr]) -- ^ (The statement, the variable it assigns to (assumed to be available!), 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 + expr <- normalizeExpr ("test input #" ++ show cycl) expr + -- Split the normalized expression. It can't have a function type, so match + -- an empty list of argument binders + let ([], binds, res) = splitNormalized 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 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) + let block = AST.BlockSm block_label [] (AST.PMapAspect []) sig_decs (concat stimulansbindss) + case (sig_decs,(concat stimulansbindss)) of + ([],[]) -> return ([], res, concat useds) + otherwise -> return ([AST.CSBSm block], res, concat useds) -- | generates a clock process with a period of 10ns createClkProc :: AST.ProcSm @@ -147,7 +160,7 @@ createOutputProc outs = [clockId] [AST.IfSm clkPred (writeOuts outs) [] Nothing] where clkPred = AST.PrimName (AST.NAttribute $ AST.AttribName (AST.NSimple clockId) - (AST.NSimple $ eventId) + (AST.NSimple eventId) Nothing ) `AST.And` (AST.PrimName (AST.NSimple clockId) AST.:=: AST.PrimLit "'1'") writeOuts :: [AST.VHDLId] -> [AST.SeqSm]