X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FVHDL.hs;h=21452a9714c24379dcdc0017b719c5e0b04fb3f3;hb=4c63601269c7097e2177c547dc36d4edecc1c648;hp=031acc8dc238f77a07059ea2fcaefc33c62e93ee;hpb=d30d9fe36698d9d9b5e44099fba9ba090e54064f;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git "a/c\316\273ash/CLasH/VHDL.hs" "b/c\316\273ash/CLasH/VHDL.hs" index 031acc8..21452a9 100644 --- "a/c\316\273ash/CLasH/VHDL.hs" +++ "b/c\316\273ash/CLasH/VHDL.hs" @@ -38,20 +38,25 @@ import CLasH.Utils.Pretty import CLasH.Utils.Core.CoreTools import CLasH.VHDL.Constants import CLasH.VHDL.Generate +-- import CLasH.VHDL.Testbench createDesignFiles :: TypeState -> [(CoreSyn.CoreBndr, CoreSyn.CoreExpr)] + -> CoreSyn.CoreBndr -- ^ Top binder + -> [(CoreSyn.CoreBndr, CoreSyn.CoreExpr)] -- ^ Test Input -> [(AST.VHDLId, AST.DesignFile)] -createDesignFiles init_typestate binds = +createDesignFiles init_typestate binds topbind testinput = (mkVHDLBasicId "types", AST.DesignFile ieee_context [type_package_dec, type_package_body]) : - map (Arrow.second $ AST.DesignFile full_context) units + map (Arrow.second $ AST.DesignFile full_context) (units ++ [testbench]) where init_session = VHDLState init_typestate Map.empty - (units, final_session) = + (units, final_session') = State.runState (createLibraryUnits binds) init_session + (testbench, final_session) = + State.runState (createTestBench Nothing testinput topbind) final_session' tyfun_decls = map snd $ Map.elems (final_session ^. vsType ^. vsTypeFuns) ty_decls = final_session ^. vsType ^. vsTypeDecls tfvec_index_decl = AST.PDISD $ AST.SubtypeDec tfvec_indexTM tfvec_index_def @@ -60,7 +65,8 @@ createDesignFiles init_typestate binds = ieee_context = [ AST.Library $ mkVHDLBasicId "IEEE", mkUseAll ["IEEE", "std_logic_1164"], - mkUseAll ["IEEE", "numeric_std"] + mkUseAll ["IEEE", "numeric_std"], + mkUseAll ["std", "textio"] ] full_context = mkUseAll ["work", "types"] @@ -296,3 +302,127 @@ mkConcSm (bndr, (Case (Var scrut) b ty [(_, _, Var false), (con, _, Var true)])) mkConcSm (_, (Case (Var _) _ _ alts)) = error "\nVHDL.mkConcSm: Not in normal form: Case statement with more than two alternatives" mkConcSm (_, Case _ _ _ _) = error "\nVHDL.mkConcSm: Not in normal form: Case statement has does not have a simple variable as scrutinee" mkConcSm (bndr, expr) = error $ "\nVHDL.mkConcSM: Unsupported binding in let expression: " ++ pprString bndr ++ " = " ++ pprString expr + + +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) + 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 = + genExprFCall2 writeId + (AST.PrimName $ AST.NSimple outputId) + (genExprFCall1 showId ((AST.PrimName $ AST.NSimple outSig) AST.:&: suffix)) + genExprFCall2 entid arg1 arg2 = + AST.ProcCall (AST.NSimple entid) $ + map (\exp -> Nothing AST.:=>: AST.ADExpr exp) [arg1,arg2] + genExprFCall1 entid arg = + AST.PrimFCall $ AST.FCall (AST.NSimple entid) $ + map (\exp -> Nothing AST.:=>: AST.ADExpr exp) [arg]