module SimMakeCBlocks ( simMakeCBlocks ) where import Flags import PPrint import ErrorUtil(internalError) import SimPackage import SimCCBlock import SimDomainInfo import SimBlocksToC(mkSchedName) import ASyntax import ASyntaxUtil import Wires(ResetId, wpClockDomain, wpResets) import VModInfo import Pragma import Prim import SimPrimitiveModules import Id import Position(noPosition) import FStringCompat(mkFString, concatFString) import PreStrings(fsUnderscore, fsEmpty) import SCC(tsort) import Util import Data.Maybe(mapMaybe, isJust, fromJust, fromMaybe, maybeToList) import Data.List(partition, nub, union, find, sortBy, (\\)) import qualified Data.Map as M import qualified Data.Set as S -- import Debug.Trace -- A set of Ids (used in place of lists, for efficiency) type IdSet = S.Set AId -- This is a map from SimBlock names to SBId type NameMap = M.Map String SBId -- map from module name to its def map type ModDefMap = M.Map String DefMap -- map from method names to method port info type MethMap = M.Map AId ( Maybe VName -- enable , [(AType, AId, VName)] -- args , Maybe (AType, VName) -- return , Bool -- is action , [AId] -- rule Ids ) -- map from module name to its method map type ModMethMap = M.Map String MethMap -- map from module names to rule method calls type CallMap = M.Map String [(ARuleId, [AId])] findModDef :: ModDefMap -> String -> DefMap findModDef mdmap inst = case M.lookup inst mdmap of Just def_map -> def_map Nothing -> internalError ("SimMakeCBlocks.findModDef: cannot find " ++ ppReadable inst ++ ppReadable mdmap) findModMeth :: ModMethMap -> String -> MethMap findModMeth mmmap inst = case M.lookup inst mmmap of Just meth_map -> meth_map Nothing -> internalError ("SimMakeCBlocks.findModMeth: cannot find " ++ ppReadable inst ++ ppReadable mmmap) -- Used several places to name the top-level instance top_blk_name :: String top_blk_name = "top" -- Create SimCCBlocks and SimCCScheds from a SimSystem. -- The result will include one SimCCSched for each clock edge -- with any associated action, and one SimCCBlock for each module. simMakeCBlocks :: Flags -> SimSystem -> ([SimCCBlock], [SimCCSched], [SimCCClockGroup], SimCCGateInfo, SBId) simMakeCBlocks flags sim_system = let pkg_map = ssys_packages sim_system pkgs = M.elems pkg_map scheds = ssys_schedules sim_system inst_map = ssys_instmap sim_system -- map module names to numeric ids (these become the SBIds) first_id = (maximum (map sb_id primBlocks)) + 1 names = (zip (map getModuleName pkgs) [first_id..]) ++ (map (\p -> (sb_name p, sb_id p)) primBlocks) name_map = M.fromList names -- make a map from module name (as String) to the map for the defs -- in that module, so that the scheduler has access to all defs full_dmap = let mkPair sp = (getIdString (sp_name sp), sp_local_defs sp) in M.fromList (map mkPair pkgs) -- make a map from module name (as String) to the map for all methods -- in that module, so that the scheduler has access to all methods full_mmap = let mkPair sp = (getIdString (sp_name sp), M.fromList (mapMaybe (getPortInfo (sp_pps sp)) (sp_interface sp))) in M.fromList (map mkPair pkgs) -- ---------- -- build blocks -- build the top package separately top_pkg = fromJust (M.lookup (ssys_top sim_system) pkg_map) top_block = onePackageToBlock flags name_map full_mmap sim_system top_pkg top_block_id = sb_id top_block -- build the rest other_blocks = [ onePackageToBlock flags name_map full_mmap sim_system pkg | pkg <- pkgs , pkg /= top_pkg ] -- ---------- -- build schedules -- methods on the top-level module top_methods = sp_interface top_pkg (top_ameths, top_vmeths) = partition aIfaceHasAction top_methods top_vmeth_set = S.fromList $ concatMap aIfaceResId top_vmeths top_ameth_set = S.fromList $ map aRuleName $ concatMap aIfaceRules top_ameths -- input clocks to the top-level module top_gates = [ gate | (AAI_Clock _ (Just gate)) <- sp_inputs top_pkg ] -- action methods called in each rule method_map = M.fromList $ [ ((p_name,m_name), sub_names) | p <- pkgs , let p_name = getModuleName p , let ms = sp_interface p , m <- ms , let m_name = aIfaceName m , let m_rules = aIfaceRules m , let sub_actions = concatMap arule_actions m_rules , let sub_names = [ (o,m) | (ACall o m _) <- sub_actions ] ] getCalls :: String -> AMethodId -> [(AId,AMethodId)] getCalls pkg_name mid = M.findWithDefault [] (pkg_name, unQualId mid) method_map getAllCalls :: SimPackage -> (AId,AMethodId) -> [AId] getAllCalls root (mod,mid) = case (findSubPkg sim_system root mod) of (Just root') -> let p_name = getModuleName root' cs = getCalls p_name mid locals = [ setIdQualString m (getIdString o) | (o,m) <- cs ] subs = [ map (addToQual (getIdString o)) (getAllCalls root' (o,m)) | (o,m) <- cs ] in nub $ locals ++ (concat subs) Nothing -> [] actionCalls :: SimPackage -> ARule -> [AId] actionCalls root r = let actions = [ (o,m) | (ACall o m _) <- arule_actions r ] locals = [ setIdQualString m (getIdString o) | (o,m) <- actions ] subs = [ map (addToQual (getIdString o)) (getAllCalls root (o,m)) | (o,m) <- actions ] in nub $ locals ++ (concat subs) rule_calls = [ (p_name, calls) | p <- pkgs , let p_name = getModuleName p , let calls = [ (arule_id r, actionCalls p r) | r <- sp_rules p ] ++ (if (p == top_pkg) then [ (arule_id r, actionCalls p r) | r <- concatMap aIfaceRules top_ameths ] else []) ] call_map = M.fromList rule_calls -- get and combine stmt lists for each clock edge stmt_infos = map (mkScheduleStmts flags top_methods top_vmeth_set top_ameth_set top_gates inst_map full_dmap full_mmap call_map) scheds stmt_map = M.unionsWith combineStmtGroups stmt_infos -- make the SimCCScheds from the stmt pairs in the map schedules = mapMaybe mkOneSchedule (M.toList stmt_map) -- make the SimCCClockGroups from the schedules clock_groups = map mkClockGroup scheds -- make the clk gate info gate_info = mkGateInfo pkg_map top_gates inst_map scheds in ((top_block:other_blocks), schedules, clock_groups, gate_info, top_block_id) -- Get all of the AIds used by AActions, as well as -- the AIds used by the defs of those AIds, etc. getIds :: DefMap -> IdSet -> [AAction] -> IdSet getIds def_map known [] = known getIds def_map known (act:acts) = let known' = getExprIds False def_map known (aact_args act) in getIds def_map known' acts -- Accumulate AIds used by an expression and its sub-expressions. -- Recurse into (and count) WILL_FIRE signals if we are in the scheduler -- Skip them (and don't count them) if we're not getExprIds :: Bool -> DefMap -> IdSet -> [AExpr] -> IdSet getExprIds _ _ known [] = known getExprIds in_sched def_map known ((APrim _ _ _ args):es) = getExprIds in_sched def_map known (args ++ es) getExprIds in_sched def_map known ((AMethCall _ _ _ args):es) = getExprIds in_sched def_map known (args ++ es) getExprIds in_sched def_map known ((ANoInlineFunCall _ _ _ args):es) = getExprIds in_sched def_map known (args ++ es) getExprIds in_sched def_map known ((AFunCall _ _ _ _ args):es) = getExprIds in_sched def_map known (args ++ es) -- don't recurse into enable or will fire signals -- note that we mask the Id property when building the scheduler -- because we need the will fire definitions there getExprIds in_sched def_map known ((ASDef _ id):es) = if id `S.member` known || isIdWillFire id && not (in_sched) then getExprIds in_sched def_map known es else let known' = id `S.insert` known in case M.lookup id def_map of (Just def) -> getExprIds in_sched def_map known' ((adef_expr def):es) Nothing -> getExprIds in_sched def_map known' es getExprIds in_sched def_map known (_:es) = getExprIds in_sched def_map known es -- Create the SimCCBlock for a SimPackage onePackageToBlock :: Flags -> NameMap -> ModMethMap -> SimSystem -> SimPackage -> SimCCBlock onePackageToBlock flags name_map full_meth_map ss pkg = let -- ---------- -- package fields class_name = getModuleName pkg modId = sp_name pkg rules = sp_rules pkg iface = sp_interface pkg def_map = sp_local_defs pkg avinst_map = sp_state_instances pkg noinline_insts = sp_noinline_instances pkg method_order_map = sp_method_order_map pkg reset_list = sp_reset_list pkg gate_map = sp_gate_map pkg raw_defs = M.elems def_map -- alphabetize the avis, by inst Id raw_avis = let -- Ord on Id is broken, so use cmpIdByName cmpFn a b = fst a `cmpIdByName` fst b in map snd $ sortBy cmpFn $ M.toList avinst_map -- ---------- -- the SimCCBlock state info state = map (mkState name_map) raw_avis ++ map (mkNoInlineState name_map) noinline_insts -- ---------- -- public and private class defs (public defs are all defs needed -- to compute CAN_FIRE and WILL_FIRE signals. all_defs = map cvtADef raw_defs cf_wf_ex = [ ASDef t i | (t,i) <- all_defs , (isFire i) ] pub_ids = getExprIds True def_map S.empty cf_wf_ex (pub_defs, pri_defs) = partition ((`S.member` pub_ids).snd) all_defs task_defs = [ aid | d@(ADef aid _ (ATaskValue {}) _) <- raw_defs ] -- ---------- -- instantiation parameters (module arguments) arg_defs = let ains = [ (ai, name, isPort vainfo) | (ai, vainfo) <- getSimPackageInputs pkg , not (isClock vainfo || isReset vainfo) , let name = getVArgInfoName vainfo ] getType (AAI_Port (_,t)) = t getType ai = internalError ("onePackageToBlock: " ++ "unexpected abs input: " ++ ppReadable ai) in [ (getType ai,n,ip) | (ai,n,ip) <- ains ] -- ---------- -- gather all method ports meth_map = findModMeth full_meth_map class_name meth_ens = [ (aTBool, vName_to_id vn, vn) | ((Just vn),_,_,_,_) <- M.elems meth_map ] meth_args = concat [ ins | (_,ins,_,_,_) <- M.elems meth_map ] meth_rets = [ (rt, n, vn) | (n, (_,_,(Just (rt,vn)),_,_)) <- M.toList meth_map ] ports = meth_ens ++ meth_args ++ meth_rets -- ---------- -- clock domains findClkDom aid [] = internalError $ "No domain for clock input: " ++ (ppReadable aid) findClkDom aid ((dom,aclks):rest) = if aid `elem` [i | (AClock (ASPort _ i) _) <- aclks] then dom else findClkDom aid rest domains = map fst (sp_clock_domains pkg) input_clks = [ (osc,dom) | (AAI_Clock osc _) <- sp_inputs pkg , let dom = findClkDom osc (sp_clock_domains pkg) ] -- ---------- -- rule functions drs = [ M.singleton clk [(aid,r')] | r <- rules , let clk = wpClockDomain (arule_wprops r) , let aid = aRuleName r , let r' = cvtARule modId def_map method_order_map reset_list r ] rule_fns = M.toList (M.unionsWith (++) drs) -- ---------- -- method functions dms = [ M.singleton clk [(aid, fromJust m')] | m <- iface , let aid = aIfaceName m , let m' = cvtIFace modId (sp_pps pkg) def_map meth_map method_order_map reset_list m , isJust m' , let clk = wpClockDomain (aif_props m) ] method_fns = M.toList (M.unionsWith (++) dms) -- ---------- -- output resets -- list of output resets and the AReset they are assigned output_resets = [ (rstId, arst) | (AIReset rstId arst _) <- iface ] -- find the output resets for a particulart AReset findOutputRsts arst = [ rstId | (rstId, arst') <- output_resets, arst' == arst ] -- ---------- -- reset defs and functions rst_defs = [ (aTBool, ae_objid (areset_wire port)) | (_,port) <- reset_list ] rst_map :: M.Map AReset [(AId, AId)] rst_map = let edges = [ (rst, [(modId, portId)]) | avi <- raw_avis, (ResetArg rstId, ASReset _ rst) <- getInstArgs avi, -- confirm that the port is connected, -- and get the port name (rstId2, (Just portName, _)) <- input_resets (vRst (avi_vmi avi)), rstId2 == rstId, let modId = avi_vname avi, -- XXX we only need the String part of the Id let portId = vName_to_id portName ] in M.fromListWith (++) edges findRstMods rst_port = M.findWithDefault [] rst_port rst_map -- tuples of: -- * the numeric resetId -- * the wire name -- * the submodules which are reset by this wire -- * the output resets which are defined as this wire reset_instances = [ (rst_id, areset_wire port, findRstMods port, findOutputRsts port) | (rst_id, port) <- reset_list ] reset_fns = map cvtReset reset_instances -- map from reset wire to the source module and output reset Id reset_out_ports = [ (wire, (mod_id, rst_id)) | avi <- raw_avis, let mod_id = avi_vname avi, (rst_id, (wire, _, _)) <- getOutputResetPorts avi ] -- in case some resets are unused, filter the used resets reset_srcs = let used_rsts = map snd rst_defs isUsed (i, _) = i `elem` used_rsts in filter isUsed reset_out_ports -- ---------- -- names of input resets in_resets = -- is it overkill to check for ResetArg? -- we could just look for AAI_Reset in "sp_inputs pkg" [ port_id | (AAI_Reset port_id, ResetArg _) <- getSimPackageInputs pkg ] -- ---------- -- Put it all together sim_block = SimCCBlock (M.findWithDefault 0 class_name name_map) class_name (\ args -> (class_name, args)) domains state arg_defs rst_defs ports pub_defs pri_defs rule_fns method_fns reset_fns task_defs reset_srcs in_resets (map fst output_resets) input_clks gate_map in sim_block -- Get the name of the SimPackage's module as a String getModuleName :: SimPackage -> String getModuleName pkg = getIdBaseString (sp_name pkg) -- Get the SimCCBlock Id corresponding to a module name modNameToSBId :: NameMap -> String -> SBId modNameToSBId map name = case M.lookup name map of (Just sbid) -> sbid Nothing -> internalError ("unknown block name: " ++ name) -- Extract the values needed for SimCCBlock state from an AVInst mkState :: NameMap -> AVInst -> (SBId,AId,[AExpr]) mkState name_map avinst = let inst_name = avi_vname avinst mod_info = avi_vmi avinst sbid = modNameToSBId name_map (getVNameString (vName mod_info)) -- get the instantiation argument exprs iarg_pairs = getInstArgs avinst -- the only clk/rst, if any, are the defaults. -- drop them and only consider the other arguments iarg_pairs_no_clk = filter (\ (i,e) -> not (isClock i || isReset i) ) iarg_pairs -- just the exprs iarg_exprs_no_clk = map snd iarg_pairs_no_clk -- we do not check whether these exprs are static, because that was -- already checked both when generating .ba and when reading back in in (sbid, inst_name, iarg_exprs_no_clk) mkNoInlineState :: NameMap -> (String, String) -> (SBId, AId, [AExpr]) mkNoInlineState name_map (inst, mod) = let -- no position is ok, because we only use this as a lookup into -- the sb_map inst_name = mkId noPosition (mkFString inst) sbid = modNameToSBId name_map mod inst_args = [] in (sbid, inst_name, inst_args) -- Convert an ADef into an (AType,AId) pair that is used by SimCCBlock cvtADef :: ADef -> (AType,AId) cvtADef (ADef aid ty expr _) = (ty,aid) -- Convert a list of AActions into a list of SimCCFnStmts, -- where the list also includes assignments for all -- definitions used by the actions, and definitions used -- by those definitions, etc. -- (Takes a list of additional Ids whose defs should be sorted -- along with the defs needed for any other values, say for an ActionValue, -- which is unioned with the defs for the action part.) cvtActions :: Id -> Id -> DefMap -> MethodOrderMap -> IdSet -> [AAction] -> [AId] -> [SimCCFnStmt] cvtActions modId rId def_map method_order_map other_defs acts reset_ids = let -- get all ids for defs used in the actions action_ids = getIds def_map S.empty acts -- merge in the other defs (needed for, say, an ActionValue) ids = other_defs `S.union` action_ids -- get their defs defs = map (findDef def_map) (S.toList ids) -- order the defs and actions, and convert to statements -- XXX is it more efficient to pass in the whole def map, -- XXX than have this func make its own map of just the defs used? ordered_stmts = tsortActionsAndDefs modId rId method_order_map defs acts reset_ids in ordered_stmts -- Convert a rule body into a SimCCFn cvtARule :: Id -> DefMap -> MethodOrderMap -> [(ResetId, AReset)] -> ARule -> SimCCFn cvtARule modId def_map method_order_map reset_list (ARule rId _ _ wp _ acts _ _) = let name = getIdBaseString rId args = [] reset_ids = map (ae_objid . areset_wire) (mapMaybe (\n -> lookup n reset_list) (wpResets wp)) body = cvtActions modId rId def_map method_order_map S.empty acts reset_ids in SimCCFn name args Nothing body -- Convert an interface method body into a SimCCFn -- Some AIFace variants return Nothing, others -- build a SimCCFn with the correct name, return type, -- arguments and body. As for a rule, the body includes -- assignments for defs used by the method. -- The method ports are handled specially, since they exist -- in the ports sub-structure and may also appear as -- arguments to the method. cvtIFace :: Id -> [PProp] -> DefMap -> MethMap -> MethodOrderMap -> [(ResetId, AReset)] -> AIFace -> Maybe SimCCFn cvtIFace modId pps def_map meth_map method_order_map reset_list m = do let name = aIfaceName m inputs = aIfaceArgs m args = [ (t,i) | (i,t) <- inputs ] -- always_enabled methods need to forcibly check their ready signal -- for situations like gated clocks because we've disabled -- all errors when the user lies check_rdy ss = if ((isAlwaysEn pps name) && (aIfaceHasAction m)) then -- we have to find the name of the port associated -- with the RDY method let rdy_id = mkRdyId (aIfaceName m) mport = do (_,_,Just (_,vn),_,_) <- M.lookup rdy_id meth_map return $ ASPort aTBool (vName_to_id vn) in case mport of (Just prt) -> [SFSCond prt ss []] Nothing -> internalError ("cvtIFace: failed to locate RDY port " ++ "for method " ++ (ppReadable rdy_id)) else ss body = concatMap arule_actions (aIfaceRules m) -- is it enough to look at the method's wire props, not each rule's? -- it should be because the evaluator should ensure the entire method -- is in a single clock domain wp = aIfaceProps m rst_ids = map (ae_objid . areset_wire) (mapMaybe (\n -> lookup n reset_list) (wpResets wp)) (men, ins, mr, _, ifcrules) <- M.lookup name meth_map let prt vn = vName_to_id vn rt = do { (t,_) <- mr; return t } en_stmts = maybe [] (\vn -> [SFSAssign True (prt vn) aTrue]) men wf_stmts = map (\i -> SFSAssign False (mkIdWillFire i) aTrue) ifcrules in_stmts = map (\(t,i,vn) -> SFSAssign True (prt vn) (ASPort t i)) ins body_stmts = case mr of Just (t,vn) -> -- account for the possible return of an actionvalue result let -- the return def ret_def = aif_value m ret_id = adef_objid ret_def ret_type = adef_type ret_def -- the port name port_id = prt vn -- find all the defs needed to compute the return value def_map' = M.insert ret_id ret_def def_map ret_expr = ASDef ret_type ret_id val_ids = getExprIds False def_map' S.empty [ret_expr] -- convert the body to SimCCFnStmts ss = cvtActions modId name def_map' method_order_map val_ids body rst_ids -- find assignments to ret_def and replace with port_id replaceRetDef (SFSAssign _ i e) | (i == ret_id) = (SFSAssign True port_id e) replaceRetDef (SFSAssignAction _ i a t) | (i == ret_id) = (SFSAssignAction True port_id a t) -- the assignment might be guarded by a reset replaceRetDef (SFSCond c ts fs) = (SFSCond c (map replaceRetDef ts) (map replaceRetDef fs)) replaceRetDef s = s ss' = map replaceRetDef ss -- at the end of the method, return the port value ret_stmts = [ SFSReturn (Just (ASPort t port_id)) ] in -- XXX This returns the stale port value in the case when -- and always-enabled ActionValue method is called and its -- ready is off (the user lied about it being always_en'd), -- but, at that point, all bets are off anyway check_rdy ss' ++ ret_stmts Nothing -> check_rdy $ cvtActions modId name def_map method_order_map S.empty body rst_ids all_stmts = concat [en_stmts, wf_stmts, in_stmts, body_stmts] return $ SimCCFn (getIdBaseString name) args rt all_stmts cvtReset :: (ResetId, AExpr, [(AId,AId)], [AId]) -> SimCCFn cvtReset (rst_num, port, inst_ports, output_resets) = let rstval_id = mk_homeless_id "rst_in" rstval_ref = ASPort aTBool rstval_id body = [ SFSAssign True (ae_objid port) rstval_ref ] ++ [ SFSFunctionCall inst (mkResetFnName rst) [rstval_ref] | (inst, rst) <- inst_ports ] ++ [ SFSOutputReset outRstId rstval_ref | outRstId <- output_resets ] in SimCCFn (mkResetFnName (ae_objid port)) [(aTBool, rstval_id)] Nothing body -- Create the assignment for a def mkDefAssign :: ADef -> SimCCFnStmt mkDefAssign (ADef id _ expr _) = SFSAssign False id expr buildEnWFZeroStmts :: [(Maybe AId,[AId])] -> [SimCCFnStmt] buildEnWFZeroStmts xs = concat [ en_stmts ++ wf_stmts | (men,wfs) <- xs , let en_stmts = map (assign True) (maybeToList men) , let wf_stmts = map (assign False) wfs ] where assign is_port i= addScope top_blk_name (SFSAssign is_port i aFalse) doTickCall :: Bool -> InstModMap -> (AId, (AId,AClock)) -> Maybe (AClock, [(AId,AId,[AExpr])]) doTickCall is_posedge inst_map (inst_id, (port, clk)) = let inst_name = getIdString inst_id port_name = getIdBaseString port prim_type = case M.lookup inst_name inst_map of (Just t) -> t Nothing -> internalError $ "unknown instance: " ++ inst_name prim_entry = find (\(n,_,_,_) -> (n == prim_type)) primMap tick_list = case prim_entry of (Just (_,_,_,l)) -> if is_posedge then filter tickIsPos l else filter tickIsNeg l Nothing -> internalError $ "unknown primitive: " ++ prim_type port_tick = find (\t -> (tickElem t) == port_name) tick_list in case port_tick of (Just (Both _)) -> Just (clk, [(inst_id, port, [aSBool is_posedge])]) (Just (Pos _)) -> Just (clk, [(inst_id, port, [aTrue])]) (Just (Neg _)) -> Just (clk, [(inst_id, port, [aFalse])]) Nothing -> Nothing buildTickStmts :: Bool -> InstModMap -> [(AId, (AId,AClock))] -> [SimCCFnStmt] buildTickStmts is_posedge inst_map prims = let ticks = mapMaybe (doTickCall is_posedge inst_map) prims sorted_ticks = sortTickCalls ticks in concatMap mkTickStmt sorted_ticks sortTickCalls :: [(AClock, [(AId,AId,[AExpr])])] -> [(AClock, [(AId,AId,[AExpr])])] sortTickCalls ticks = let -- join ticks for the same clock grouped_ticks_map = M.fromListWith (++) ticks findCalls clk = case (M.lookup clk grouped_ticks_map) of Just calls -> (clk, calls) Nothing -> internalError ("sortTickCalls: missing from map: " ++ ppReadable clk) clocks = M.keys grouped_ticks_map -- map from a gate to its clock clock_map = let mkEdge clk = case (aclock_gate clk) of (AMGate _ modId _) -> Just (modId, [clk]) (ASPort _ objId) -> Just (mk_homeless_id (getIdQualString objId), [clk]) _ -> Nothing es = mapMaybe mkEdge clocks in M.fromListWith (++) es -- for a set of ticks, find the Ids of the submods that are ticked getModIds calls = map fst3 calls -- make the tsort edges mkEdge (clk, calls) = let mods = getModIds calls clocks = concat (mapMaybe (\i -> M.lookup i clock_map) mods) in (clk, clocks) edges = map mkEdge (M.toList grouped_ticks_map) in case (tsort edges) of Left is -> internalError ("sortTickCalls: cyclic " ++ ppReadable is) Right is -> map findCalls (reverse is) -- map from an edge of a clock expression to schedule stmts, tick calls, etc. data SchedStmtGroup = SchedFns { sched_stmts :: [SimCCFnStmt] , sched_ticks :: [SimCCFnStmt] , sched_after :: [SimCCFnStmt] } type SchedStmtMap = M.Map (TickDirection AExpr) SchedStmtGroup combineStmtGroups :: SchedStmtGroup -> SchedStmtGroup -> SchedStmtGroup combineStmtGroups (SchedFns a1 b1 c1) (SchedFns a2 b2 c2) = SchedFns (a1 ++ a2) (b1 ++ b2) (c1 ++ c2) -- Convert a SimSchedule into a map from clock edges to pairs of -- schedule statements and tick statements. mkScheduleStmts :: Flags -> [AIFace] -> S.Set AId -> S.Set AId -> [AId] -> InstModMap -> ModDefMap -> ModMethMap -> CallMap -> SimSchedule -> SchedStmtMap mkScheduleStmts flags top_ifc top_vmeth_set top_ameth_set top_gates inst_map full_def_map full_meth_map call_map sim_sched = let sched_order = ss_sched_order sim_sched disjoint_map = ss_disjoint_rules_db sim_sched -- This should be a list of one element domain_infos = M.toList (ss_domain_info_map sim_sched) clk_expr = aclock_osc (ss_clock sim_sched) rules = concatMap (di_rules . snd) domain_infos lookupMethods r = do mod <- M.lookup (getIdQualString r) inst_map calls <- M.lookup mod call_map lookup (unQualId r) calls calls_by_rule = M.fromList $ [ (r, maybe [] id (lookupMethods r)) | r <- (rules ++ (S.toList top_ameth_set)) -- XXX unnecessary conversion ] isNotPrimitive q m = let inst = if (null q) then getIdQualString m else q ++ "." ++ (getIdQualString m) in case M.lookup inst inst_map of (Just x) -> not (isPrimitiveModule x) Nothing -> internalError $ "bad instance: " ++ (ppReadable m) non_prim_calls = M.mapWithKey (\r -> (filter (isNotPrimitive (getIdQualString r)))) calls_by_rule -- partition sched_order into early_sched_order and edge_sched_order isEarlyNode (Exec rid) = rid `elem` (ss_early_rules sim_sched) isEarlyNode (Sched rid) = rid `elem` (ss_early_rules sim_sched) (early_sched_order, edge_sched_order) = partition isEarlyNode sched_order -- build the schedule statements sched_ME_inhibits = mkMERuleInhibits top_vmeth_set sched_order disjoint_map sched_conflicts = case (ss_schedule sim_sched) of (ASchedule [ASchedEsposito cs] _) -> cs (ASchedule as _) -> internalError ("mkScheduleStmts: as = " ++ ppReadable as) gate_substs = mkGateSubstMap top_gates $ concatMap (di_clock_substs . snd) domain_infos mkStmt = mkSchedStmts top_ifc top_vmeth_set top_ameth_set inst_map full_def_map non_prim_calls gate_substs sched_conflicts sched_ME_inhibits (pos_rule_stmts, neg_rule_stmts) = if (ss_posedge sim_sched) then (stableOrdNub (concatMap mkStmt edge_sched_order), []) else ([], stableOrdNub (concatMap mkStmt edge_sched_order)) (after_posedge_stmts, after_negedge_stmts) = if (ss_posedge sim_sched) then (stableOrdNub (concatMap mkStmt early_sched_order), []) else ([], stableOrdNub (concatMap mkStmt early_sched_order)) -- determine all ids used in the schedule used_ids = S.fromList $ (concatMap defs_read (pos_rule_stmts ++ neg_rule_stmts ++ after_posedge_stmts ++ after_negedge_stmts)) isUsedId i = (i `inlineIdFrom` top_blk_name) `S.member` used_ids -- build the enable-zeroing statements schedule_rules = [ i | (Exec i) <- edge_sched_order ] getMeths r = do ms <- M.lookup r non_prim_calls let inst = getIdQualString r qms = [ addToQual inst m | m <- ms ] return qms schedule_methods = stableOrdNub $ concat $ mapMaybe getMeths schedule_rules getEnWFPort m = do let inst = getIdQualString m mod <- M.lookup inst inst_map let meth_map = findModMeth full_meth_map mod (e,_,_,_,rs) <- M.lookup (unQualId m) meth_map let en = do v <- e return $ (vName_to_id v) `inlineIdFrom` inst wfs = [ (mkIdWillFire i) `inlineIdFrom` inst | i <- rs ] init_port = (keepFires flags) || (any isUsedId ((maybeToList en) ++ wfs)) if init_port then return (en,wfs) else Nothing schedule_enables = mapMaybe getEnWFPort schedule_methods (pos_enable_stmts, neg_enable_stmts) = if (ss_posedge sim_sched) then (buildEnWFZeroStmts schedule_enables, []) else ([], buildEnWFZeroStmts schedule_enables) -- build the tick statements prims = concatMap (di_prims . snd) domain_infos pos_tick_stmts = buildTickStmts True inst_map prims neg_tick_stmts = buildTickStmts False inst_map prims -- build the conditional reset tick stmts inst_clk_map = M.fromList [((i,c), ac) | (i,(c,ac)) <- prims] addGateInfo (inst,clk) = let gate = case M.lookup (inst,clk) inst_clk_map of Just ac -> -- if this is a top-level input, replace with True case (aclock_gate ac) of -- XXX might be cheaper to test that the Id -- XXX qualifier is empty? (ASPort _ portId) | portId `elem` top_gates -> aTrue g -> g Nothing -> internalError $ "mkScheduleStmts: no primitive info for " ++ (ppReadable inst) ++ " with clock " ++ (ppReadable clk) in (inst,clk,gate) prims_with_reset = concatMap (di_prim_resets . snd) domain_infos reset_info = map addGateInfo prims_with_reset reset_tick_stmt = mkResetTickStmt reset_info -- combine the statements for each edge direction pos_stmt_group = SchedFns { sched_stmts = pos_enable_stmts ++ pos_rule_stmts , sched_ticks = pos_tick_stmts ++ [reset_tick_stmt] , sched_after = after_posedge_stmts } neg_stmt_group = SchedFns { sched_stmts = neg_enable_stmts ++ neg_rule_stmts , sched_ticks = neg_tick_stmts , sched_after = after_negedge_stmts } edge_stmt_list = [ (Pos clk_expr, pos_stmt_group) , (Neg clk_expr, neg_stmt_group) ] in M.fromList edge_stmt_list -- build a SimCCSched from an edge and sched and tick statement lists mkOneSchedule :: ((TickDirection AExpr), SchedStmtGroup) -> Maybe SimCCSched mkOneSchedule (clk, ssg) = let clk_expr = tickElem clk is_posedge = ((Pos clk_expr) == clk) fn_name = mkSchedName (clk_expr, is_posedge, False) after_fn_name = mkSchedName (clk_expr, is_posedge, True) edge_stmts = (sched_stmts ssg) ++ (sched_ticks ssg) edge_fn = SimCCFn fn_name [] Nothing edge_stmts after_fn = case (sched_after ssg) of [] -> Nothing xs -> Just $ SimCCFn after_fn_name [] Nothing xs in if (null edge_stmts) then Nothing else Just (SimCCSched { sched_clock = clk_expr , sched_posedge = is_posedge , sched_fn = edge_fn , sched_after_fn = after_fn }) -- build a SimSchedule based on the clocks and instances in a SimSchedule mkClockGroup :: SimSchedule -> SimCCClockGroup mkClockGroup ss = let aclk = ss_clock ss insts = concatMap di_domains (M.elems (ss_domain_info_map ss)) in SimCCClockGroup aclk insts mkGateInfo :: PackageMap -> [AId] -> InstModMap -> [SimSchedule] -> SimCCGateInfo mkGateInfo pkg_map top_gates inst_map scheds = let -- -------------------- -- The SimSchedule contains a substitution mapping from gates in the -- modules (with fully qualified hierarchy) to the real source of the -- gate (a primitive, also with fully qualified hierarchy) getDomainGateSubsts sched = let -- This should be a list of one element domain_infos = M.toList (ss_domain_info_map sched) in mkGateSubstMap top_gates $ concatMap (di_clock_substs . snd) domain_infos -- the full substitution map for the system gateSubsts = M.unions (map getDomainGateSubsts scheds) -- -------------------- -- The individual SimBlocks will not have fully qualified hierarchical -- names, so we the following functions to add that hierarchy qualifyId :: String -> AId -> AId qualifyId inst i = let q_str = getIdQualString i q_str' = if (q_str == "") then inst else inst ++ "." ++ q_str in setIdQualString i q_str' qualifyGate :: String -> AExpr -> AExpr qualifyGate inst (AMGate t oid cid) = (AMGate t (qualifyId inst oid) cid) qualifyGate inst (ASPort t g) = (ASPort t (qualifyId inst g)) qualifyGate inst e | isTrue e = e qualifyGate inst e = internalError ("qualifyGate: unexpected expr " ++ ppReadable e) -- -------------------- mkOneGateInfo :: String -> (Int, AExpr) -> (Int, Either Bool AId) mkOneGateInfo inst (num, gate) = let qual_gate = qualifyGate inst gate in case (M.lookup qual_gate gateSubsts) of Just (ASPort _ portId) -> (num, Right portId) Just gate_expr | isTrue gate_expr -> (num, Left True) Just gate_expr | isFalse gate_expr -> (num, Left False) Just gate_expr -> internalError ("mkOneGateInfo: unexpected src: " ++ show gate_expr) Nothing -> --internalError ("mkOneGateInfo: " ++ ppReadable qual_gate) -- This occurs if the clock is instantiated with noClock -- XXX Consider eliminating this by having mergeSched -- XXX include info for the noClock domain? (num, Left False) -- XXX True? mkGateInfo :: (String, String) -> Maybe (String, [(Int, Either Bool AId)]) mkGateInfo (inst, mod) = let modId = mk_homeless_id mod in case (M.lookup modId pkg_map) of Just pkg -> let gate_map = zip [0..] (sp_gate_map pkg) in Just (inst, map (mkOneGateInfo inst) gate_map) _ | isPrimitiveModule mod -> Nothing _ -> internalError ("mkGateInfo: " ++ mod ++ "\n" ++ ppReadable (M.keys pkg_map)) in mapMaybe mkGateInfo (M.toList inst_map) -- apply a binary primitive to a list to reduce it to a singleton reduce :: PrimOp -> [AExpr] -> [AExpr] reduce prim [] = [] reduce prim [e] = [e] reduce prim [e1,e2] = [APrim dummy_id (ae_type e1) prim [e1,e2]] reduce prim es = reduce prim (concatMap (reduce prim) (pairs es)) where pairs [] = [] pairs [x] = [[x]] pairs (x:y:rest) = [[x,y]] ++ (pairs rest) -- functions for adding instance scope to Id qualifiers when inlining inlineIdFrom :: Id -> String -> Id inlineIdFrom aid scope = addToQual scope aid inlineExprFrom :: AExpr -> String -> AExpr inlineExprFrom expr scope = mapExprIds (`inlineIdFrom` scope) expr mapExprIds :: (AId -> AId) -> AExpr -> AExpr mapExprIds fn expr = mapAExprs (aIdFnToAExprFn fn) expr mapActionIds :: (AId -> AId) -> AAction -> AAction mapActionIds fn act = mapAActions (aIdFnToAActionFn fn) act addScope :: String -> SimCCFnStmt -> SimCCFnStmt -- if the scope is empty, do nothing addScope "" x = x addScope scope (SFSDef p (ty,aid) (Just v)) = let aid' = aid `inlineIdFrom` scope v' = v `inlineExprFrom` scope in SFSDef p (ty, aid') (Just v') addScope scope (SFSDef p (ty,aid) Nothing) = let aid' = aid `inlineIdFrom` scope in SFSDef p (ty, aid') Nothing addScope scope (SFSAssign p aid v) = let aid' = aid `inlineIdFrom` scope v' = v `inlineExprFrom` scope in SFSAssign p aid' v' addScope scope (SFSAction action) = SFSAction (mapActionIds (`inlineIdFrom` scope) action) addScope scope (SFSAssignAction p aid action ty) = let aid' = aid `inlineIdFrom` scope action' = mapActionIds (`inlineIdFrom` scope) action in SFSAssignAction p aid' action' ty addScope scope (SFSRuleExec rid) = let rid' = rid `inlineIdFrom` scope in SFSRuleExec rid' addScope scope (SFSCond cond ts fs) = let cond' = cond `inlineExprFrom` scope ts' = map (addScope scope) ts fs' = map (addScope scope) fs in SFSCond cond' ts' fs' addScope scope (SFSMethodCall obj meth args) = let obj' = obj `inlineIdFrom` scope args' = map (`inlineExprFrom` scope) args in SFSMethodCall obj' meth args' addScope scope (SFSFunctionCall obj func args) = let obj' = obj `inlineIdFrom` scope args' = map (`inlineExprFrom` scope) args in SFSFunctionCall obj' func args' addScope scope (SFSResets stmts) = let stmts' = map (addScope scope) stmts in SFSResets stmts' addScope scope (SFSReturn Nothing) = SFSReturn Nothing addScope scope (SFSReturn (Just v)) = let v' = v `inlineExprFrom` scope in SFSReturn (Just v') -- It is unlikely that scope will be added to an OutputReset, but here it is addScope scope (SFSOutputReset rstId val) = let rstId' = rstId `inlineIdFrom` scope val' = val `inlineExprFrom` scope in SFSOutputReset rstId' val' -- Create the SimCCFnStmts that correspond to a schedule node mkSchedStmts :: [AIFace] -> S.Set AId -> S.Set AId -> InstModMap -> ModDefMap -> M.Map ARuleId [AId] -> GateSubstMap -> [(AId, [AId])] -> M.Map AId [AId] -> SchedNode -> [SimCCFnStmt] mkSchedStmts top_ifc top_vmeth_set top_ameth_set inst_map full_dmap calls_by_rule gate_substs sched_conflicts sched_me_inhibits (Sched qual_rid) = let method_calls = fromMaybe [] (M.lookup qual_rid calls_by_rule) in if (qual_rid `S.member` top_vmeth_set) then mkValueMethodSchedStmts top_ifc top_vmeth_set top_ameth_set inst_map full_dmap gate_substs sched_conflicts sched_me_inhibits qual_rid else if (qual_rid `S.member` top_ameth_set) then mkActionMethodSchedStmts top_ifc top_vmeth_set top_ameth_set inst_map full_dmap method_calls gate_substs sched_conflicts sched_me_inhibits qual_rid else mkRuleSchedStmts inst_map full_dmap method_calls gate_substs sched_conflicts sched_me_inhibits qual_rid mkSchedStmts top_ifc top_vmeth_set top_ameth_set inst_map full_dmap calls_by_rule gate_substs sched_conflicts sched_me_inhibits (Exec rid) = if (rid `S.member` top_vmeth_set) then mkValueMethodExecStmts top_ifc top_vmeth_set top_ameth_set inst_map full_dmap gate_substs sched_conflicts sched_me_inhibits rid else if (rid `S.member` top_ameth_set) then mkActionMethodExecStmts top_ifc top_vmeth_set top_ameth_set inst_map full_dmap gate_substs sched_conflicts sched_me_inhibits rid else mkRuleExecStmts top_ifc top_vmeth_set top_ameth_set inst_map full_dmap gate_substs sched_conflicts sched_me_inhibits rid -- Make statements for determining if a value method is ready mkValueMethodSchedStmts :: [AIFace] -> S.Set AId -> S.Set AId -> InstModMap -> ModDefMap -> GateSubstMap -> [(AId, [AId])] -> M.Map AId [AId] -> AId -> [SimCCFnStmt] mkValueMethodSchedStmts top_ifc top_vmeth_set top_ameth_set inst_map full_dmap gate_substs sched_conflicts sched_me_inhibits qual_rid = [] -- Make statements for determining if an action method should fire mkActionMethodSchedStmts :: [AIFace] -> S.Set AId -> S.Set AId -> InstModMap -> ModDefMap -> [AId] -> GateSubstMap -> [(AId, [AId])] -> M.Map AId [AId] -> AId -> [SimCCFnStmt] mkActionMethodSchedStmts top_ifc top_vmeth_set top_ameth_set inst_map full_dmap method_calls gate_substs sched_conflicts sched_me_inhibits qual_rid = let bit_type = ATBit 1 wf = mkIdWillFire qual_rid unqual_wf = unQualId wf -- The qualifier tells us which submodule instance this rule is in. -- Remove the qualifier and use it to get the def_map for the defs -- in that module. Then process the rule unqualified, using that map. inst = getIdQualString qual_rid modtype = findInstMod inst_map inst def_map = findModDef full_dmap modtype -- ---------- -- Get all the defs needed for the WF expr ids = S.toList $ getExprIds True def_map S.empty [ASDef bit_type unqual_wf] defs = tsortADefs $ map (findDef def_map) ids -- ---------- -- Call the RDY method for top-level methods, since they may check their -- RDY port in the method body. call_rdy_method = [ SFSMethodCall (setIdBase emptyId (getIdQual qual_rid)) (mkRdyId (unQualId qual_rid)) [] ] -- ---------- -- The sub-methods this method calls may need to check their RDY ports -- if they are always_ready, so we need to call the RDY method for -- any methods which might be called but are not in the WF expr. wf_rdys = [ (setIdQualString emptyId (getIdBaseString inst), unQualId rm) | (inst,rm) <- -- "aMethCalls" can return duplicates, but that's OK concatMap (aMethCalls . adef_expr) defs ] meth_rdys = [ (setIdBase m fsEmpty, unQualId (mkRdyId m)) | m <- method_calls ] rdy_calls = [ addScope inst (SFSMethodCall obj rdy []) | (obj,rdy) <- (nub meth_rdys) \\ wf_rdys ] -- ---------- -- Make the statements stmts = (map mkDefAssign defs) ++ call_rdy_method ++ rdy_calls in map (addScope top_blk_name) stmts -- Make statements for determining if a rule should fire mkRuleSchedStmts :: InstModMap -> ModDefMap -> [AId] -> GateSubstMap -> [(AId, [AId])] -> M.Map AId [AId] -> AId -> [SimCCFnStmt] mkRuleSchedStmts inst_map full_dmap method_calls gate_substs sched_conflicts sched_me_inhibits qual_rid = let bit_type = ATBit 1 cf = mkIdCanFire qual_rid wf = mkIdWillFire qual_rid unqual_wf = unQualId wf -- The qualifier tells us which submodule instance this rule is in. -- Remove the qualifier and use it to get the def_map for the defs -- in that module. Then process the rule unqualified, using that map. inst = getIdQualString qual_rid modtype = findInstMod inst_map inst def_map = findModDef full_dmap modtype -- ---------- -- Get all the defs needed for the WF expr ids = S.toList $ getExprIds True def_map S.empty [ASDef bit_type unqual_wf] defs = tsortADefs $ map (findDef def_map) ids -- ---------- -- Make the statements stmts = map mkDefAssign defs -- reintroduce the instance hierarchy to the WF and its defs, -- so that the variables referenced are from the proper scope. qual_stmts0 = map (addScope inst) stmts -- ---------- -- replace any gate references with the substitute value -- (the substs have the full scope, so this step requires that the -- defs have had the scope added, as was just done above) qual_stmts1 = substGateReferences gate_substs qual_stmts0 -- ---------- -- Mutual exclusion inhibitors to be added to the CF -- The purpose of this is to deal with the way that Bluesim -- performs updates directly. This can cause 2 rules with -- mutually exclusive conditions to be fired together erroneously -- if the first rule is schedule and executed, and its execution -- makes the predicate of the second rule true. The "solution" -- used here is to explicitly add logic to prevent this case. me_inhibitors = -- XXX we could take advantage of the fact that the inhibits are -- XXX in order, so the lookup should be the top of the list case (M.lookup qual_rid sched_me_inhibits) of Nothing -> [] Just is -> is inhibit_ids = map mkIdCanFire me_inhibitors inhibit_expr = reduce PrimBOr (map (ASDef bit_type) inhibit_ids) addInhibitExpr base_expr = case inhibit_expr of [] -> base_expr [cfl] -> let not_inhibit = APrim dummy_id bit_type PrimBNot [cfl] in APrim dummy_id bit_type PrimBAnd [base_expr, not_inhibit] _ -> internalError "reduce produced a list of length > 1" -- ---------- -- Update the CF with the inhibitor updateCFStmt (SFSAssign p i e) | (i == cf) = SFSAssign p i (addInhibitExpr e) updateCFStmt d = d qual_stmts2 = map updateCFStmt qual_stmts1 -- ---------- -- Methods in the rule which are always_ready may need to check -- their RDY ports, so we need to call the RDY method for any methods -- which might be called but are not in the WF expr. wf_rdys = [ (setIdQualString emptyId (getIdBaseString inst), unQualId rm) | (inst,rm) <- -- "aMethCalls" can return duplicates, but that's OK concatMap (aMethCalls . adef_expr) defs ] rl_rdys = [ (setIdBase m fsEmpty, unQualId (mkRdyId m)) | m <- method_calls ] rdy_calls = [ addScope inst (SFSMethodCall obj rdy []) | (obj,rdy) <- (nub rl_rdys) \\ wf_rdys ] in -- in addition to the submodule instance hierarchy, -- we add the top module instance to all identifiers map (addScope top_blk_name) (rdy_calls ++ qual_stmts2) -- Make statements for computing value method outputs mkValueMethodExecStmts :: [AIFace] -> S.Set AId -> S.Set AId -> InstModMap -> ModDefMap -> GateSubstMap -> [(AId, [AId])] -> M.Map AId [AId] -> AId -> [SimCCFnStmt] mkValueMethodExecStmts top_ifc top_vmeth_set top_ameth_set inst_map full_dmap gate_substs sched_conflicts sched_me_inhibits rid = [] -- Make statements for executing an action method mkActionMethodExecStmts :: [AIFace] -> S.Set AId -> S.Set AId -> InstModMap -> ModDefMap -> GateSubstMap -> [(AId, [AId])] -> M.Map AId [AId] -> AId -> [SimCCFnStmt] mkActionMethodExecStmts top_ifc top_vmeth_set top_ameth_set inst_map full_dmap gate_substs sched_conflicts sched_me_inhibits mid = let blk_id = mk_homeless_id top_blk_name wf = (mkIdWillFire mid) `inlineIdFrom` top_blk_name method = headOrErr ("method not in interface: " ++ (ppReadable mid)) [ m | m <- top_ifc, aif_name m == mid ] args = [ ASPort t (i `inlineIdFrom` top_blk_name) | (i,t) <- aif_inputs method ] cond_stmt = SFSCond (ASDef (ATBit 1) wf) [SFSMethodCall blk_id mid args] [] in [cond_stmt] -- Make statements for executing a rule mkRuleExecStmts :: [AIFace] -> S.Set AId -> S.Set AId -> InstModMap -> ModDefMap -> GateSubstMap -> [(AId, [AId])] -> M.Map AId [AId] -> AId -> [SimCCFnStmt] mkRuleExecStmts top_ifc top_vmeth_set top_ameth_set inst_map full_dmap gate_substs sched_conflicts sched_me_inhibits rid = let wf = mkIdWillFire rid cond_stmt = SFSCond (ASDef (ATBit 1) wf) [SFSRuleExec rid] [] in map (addScope top_blk_name) [cond_stmt] -- Create the SimCCFnStmt that corresponds to a group of tick calls -- for a clock. mkTickStmt :: (AClock, [(AId,AId,[AExpr])]) -> [SimCCFnStmt] mkTickStmt (clk, ticks) = let gate = aclock_gate clk calls = [ SFSFunctionCall obj (getIdBaseString mid) (args ++ [gate]) | (obj,mid,args) <- ticks ] in map (addScope top_blk_name) calls -- Create the SimCCFnStmt that corresponds to a group of reset tick -- calls for the primitives clocked by a clock. mkResetTickStmt :: [(AId,AId,AExpr)] -> SimCCFnStmt mkResetTickStmt prims = let mname clk_id = "rst_tick_" ++ getIdBaseString clk_id calls = [ SFSFunctionCall obj (mname clk) [gate] | (obj,clk,gate) <- prims ] in addScope top_blk_name (SFSResets calls) -- =============== tsortActionsAndDefs :: Id -> Id -> MethodOrderMap -> [ADef] -> [AAction] -> [AId] -> [SimCCFnStmt] tsortActionsAndDefs modId rId mmap ds acts reset_ids = let -- we will create a graph where the edges are: -- * "Left AId" to represent a def (by it's name) -- * "Right Integer" to represent an action (by it's position in acts) -- The use of Left and Right was chosen to make Defs lower in -- the Ord order than Actions. This way, tsort puts them first. -- ---------- -- Defs -- the Ids of the defs -- (we only want to make edges for variable uses from this list) ds_ids = map adef_objid ds -- for efficiency, make it a set s = S.fromList ds_ids -- make edges for def-to-def dependencies def_edges = [ (Left i, map Left uses) | ADef i _ e _ <- ds, let uses = filter (`S.member` s) (aVars e) ] -- ---------- -- Actions -- give the actions a unique number and make a mapping -- (this is necessary because the same action can be repeated -- more than once ... for instance, $display on the same arguments) -- (numbering in order also helps the Ord order, for tsort) numbered_acts = zip [1..] acts act_map = M.fromList numbered_acts getAct n = case (M.lookup n act_map) of Just d -> d Nothing -> internalError "tsortActionsAndDefs: getAct" -- separate the sorts of actions -- * method calls we will re-order, respecting sequential composability -- * foreign task/function calls we will keep in order, but allow -- other things to come between them (because tasks can return -- values) isACall (_, ACall {}) = True isACall _ = False isATaskAction (_, ATaskAction {}) = True isATaskAction _ = False (method_calls, foreign_calls) = partition isACall numbered_acts task_calls = filter isATaskAction foreign_calls -- ---------- -- foreign-to-foreign edges -- (to maintain the user-specified order of system/foreign-func calls) -- (are these still needed now that we use Ord to bias tsort?) foreign_edges = if (length foreign_calls > 1) then let mkEdge (n1,_) (n2,_) = (Right n2, [Right n1]) in zipWith mkEdge (init foreign_calls) (tail foreign_calls) else [] -- ---------- -- Action to def edges -- any defs used by an action have to be computed before the -- action is called act_def_edges = [ (Right n, map Left uses) | (n,a) <- numbered_acts, let uses = filter (`S.member` s) (aVars a) ] -- ---------- -- Action method to Action method edges -- function to create order edges -- m1 `isBefore` m2 == True -- when (m1 SB m2) is in the VModInfo for the submodule isBefore (ACall obj1 meth1 _) (ACall obj2 meth2 _) = -- do they act on the same object? if (obj1 /= obj2) then False else let mset = findMethodOrderSet mmap obj1 in (unQualId meth1, unQualId meth2) `S.member` mset isBefore _ _ = False -- order the method calls -- The edges must be of the form (a, as) s.t. all actions in "as" -- have to execute before "a". meth_edges = [ (Right n1, ns) | (n1,a1) <- method_calls, let ns = [ Right n2 | (n2,a2) <- numbered_acts, a2 /= a1, a2 `isBefore` a1 ] ] -- ---------- -- ActionValue method edges (av_meth_edges, av_meth_set, av_meth_local_vars) = mkAVMethEdges ds method_calls -- ---------- -- ActionValue task edges -- Make edges from the task to the def that it sets -- (ATaskValue is always a top-level def, and the Id is stored -- in the ATaskAction by the ATaskSplice stage.) -- (Rather than remove the def for the ATaskValue and make edges from -- the users of that def to the ATaskAction, we leave the def in -- the graph and just generate nothing for it when we make statements -- from the flattened graph.) av_task_edges = [ (Left tmp_id, [Right n]) | (n, ATaskAction { ataskact_temp=(Just tmp_id) }) <- task_calls ] -- ---------- -- Action / Value method call edges -- like isBefore, but for Action vs Value method isVMethSB v_obj v_meth (ACall a_obj a_meth _) = -- do they act on the same object? if (v_obj /= a_obj) then False else let mset = findMethodOrderSet mmap v_obj in (unQualId v_meth, unQualId a_meth) `S.member` mset isVMethSB _ _ _ = False isAMethSB v_obj v_meth (ACall a_obj a_meth _) = -- do they act on the same object? if (v_obj /= a_obj) then False else let mset = findMethodOrderSet mmap v_obj in (unQualId a_meth, unQualId v_meth) `S.member` mset isAMethSB _ _ _ = False -- value method calls which are SB with action methods -- need to be properly ordered -- Edges must be of the form (m1, m2) where the method "m2" -- has to be executed before "m1". mdef_edges = [ edge | ADef i _ e _ <- ds, -- "aMethCalls" can return duplicates, but that's OK (obj,meth) <- aMethCalls e, edge <- -- def SB act [ (Right n, [Left i]) | (n,a) <- method_calls, isVMethSB obj meth a ] ++ -- act SB def (XXX can this happen?) [ (Left i, map Right ns) | let ns = map fst $ filter ((isAMethSB obj meth) . snd) method_calls, not (null ns) ] ] -- ---------- -- put it together into one graph g = {- trace ("acts = " ++ ppReadable numbered_acts) $ trace ("foreign_edges = " ++ ppReadable (foreign_edges :: [Edge])) $ trace ("av_task_edges = " ++ ppReadable av_task_edges) $ trace ("av_meth_edges = " ++ ppReadable av_meth_edges) $ trace ("meth_edges = " ++ ppReadable (meth_edges :: [Edge])) $ trace ("mdef_edges = " ++ ppReadable mdef_edges) $ trace ("act_def_edges = " ++ ppReadable (act_def_edges :: [Edge])) $ -} M.fromListWith union $ concat [ foreign_edges , av_task_edges , av_meth_edges , meth_edges , mdef_edges , act_def_edges , def_edges ] -- Convert the graph to the format expected by tsort. g_edges = M.toList g -- ---------- -- convert a graph node back into a def/action -- and then to a SimCCFnStmt -- map def ids back to their exprs -- (remember to substitute away AMethValue references) defmap = M.fromList [ (i,d) | d@(ADef i _ _ _) <- ds ] getDef i = case (M.lookup i defmap) of Just d -> (mapAExprs substAV d) Nothing -> internalError "tsortActionsAndDefs: getDef" -- function to substitute ASDef for AMethValue substAV (AMethValue ty obj meth) = ASDef ty (mkAVMethTmpId obj meth) substAV (APrim i t o es) = (APrim i t o (map substAV es)) substAV (AMethCall t o m es) = (AMethCall t o m (map substAV es)) substAV (AFunCall t o f isC es) = (AFunCall t o f isC (map substAV es)) substAV e = e -- allow statements to be conditional on the rule not being reset reset_cond = reduce PrimBOr [ APrim dummy_id aTBool PrimEQ [ASPort aTBool rst_id, aFalse] | rst_id <- reset_ids ] addRstCond s = case reset_cond of [] -> s [c] -> [ SFSCond (aNot c) s [] ] _ -> internalError "reduce produced a list of length > 1" -- defs are SFSAssigns, actions are actions, -- actionvalue are assignactions -- filter out the ATaskValue defs (see av_task_edges) convertNode (Left (ADef _ _ (ATaskValue {}) _)) = Nothing convertNode (Left d) = Just [mkDefAssign d] convertNode (Right (False,acts)) = Just (map cvt_action acts) convertNode (Right (True,acts)) = Just (addRstCond (map cvt_action acts)) cvt_action a@(ACall obj meth _) = case (M.lookup (obj,meth) av_meth_set) of Just ty -> SFSAssignAction False (mkAVMethTmpId obj meth) a ty Nothing -> SFSAction a cvt_action a@(ATaskAction { aact_objid = f_id , ataskact_temp = maybe_tmp_id , ataskact_value_type = ty }) = case (maybe_tmp_id) of Just tmp_id -> SFSAssignAction False tmp_id a ty Nothing -> SFSAction a cvt_action a@(AFCall {}) = SFSAction a -- g++ sometimes has a hard time with sequences of conditionals, -- so we try to group system tasks, etc. with the same reset -- condition into one if block. -- It's OK to leave stale values for these when in reset, -- since Verilog does as well. hasRst (Left _) = False hasRst (Right (ACall {})) = False hasRst (Right _) = True groupRsts [] = [] groupRsts ((Left d):rest) = (Left d):(groupRsts rest) groupRsts l@(x@(Right _):_) = let rst = hasRst x sameRight (Left _) = False sameRight r = hasRst r == rst (group,rest) = span sameRight l in (Right (rst,[act | (Right act) <- group])):(groupRsts rest) in -- tsort returns Left if there is a loop, Right if sorted. -- (In the absence of restrictive edges, tsort uses Ord to put -- the lower valued nodes first. Thus, we have chosen the node -- representation to put Defs first, followed by Actions in the -- order that they were give by the user.) case (tsort g_edges) of Left iss -> let -- lookup def and action nodes lookupFn = either (Left . getDef) (Right . getAct) xss = map (map lookupFn) iss in internalError ("tsortActionsAndDefs: cyclic: " ++ ppReadable (modId, rId) ++ ppReadable xss) Right is -> let -- lookup def and action nodes xs = map (either (Left . getDef) (Right . getAct)) is -- group by reset conditions grouped = groupRsts xs in -- declare the local temporaries av_meth_local_vars ++ -- convert the sorted and grouped nodes concat (mapMaybe convertNode grouped) -- ---------- type Node = Either AId Integer type Edge = (Node, [Node]) -- ---------- -- Given the defs and a list of only the action method calls (ACall), -- returns: -- * a list of edges between the defs using the value and any -- ActionValue ACall which is producing the value -- * a set of the ACall which are action value (mapped to their types) -- * a list of declarations for the new defs (holding the values) mkAVMethEdges :: [ADef] -> [(Integer, AAction)] -> ([Edge], M.Map (AId,AId) AType, [SimCCFnStmt]) mkAVMethEdges ds method_calls = let -- check whether an AMethValue is from a particular action isMethValueOf v_obj v_meth (ACall a_obj a_meth _) = (v_obj == a_obj) && (v_meth == a_meth) isMethValueOf _ _ _ = False -- find the AMethValue references av_meth_refs = [ (i, refs) | ADef i _ e _ <- ds, -- "aMethValues" can return duplicates let refs = nub $ aMethValues e, not (null refs) ] -- the value reference from an ActionValue needs to come after -- the action method call. -- Edges must be of the form (i, as) where all actions in "as" -- have to execute before "i" is computed. av_meth_edges = [ (Left i, map Right ns) | (i, refs) <- av_meth_refs, (obj,meth,_) <- refs, let ns = map fst $ filter ((isMethValueOf obj meth) . snd) method_calls, not (null ns) ] mkAVMethDecl (obj,meth,ty) = let id = mkAVMethTmpId obj meth in SFSDef False (ty, id) Nothing av_meths = unions (map snd av_meth_refs) av_meth_local_vars = map mkAVMethDecl av_meths av_meth_set = M.fromList (map (\ (o,m,t) -> ((o,m),t)) av_meths) in (av_meth_edges, av_meth_set, av_meth_local_vars) -- We'll need to declare local variables for the actionvalues, -- and replace AMethValue with (bogus) ASDef reference for the new -- temporary (prior to being converted to CC) mkAVMethTmpId :: Id -> Id -> Id mkAVMethTmpId obj meth = -- XXX make sure this Id is unique? mkId noPosition (concatFString [mkFString "AVMeth_", getIdBase obj, fsUnderscore, getIdBase meth]) -- =============== type GateSubstMap = M.Map AExpr AExpr mkGateSubstMap :: [AId] -> [(AClock, AClock)] -> GateSubstMap mkGateSubstMap top_gates es = let -- For now, replace top-level input gates with True mkTopSubst gateId = (ASPort (ATBit 1) gateId, aTrue) top_subst = M.fromList $ map mkTopSubst top_gates -- And update the existing substitutions substTop (orig, new) = (orig, M.findWithDefault new new top_subst) -- Convert a clock substitution into a gate substitution convEdge (orig_aclk, new_aclk) = (aclock_gate orig_aclk, aclock_gate new_aclk) es_subst = M.fromList $ map (substTop . convEdge) es in -- more efficient when the bigset is first es_subst `M.union` top_subst -- This should only be called on a list of converted defs -- (so the stmt list should only contain SFSAssign stmts) substGateReferences :: GateSubstMap -> [SimCCFnStmt] -> [SimCCFnStmt] substGateReferences smap stmts = let -- replace a gate if found in the map substInAExpr e@(AMGate {}) = M.findWithDefault e e smap substInAExpr e@(ASPort {}) = M.findWithDefault e e smap -- otherwise, follow exprs substInAExpr e@(APrim { ae_args = es }) = e { ae_args = map substInAExpr es } substInAExpr e@(AMethCall { ae_args = es }) = e { ae_args = map substInAExpr es } substInAExpr e@(ANoInlineFunCall { ae_args = es }) = e { ae_args = map substInAExpr es } substInAExpr e@(AFunCall { ae_args = es }) = e { ae_args = map substInAExpr es } substInAExpr e = e substInStmt (SFSAssign p i e) = (SFSAssign p i (substInAExpr e)) substInStmt s = internalError ("substGateReferences: non-assign: " ++ ppReadable s) in map substInStmt stmts -- =============== -- Inserting mutual exclusion inhibitors mkMERuleInhibits :: S.Set AId -> [SchedNode] -> DisjointRulesDB -> M.Map AId [AId] mkMERuleInhibits top_vmeth_set sched_order disjoint_map = let -- value methods can't change state, so they don't need to inhibit foldfunc :: (IdSet, [(AId,[AId])]) -> SchedNode -> (IdSet, [(AId,[AId])]) foldfunc (seen_exec_nodes, res) (Exec r) = if (S.member r top_vmeth_set) then (seen_exec_nodes, res) else (S.insert r seen_exec_nodes, res) foldfunc (seen_exec_nodes, res) (Sched r) = case (M.lookup r disjoint_map) of Nothing -> (seen_exec_nodes, res) Just dset -> let inhibit_set = S.intersection dset seen_exec_nodes new_res = (r, S.toList inhibit_set) in (seen_exec_nodes, new_res:res) in M.fromList $ reverse $ snd $ foldl foldfunc (S.empty, []) sched_order -- ===============