module SimCOpt ( simCOpt ) where import Flags import SimCCBlock import ASyntax import ASyntaxUtil import Id( Id, getIdBaseString, setIdBaseString , getIdQualString, setIdQualString , unQualId, isFire ) import ABinUtil(InstModMap) import ErrorUtil(internalError) import ListUtil(mapSnd) import SimPrimitiveModules(isPrimitiveModule) import Data.Maybe(maybeToList) import Data.List(find, intercalate) import Data.List.Split(split, condense, oneOf) import qualified Data.Map as M import qualified Data.Set as S import PPrint -- import Debug.Trace simCOpt :: Flags -> InstModMap -> ([SimCCBlock], [SimCCSched], [SimCCClockGroup], SimCCGateInfo) -> ([SimCCBlock], [SimCCSched], [SimCCClockGroup], SimCCGateInfo) simCOpt flags instmodmap (blocks, scheds, clk_groups, gate_info) = let (blocks1,scheds1) = moveDefsOntoStack flags instmodmap (blocks,scheds) blocks2 = map (mapBlockFns removeUnusedLocals) blocks1 scheds2 = map (mapSchedFns removeUnusedLocals) scheds1 in (blocks2, scheds2, clk_groups, gate_info) -- --------------------- -- type used to keep track of writers and readers for each def type FnLoc = (String,Bool) -- fn name, is_schedule data DefRecord = DF (S.Set FnLoc) (S.Set FnLoc) -- writers, readers printFnLoc :: FnLoc -> Doc printFnLoc (s,_) = text s instance PPrint DefRecord where pPrint _ _ (DF ws rs) = let wtxt = map printFnLoc (S.toList ws) rtxt = map printFnLoc (S.toList rs) in (text "Writers:") $+$ (nest 2 (commaSep wtxt)) $+$ (text "Readers:") $+$ (nest 2 (commaSep rtxt)) -- create records for a bunch of reads or writes readsIds :: FnLoc -> [AId] -> [(AId, DefRecord)] fl `readsIds` ids = [ (aid,DF S.empty (S.singleton fl)) | aid <- ids] writesIds :: FnLoc -> [AId] -> [(AId, DefRecord)] fl `writesIds` ids = [ (aid,DF (S.singleton fl) S.empty) | aid <- ids] combine_refs :: DefRecord -> DefRecord -> DefRecord combine_refs (DF w1 r1) (DF w2 r2) = DF (w1 `S.union` w2) (r1 `S.union` r2) -- Get the AIds read or written by a SimCCFn getFnRefs :: Bool -> SimCCFn -> [(AId, DefRecord)] getFnRefs is_sched fn = concatMap (helper (sf_name fn, is_sched)) (sf_body fn) where helper fl (SFSDef _ (_,_) Nothing) = [] helper fl (SFSDef _ (_,aid) (Just e)) = (fl `writesIds` [aid]) ++ (fl `readsIds` (aVars e)) helper fl (SFSAssign _ aid e) = (fl `writesIds` [aid]) ++ (fl `readsIds` (aVars e)) helper fl (SFSAction act) = fl `readsIds` (aVars act) helper fl (SFSAssignAction _ aid act _) = (fl `writesIds` [aid]) ++ (fl `readsIds` (aVars act)) helper fl (SFSRuleExec _) = [] helper fl (SFSCond e ts fs) = (fl `readsIds` (aVars e)) ++ (concatMap (helper fl) ts) ++ (concatMap (helper fl) fs) helper fl (SFSMethodCall obj meth args) = concatMap (\e -> fl `readsIds` (aVars e)) args helper fl (SFSFunctionCall obj func args) = concatMap (\e -> fl `readsIds` (aVars e)) args helper fl (SFSResets stmts) = concatMap (helper fl) stmts helper fl (SFSReturn Nothing) = [] helper fl (SFSReturn (Just e)) = fl `readsIds` (aVars e) helper fl (SFSOutputReset rstId e) = -- the rstId doesn't exist as an entity in the SimCCBlock fl `readsIds` (aVars e) -- --------------------- -- Optimization that analyzes def usage and moves defs -- to be stack-local in the schedule function or block SimCCFns. -- This reduces the size of the class, improves cache effects and -- optimizations and reduces memory traffic, VCD size, etc. by not -- storing unneeded temporaries. This will also remove entirely any -- defs which are defined but not used anywhere. moveDefsOntoStack :: Flags -> InstModMap -> ([SimCCBlock],[SimCCSched]) -> ([SimCCBlock],[SimCCSched]) moveDefsOntoStack flags instmodmap (blocks,scheds) = let -- find all defs used in the blocks block_refs = [((sb_id b, aid), dr) | b <- blocks , let fns = (get_rule_fns b)++(get_method_fns b)++(sb_resets b) , (aid,dr) <- concatMap (getFnRefs False) fns ] block_defs = M.fromListWith combine_refs block_refs -- find all defs used in the schedule functions modsbmap = M.fromList [ (sb_name b, b) | b <- blocks ] -- Construct maps from (sbid, name) -> refs and -- (sbid, name) -> qual_id used in schedule -- Because we will need both later. sched_tups = [ ((sbid, unqual_id), (dr, qual_id)) | s <- scheds , let fns = (sched_fn s):(maybeToList (sched_after_fn s)) , (qual_id,dr) <- concatMap (getFnRefs True) fns , let inst = getIdQualString (dropTopInst qual_id) , let mod = M.findWithDefault (internalError $ "Unknown instance " ++ inst) inst instmodmap , not (isPrimitiveModule mod) , let mb = M.lookup mod modsbmap , let blk = case mb of (Just b) -> b Nothing -> internalError $ "No block for " ++ mod , let unqual_id = unQualId qual_id , let sbid = sb_id blk ] sched_refs = [ (k, dr) | (k, (dr,_)) <- sched_tups ] sched_defs = M.fromListWith combine_refs sched_refs sched_qids = M.fromListWith S.union [ (k, S.singleton q) | (k,(_,q)) <- sched_tups ] all_defs = M.unionWith combine_refs block_defs sched_defs -- build a map from (BlockId,Id) to AType for all defs we -- might want to move btype_map = M.fromList [((sb_id b, aid),ty) | b <- blocks , let defs = (sb_publicDefs b) ++ (sb_privateDefs b) ++ [(t,i) | (t,i,_) <- sb_methodPorts b] , (ty,aid) <- defs ] -- record which Ids are for ports port_set = S.fromList [ (sb_id b, aid) | b <- blocks, (_,aid,_) <- sb_methodPorts b ] -- record which Ids are for ATaskAction atask_set = S.fromList [ (sb_id b, aid) | b <- blocks, aid <- sb_taskDefs b ] -- find the sb_id of the top-level module top_sbid = do mod <- M.lookup "" instmodmap blk <- find (\b -> sb_name b == mod) blocks return (sb_id blk) -- until performance issues with wide data are resolved, do not move -- wide values into the function, since they pay a construction penalty -- on each call. also don't move string constructors. shouldMove (sbid,aid) = let sizeOkToMove = case (M.lookup (sbid,aid) btype_map) of (Just ty) -> (ty == ATReal) || ((not (isStringType ty)) && ((aSize ty) <= 64)) Nothing -> False -- don't move AV task defs exprOkToMove = S.notMember (sbid,aid) atask_set -- only move CF or WF if -keep-fires is not set cfwfOkToMove = not ((isFire aid) && (keepFires flags)) -- only move ports if -keep-fires is not set isPort = (sbid,aid) `S.member` port_set portOkToMove = not (isPort && (keepFires flags)) -- do not move ports if this is the top module of a SystemC model isTopSysC = (genSysC flags) && (top_sbid == (Just sbid)) syscOkToMove = not (isPort && isTopSysC) in and [ sizeOkToMove , exprOkToMove , cfwfOkToMove , portOkToMove , syscOkToMove ] -- determine which defs we want to move into each function move_map = M.fromListWith (++) [ (dest, [(sbid,aid)]) | ((sbid, aid), DF ws rs) <- M.toList all_defs , let fs = ws `S.union` rs , (S.size fs) == 1 , let (fn,is_schedule) = S.findMin fs , shouldMove (sbid,aid) , let dest = if is_schedule then (Nothing,fn) else (Just sbid,fn) ] moved_defs = M.fromListWith S.union [ (sbid, S.singleton aid) | els <- M.elems move_map , (sbid, aid) <- els ] -- determine which defs we want to delete entirely def_set = S.fromList [ (sb_id b, aid) | b <- blocks , aid <- map snd ((sb_publicDefs b) ++ (sb_privateDefs b)) ] unused_defs = def_set `S.difference` (M.keysSet all_defs) deleted_defs = M.fromListWith S.union [ (sbid, S.singleton aid) | (sbid, aid) <- S.toList unused_defs ] -- update blocks and functions isNotDeleted sbid aid = let moved = M.findWithDefault S.empty sbid moved_defs deleted = M.findWithDefault S.empty sbid deleted_defs in (aid `S.notMember` deleted) && (aid `S.notMember` moved) sndOf3 (_,x,_) = x inline aid = let q = getIdQualString aid b = getIdBaseString aid segs = filter (/=".") $ split (condense (oneOf ".")) q name = intercalate "_" $ (map ("INST_"++) segs) ++ ["DEF_" ++ b] in setIdBaseString (unQualId aid) name moveDefs (Just sbid) fn = -- move within block let fname = sf_name fn new_defs = [ SFSDef isPort (ty,aid) Nothing | (_,aid) <- M.findWithDefault [] ((Just sbid),fname) move_map , let (Just ty) = M.lookup (sbid,aid) btype_map , let isPort = S.member (sbid,aid) port_set ] body = new_defs ++ (sf_body fn) in fn { sf_body = body } moveDefs Nothing fn = -- move into schedule let fname = sf_name fn new_defs = [ [ SFSDef isPort (ty,qual_id) Nothing | qual_id <- S.toList qids ] | (sbid,aid) <- M.findWithDefault [] (Nothing,fname) move_map , let (Just ty) = M.lookup (sbid,aid) btype_map , let isPort = S.member (sbid,aid) port_set , let qids = M.findWithDefault S.empty (sbid, aid) sched_qids ] idmap = M.fromList [ (qual_id, inline qual_id) | (sbid,aid) <- M.findWithDefault [] (Nothing,fname) move_map , let qids = M.findWithDefault S.empty (sbid,aid) sched_qids , qual_id <- S.toList qids ] body = map (renameIds idmap) ((concat new_defs) ++ (sf_body fn)) in fn { sf_body = body } blocks' = [ b { sb_publicDefs = pubs , sb_privateDefs = privs , sb_methodPorts = ports , sb_rules = rls , sb_methods = meths } | b <- blocks , let sbid = sb_id b , let pubs = filter ((isNotDeleted sbid) . snd) (sb_publicDefs b) , let privs = filter ((isNotDeleted sbid) . snd) (sb_privateDefs b) , let ports = filter ((isNotDeleted sbid) . sndOf3) (sb_methodPorts b) , let rls = [ (mcd, mapSnd (moveDefs (Just sbid)) fns) | (mcd, fns) <- sb_rules b ] , let meths = [ (mcd, mapSnd (moveDefs (Just sbid)) fns) | (mcd,fns) <- sb_methods b ] ] scheds' = [ s { sched_fn = moveDefs Nothing (sched_fn s) , sched_after_fn = fmap (moveDefs Nothing) (sched_after_fn s) } | s <- scheds ] in (blocks',scheds') dropTopInst :: Id -> Id dropTopInst a = let q = (dropWhile (/= '.')) (getIdQualString a) in if (null q) then unQualId a else setIdQualString a (tail q) -- --------------------- -- Optimization that removes unused local defs from a SimCCFn -- Note: this is a cheap and cheerful optimization that just handles -- the simplest case. It is not a proper dead/unreachable code -- eliminator. If we ever get around to doing proper analysis & -- optimization then this pass can be removed. removeUnusedLocals :: SimCCFn -> SimCCFn removeUnusedLocals fn = let used_defs = S.fromList [ aid | (aid, DF wr rd) <- getFnRefs False fn , not (S.null rd) ] action_values = S.fromList [ aid | (SFSAssignAction _ aid _ _) <- sf_body fn ] keep_defs = (used_defs `S.union` action_values) local_defs = S.fromList [ aid | (SFSDef _ (_,aid) _) <- sf_body fn ] args = S.fromList (map snd (sf_args fn)) -- consider any unreferenced def to be unused, as well as any argument ports -- since the argument will be referenced directly isUnusedDef (SFSDef p (_,aid) _) = (aid `S.notMember` keep_defs) || (p && (aid `S.member` args)) -- consider any assignment to a local unreferenced def to be unused, as well -- assignments to locally defined argument ports, since the argument will be -- referenced directly isUnusedDef (SFSAssign p aid _) = (aid `S.member` local_defs) && ((aid `S.notMember` keep_defs) || (p && (aid `S.member` args))) -- keep everything else isUnusedDef _ = False body = [ stmt | stmt <- sf_body fn, not (isUnusedDef stmt) ] in fn { sf_body = body } -- --------------------- -- Utility routines for mapping over SimCCFns in blocks and schedules mapFnSet :: (SimCCFn -> SimCCFn) -> SBFnSet -> SBFnSet mapFnSet f (mcd,fs) = (mcd, mapSnd f fs) mapBlockFns :: (SimCCFn -> SimCCFn) -> SimCCBlock -> SimCCBlock mapBlockFns f blk = let rules = map (mapFnSet f) (sb_rules blk) meths = map (mapFnSet f) (sb_methods blk) rsts = map f (sb_resets blk) in blk { sb_rules = rules , sb_methods = meths , sb_resets = rsts } mapSchedFns :: (SimCCFn -> SimCCFn) -> SimCCSched -> SimCCSched mapSchedFns f sch = let sf = f (sched_fn sch) saf = fmap f (sched_after_fn sch) in sch { sched_fn = sf , sched_after_fn = saf }