X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FVHDL.hs;h=8429a5786810ae52b6b72146722fcd1d44b72462;hb=7a5ac42fd29b91ef4e7cb36aefb6e01d2b4d1874;hp=944d33f82c9ef3dee996419db7c3988bd229f44c;hpb=fcadaad2e47e5f6cba4b9f7d4341477b8fe74158;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 944d33f..8429a57 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 @@ -112,160 +112,3 @@ createLibraryUnit bndr = do entity <- getEntity bndr (arch, _) <- getArchitecture bndr return (ent_id entity, [AST.LUEntity (ent_dec entity), AST.LUArch arch]) - -{- --- | Looks up all pairs of old state, new state signals, together with --- the state id they represent. -makeStatePairs :: FlatFunction -> [(StateId, SignalInfo, SignalInfo)] -makeStatePairs flatfunc = - [(Maybe.fromJust $ oldStateId $ sigUse old_info, old_info, new_info) - | old_info <- map snd (flat_sigs flatfunc) - , new_info <- map snd (flat_sigs flatfunc) - -- old_info must be an old state (and, because of the next equality, - -- new_info must be a new state). - , Maybe.isJust $ oldStateId $ sigUse old_info - -- And the state numbers must match - , (oldStateId $ sigUse old_info) == (newStateId $ sigUse new_info)] - - -- Replace the second tuple element with the corresponding SignalInfo - --args_states = map (Arrow.second $ signalInfo sigs) args -mkStateProcSm :: (StateId, SignalInfo, SignalInfo) -> AST.ProcSm -mkStateProcSm (num, old, new) = - AST.ProcSm label [clk] [statement] - where - label = mkVHDLExtId $ "state_" ++ (show num) - clk = mkVHDLExtId "clk" - rising_edge = AST.NSimple $ mkVHDLBasicId "rising_edge" - wform = AST.Wform [AST.WformElem (AST.PrimName $ AST.NSimple $ getSignalId new) Nothing] - assign = AST.SigAssign (AST.NSimple $ getSignalId old) wform - rising_edge_clk = AST.PrimFCall $ AST.FCall rising_edge [Nothing AST.:=>: (AST.ADName $ AST.NSimple clk)] - statement = AST.IfSm rising_edge_clk [assign] [] Nothing - --- | Creates a VHDL Id from a named SignalInfo. Errors out if the SignalInfo --- is not named. -getSignalId :: SignalInfo -> AST.VHDLId -getSignalId info = - mkVHDLExtId $ Maybe.fromMaybe - (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) - --}