{-# LANGUAGE CPP #-} module SimExpand ( simExpand, simExpandSched, simCheckPackage ) where import Data.Maybe (isNothing, isJust, catMaybes, mapMaybe, maybeToList) import Data.List (partition, union, nub, sort, sortBy, delete) import Control.Monad (when, guard, msum {-, mapM_ -}) import Debug.Trace import qualified Data.Map as M import qualified Data.Set as S import IOUtil(progArgs) import Error (internalError, EMsg, ErrMsg(..), ErrorHandle, bsError, convErrorTToIO) import Position (noPosition, getPosition) import PPrint import Flags import FStringCompat(mkFString) import Backend import PreStrings (sSigned, sUnsigned) import PreIds (idDefaultClock, idDefaultReset) import Id (mkId, setSignedId, getIdString, unQualId, isRdyId, getIdBaseString, getIdQualString, setIdQualString, emptyId, mkIdTempReturn) import VModInfo import Wires(WireProps(..), ClockDomain) import Pragma(PProp(..), isAlwaysEn, isEnWhenRdy, RulePragma(..)) import ASyntax import ASyntaxUtil(aSubst, findAExprs, exprFold) import AScheduleInfo import AUses(MethodId(..)) import Params(isConstAExpr) import SimPackage import SimPrimitiveModules(getPrimDomainInfo, checkBluesimPrimitives) import SimCCBlock(SimCCBlock(..), primBlocks) import SchedInfo (methodConflictInfo, sSB) import ABin (ABin(..), ABinModInfo(..)) import ABinUtil(HierMap, getABIHierarchy, assertNoSchedErr) import SimDomainInfo import ListUtil (mapFst, mapSnd) import SCC (tsort) import Util (headOrErr, map_insertManyWith, allPairs, stableOrdNub) import GraphUtil(extractOneCycle_map, reverseMap) -- =============== -- Traces trace_mergesched, trace_bs_mcd :: Bool trace_mergesched = "-trace-mergesched" `elem` progArgs trace_bs_mcd = "-trace-bs-mcd" `elem` progArgs -- =============== -- topname: the top module of the design -- fabis: the name of each .ba file paired with its contents -- (file + abi = fabi) -- the filename is kept for reporting errors to the user simExpand :: ErrorHandle -> Flags -> String -> [(String, ABin)] -> IO SimSystem simExpand errh flags topname fabis = do -- get the names of the primitives -- (to put in the list of mods we don't need .ba for) let prim_names = map sb_name primBlocks (topmodId, hiermap, instmap, ffuncmap, filemap, _, emodinfos_used_by_name) <- convErrorTToIO errh $ getABIHierarchy errh (verbose flags) (ifcPath flags) (Just Bluesim) prim_names topname fabis modinfos_used_by_name <- convErrorTToIO errh $ assertNoSchedErr emodinfos_used_by_name -- reject top-level modules with always_enabled ifc, if generating -- a Bluesim executable let topModInfo = case (lookup (getIdString topmodId) modinfos_used_by_name) of Just (mi,_) -> mi Nothing -> internalError ("simExpand: topmodId not found") when ((not (genSysC flags)) && (hasEnabledMethod topModInfo)) $ bsError errh [(noPosition, EBSimEnablePragma)] -- reject top-level modules with arguments or params in Bluesim or SystemC let (top_args, top_params) = getArgsAndParams topModInfo if (genSysC flags) then when ((not (null top_args)) || (not (null top_params))) $ bsError errh [(noPosition, EBSimTopLevelArgOrParam True (top_args ++ top_params))] else when ((not (null top_args)) || (not (null top_params))) $ bsError errh [(noPosition, EBSimTopLevelArgOrParam False (top_args ++ top_params))] simpkgs <- mapM (simExpandABin errh flags) (map snd modinfos_used_by_name) let pkg_map = M.fromList (map (\p -> (sp_name p,p)) simpkgs) -- record default clock and reset for top module let def_clk = msum $ [ lookup idDefaultClock xs | (PPclock_osc xs) <- (abmi_pps topModInfo) ] ++ [Just "CLK"] top_clk = do x <- def_clk guard (not (null x)) return x def_rst = msum $ [ lookup idDefaultReset xs | (PPreset_port xs) <- (abmi_pps topModInfo) ] ++ [Just "RSTN"] top_rst = do x <- def_rst guard (not (null x)) return x simscheds <- simExpandSched modinfos_used_by_name hiermap instmap topname return $ SimSystem { ssys_packages = pkg_map , ssys_schedules = simscheds , ssys_top = topmodId , ssys_instmap = instmap , ssys_ffuncmap = ffuncmap , ssys_filemap = filemap , ssys_default_clk = top_clk , ssys_default_rst = top_rst } -- =============== simExpandABin :: ErrorHandle -> Flags -> (ABinModInfo,String) -> IO SimPackage simExpandABin errh flags (abi,ver) = do let -- we will update the apkg, so name this as the initial value apkg0 = abmi_apkg abi when (trace_bs_mcd) $ do traceM ("domains = " ++ ppReadable (apkg_clock_domains apkg0)) traceM ("resets = " ++ ppReadable (apkg_reset_list apkg0)) let inst_tuples = [ (avi_vname avi, getInstArgs avi) | avi <- apkg_state_instances apkg0 ] traceM ("insts = " ++ ppReadable inst_tuples) let rule_tuples = [ (arule_id r, arule_wprops r) | r <- apkg_rules apkg0 ] traceM ("rules = " ++ ppReadable rule_tuples) -- ---------- -- Check the package for features not supported by Bluesim -- and do any necessary changes (such as inlining module arg exprs) -- We already did this prior to generating .ba, but we do it again -- here to be sure. -- Checks include: -- - Inout is not allowed in the ifc or as arguments -- - unsupported primitives (MCD, for example) -- - module arg exprs -- -- Bluesim can only handle module instantiation arguments which -- are static. VArgInfo distinguishes between Param and Port, -- but Bluesim has to treat everything as a Param. -- Check here that the values to Port are also constant expressions. -- -- However, isConstAExpr expects all defs to be inlined. -- During elaboration, iParams only inlines for Param exprs. -- Bluesim needs this inlining to be done for Port too. apkg1 <- simCheckPackage errh True apkg0 -- ---------- -- Make sure that all ActionValue method return values use a -- temporary def. This is required for the sorting which -- ensures that method calls occur in schedule order within an -- ActionValue method (see SimMakeCBlocks.hs::tsortActionsAndDefs). -- We also lift any method return of a foreign function result, -- because that is required for handling of imported function calls. let apkg = makeMethodTemps apkg1 let -- ---------- -- package fields -- these we will update, so name indicates they are the initial values defs0 = apkg_local_defs apkg -- ---------- -- Remove $signed and $unsigned calls -- Sign information is preserved in IdP_signed prop on the ADef's Id removeSignCasts def@(ADef id ty (AFunCall _ _ name _ [arg]) props) = if (name == sSigned) || (name == sUnsigned) then ADef (setSignedId id) ty arg props else def removeSignCasts def = def defs1 = map removeSignCasts defs0 -- ---------- -- convert noinline function calls to method calls -- and create instantiations for the modules they are calls on -- XXX technically, we don't need to convert to method calls, -- XXX if we handle ANoInlineFun in aExprToCExpr ? let (defs, noinline_instances) = getNoInlineInfo defs1 -- ---------- -- identify the gates used in the module (not just connected between mods) -- and assign unique numbers (to be the names for those gates in codegen) -- XXX Is it worth only keeping around the gates which are used as exprs -- XXX (or do we eventually want to dump VCDs for all gates, for example?) -- XXX Because maybe it's better to just walk the args and the submods -- XXX to get the full list, than to walk all AExprs of the module? -- XXX Note that some gates used directly in the ARule won't be included. let gates = findGates (apkg_inputs apkg) (apkg_interface apkg) defs -- ---------- -- create the SimPackage let insts = apkg_state_instances apkg let simpkg = SimPackage { sp_name = apkg_name apkg, sp_is_wrapped = apkg_is_wrapped apkg, sp_version = ver, sp_pps = abmi_pps abi, sp_size_params = apkg_size_params apkg, sp_inputs = apkg_inputs apkg, sp_clock_domains = apkg_clock_domains apkg, sp_external_wires = apkg_external_wires apkg, sp_reset_list = apkg_reset_list apkg, sp_state_instances = mkAVInstMap insts, sp_noinline_instances = noinline_instances, sp_method_order_map = mkMethodOrderMap insts, sp_local_defs = mkDefMap defs, sp_rules = apkg_rules apkg, sp_interface = apkg_interface apkg, sp_schedule = abmi_aschedinfo abi, sp_pathinfo = abmi_pathinfo abi, sp_gate_map = gates, sp_schedule_pragmas = apkg_schedule_pragmas apkg } return simpkg -- =============== simExpandSched :: [(String, (ABinModInfo,String))] -> HierMap -> InstModMap -> String -> IO [SimSchedule] simExpandSched abis0 hiermap instmap topmod = do let abis = [ (n,mi) | (n,(mi,_)) <- abis0 ] -- ---------- -- merge the schedules combscheds_by_domain -- :: [(AClock, CombSchedInfo)] <- mergeSchedules abis hiermap instmap topmod -- ---------- -- create the SimSchedule let mkPosSched (aclk, csi) = let (sched_graph, sched_order) = flattenCombSchedGraph csi (sched_nodes, exec_nodes) = partition isSchedNode sched_order urgency_order = map getSchedNodeId sched_nodes earliness_order = map getSchedNodeId exec_nodes find_conflicts i = M.findWithDefault [] i (csi_conflicts csi) conflict_pairs = map (\i -> (i,find_conflicts i)) urgency_order asched = ASchedule [ASchedEsposito conflict_pairs] (reverse earliness_order) di = headOrErr "simExpandSched" (M.elems (csi_domain_info_map csi)) early_rules = di_clock_crossing_rules di before_early_rules = concat [ filter (\x -> (getSchedNodeId x) /= r) ns | (n,ns) <- sched_graph , let r = getSchedNodeId n , r `elem` early_rules ] in if (null before_early_rules) then SimSchedule { ss_clock = aclk , ss_posedge = True , ss_schedule = asched , ss_disjoint_rules_db = csi_drdb csi , ss_sched_graph = sched_graph , ss_sched_order = sched_order , ss_domain_info_map = csi_domain_info_map csi , ss_early_rules = early_rules } else internalError $ "unexpected nodes before clock-crossing rule: " ++ (show before_early_rules) pos_scheds = map mkPosSched combscheds_by_domain let showSchedOrder ss = traceM ("sched order: " ++ ppReadable (ss_sched_order ss)) when trace_mergesched $ mapM_ showSchedOrder pos_scheds -- ---------- -- return all the schedules let simscheds = pos_scheds return simscheds -- --------------- flattenCombSchedGraph :: CombSchedInfo -> ([(SchedNode, [SchedNode])], [SchedNode]) flattenCombSchedGraph csi = let sched_map = csi_sched_map csi rrmap = csi_rule_rel_map csi sched_graph = M.toList sched_map -- Sort the SchedNodes initially so we respect the stable ordering -- from the Ord instance, but still have fast comparisons for tsort. sorted_nodes = sort $ M.keys sched_map nodesToInt :: M.Map FastSchedNode Int nodesToInt = M.fromList $ zip (map FSN sorted_nodes) [0..] getInt n = M.findWithDefault (internalError "flattenCombSchedGraph.getInt") (FSN n) nodesToInt intToNodes :: M.Map Int SchedNode intToNodes = M.fromList $ zip [0..] sorted_nodes getNode i = M.findWithDefault (internalError "flattenCombSchedGraph.getNode") i intToNodes sched_graph_int = M.toList $ M.mapKeys getInt $ M.map (map getInt) sched_map -- whether the ordering of two nodes is only because of -- foreign func uses (and therefore the edge can be dropped) isFFuncEdge (Exec r1, Exec r2) = case (M.lookup (r1,r2) rrmap) of Just (RuleRelationInfo Nothing Nothing Nothing Nothing Nothing (Just CFFuncArbitraryChoice)) -> True _ -> False isFFuncEdge _ = False findFFuncEdges scc = let -- XXX we could go through the trouble of finding -- XXX just the edges on the cycles, and even of finding -- XXX some minimal set of edges to break the cycles, -- XXX but it didn't seem worth the effort. pairs = allPairs $ map getNode scc in filter isFFuncEdge pairs in case (tsort sched_graph_int) of Right order -> (sched_graph, map getNode order) Left sccs -> let edges_to_remove = concatMap findFFuncEdges sccs new_sched_map = let updateFn n priors = case (delete n priors) of [] -> Nothing rest -> Just rest -- (n1, n2) means delete n1 from n2's priors foldFn (n1, n2) = M.update (updateFn n1) n2 in foldr foldFn sched_map edges_to_remove new_sched_graph = M.toList new_sched_map new_sched_graph_int = M.toList $ M.mapKeys getInt $ M.map (map getInt) $ new_sched_map in -- try once more, with the bias edges removed case (tsort new_sched_graph_int) of Right order -> (new_sched_graph, map getNode order) Left [] -> internalError "empty scc" Left (scc:_) -> let one_cycle = extractOneCycle_map new_sched_map (map getNode scc) in internalError ("cycle in combsched: " ++ ppReadable one_cycle) -- =============== -- Merging schedules -- This the intermediate data which is carried around while combining -- AScheduleInfos. After merging is done, this info is processed to -- create the final SimSchedule. data CombSchedInfo = CombSchedInfo { -- this is used to reconstruct the ASchedule csi_conflicts :: ConflictMap, csi_drdb :: DisjointRulesDB, -- from this we can get the sched_graph and -- (by flattening) the sched_order csi_sched_map :: SchedMap, csi_rule_rel_map :: RuleRelationMap, -- clock domain info (rules, clocked submods, resets) csi_domain_info_map :: DomainInfoMap } deriving (Eq, Show) -- Just the conflict info from the RuleRelationDB -- (the disjoint info cannot be accumulated across method calls) type RuleRelationMap = M.Map (AId, AId) RuleRelationInfo -- The schedule graphs will be converted from list to map for better access type SchedMap = M.Map SchedNode [SchedNode] -- The Esposito scheduler is a list of rules/methods paired with the -- more urgent rules/methods that block it. This pairing we will store -- as a map, for better update and access. type ConflictMap = M.Map AId [AId] -- ------ -- A map from module name to the result of merging all the schedules -- from submodules into this parent module. This is the map we will -- be building up from the leaves of the design, from an empty map. type CSIMap = M.Map String CombSchedInfo -- ---------- reverseSchedMap :: SchedMap -> SchedMap reverseSchedMap smap = M.mapKeys unFSN $ M.map (map unFSN) $ reverseMap smap' where smap' = M.mapKeys FSN $ M.map (map FSN) smap reverseConflictMap :: ConflictMap -> ConflictMap reverseConflictMap cmap = reverseMap cmap -- ---------- makeDomainMaps :: [AClockDomain] -> [ARule] -> [AVInst] -> [AIFace] -> (DomainIdMap, DomainInfoMap) makeDomainMaps cds rs insts iface = let -- convert a domain to its DomainId domainToDomainId cd = (emptyId, cd) -- empty info, for building up from emptyDomainInfo = DomainInfo { di_clocks = [], di_domains = [], di_rules = [], di_clock_crossing_rules = [], di_prims = [], di_prim_resets = [], di_output_clocks = [], di_clock_substs = [] } -- ---------- -- domain Id map -- make a map from clocks visible in this module to their DomainId domain_id_map = makeDomainIdMap [ (aclk, domainToDomainId cd) | (cd, aclks) <- cds, aclk <- aclks ] -- ---------- -- start the domain info map with just the domain info dinfoFromClks dom_id aclks = emptyDomainInfo { di_clocks = aclks, di_domains = [dom_id] } dmap_with_clks = M.fromList [ (dom_id, dinfoFromClks dom_id aclks) | (cd, aclks) <- cds , let dom_id = domainToDomainId cd ] -- ---------- -- accumulate rule info singleRule r False = emptyDomainInfo { di_rules = [r] } singleRule r True = emptyDomainInfo { di_rules = [r] , di_clock_crossing_rules = [r] } -- assumes no duplicates accumRule :: ARule -> DomainInfoMap -> DomainInfoMap accumRule r map_so_far = let rid = arule_id r cd = getWPropDomain rid (arule_wprops r) clock_crossing = RPclockCrossingRule `elem` (arule_pragmas r) new_dom = domainToDomainId cd new_rl = singleRule rid clock_crossing in M.insertWith joinDomainInfo new_dom new_rl map_so_far -- add the rules to the map dmap_with_clks_rules = foldr accumRule dmap_with_clks rs -- ---------- -- accumulate primitive info singlePrim p@(pid, (arg_id, _)) True = emptyDomainInfo { di_prims = [p] , di_prim_resets = [(pid, arg_id)] } singlePrim p False = emptyDomainInfo { di_prims = [p] } -- primtives prim_names = map sb_name primBlocks accumPrim :: AVInst -> DomainInfoMap -> DomainInfoMap accumPrim p map_so_far | (getVNameString (vName (avi_vmi p)) `notElem` prim_names) = map_so_far accumPrim p map_so_far = let pid = avi_vname p -- all the clock arguments to the module clk_infos = [ (aclk, arg_id) | (ClockArg arg_id, clk_expr) <- getInstArgs p, let aclk = getClkFromAExpr clk_expr, -- don't count the ones with no clock not (isNoClock aclk) ] -- (input) clocks associated with input resets rst_clks = nub $ [ c | (r, (mp, (Just c))) <- input_resets (vRst (avi_vmi p)), -- ignore resets which don't have a port isJust mp ] -- convert it to the DomainInfo form infoToEntry :: (AClock, AId) -> (DomainId, DomainInfo) infoToEntry (aclk, arg_id) = let has_reset = arg_id `elem` rst_clks in (findDomainId domain_id_map aclk, singlePrim (pid, (arg_id, aclk)) has_reset) new_entries = map infoToEntry clk_infos new_map = M.fromListWith joinDomainInfo new_entries in M.unionWith joinDomainInfo new_map map_so_far dmap_with_clks_rules_prims = foldr accumPrim dmap_with_clks_rules insts -- ---------- -- add the output clocks singleOutClk c = emptyDomainInfo { di_output_clocks = [c] } outclks = [ (findDomainId domain_id_map aclk, singleOutClk (clk_id, aclk)) | (AIClock clk_id aclk _) <- iface, -- noClock has no domain not (isNoClock aclk) ] dmap_with_clks_rules_prims_outclks = let outclk_map = M.fromListWith joinDomainInfo outclks in M.unionWith joinDomainInfo outclk_map dmap_with_clks_rules_prims -- ---------- -- return the result in (domain_id_map, dmap_with_clks_rules_prims_outclks) -- This assumes no duplicates (uses ++ instead of `union`) joinDomainInfo :: DomainInfo -> DomainInfo -> DomainInfo joinDomainInfo di1 di2 = DomainInfo { di_clocks = (di_clocks di1) ++ (di_clocks di2), di_domains = (di_domains di1) ++ (di_domains di2), di_rules = (di_rules di1) ++ (di_rules di2), di_clock_crossing_rules = (di_clock_crossing_rules di1) ++ (di_clock_crossing_rules di2), di_prims = (di_prims di1) ++ (di_prims di2), di_prim_resets = (di_prim_resets di1) ++ (di_prim_resets di2), di_output_clocks = (di_output_clocks di1) ++ (di_output_clocks di2), di_clock_substs = (di_clock_substs di1) ++ (di_clock_substs di2) } -- ---------- substInputClockInDomainInfo :: AClock -> AClock -> DomainInfo -> DomainInfo substInputClockInDomainInfo child_clk parent_clk child_dom_info = let clocks = di_clocks child_dom_info domains = di_domains child_dom_info rules = di_rules child_dom_info cross_rules = di_clock_crossing_rules child_dom_info prims = di_prims child_dom_info prim_resets = di_prim_resets child_dom_info output_clks = di_output_clocks child_dom_info clk_substs = di_clock_substs child_dom_info -- ---------- -- clocks are unchanged clocks' = clocks domains' = domains -- ---------- -- the set of rules remains the same rules' = rules cross_rules' = cross_rules -- ---------- -- Replace the child clock with the parent clock in primitives -- (this will include any gate from the parent) substPrim (inst, (arg_id, clk)) | clk == child_clk = (inst, (arg_id, parent_clk)) substPrim p = p prims' = map substPrim prims -- reset ids are unchanged prim_resets' = prim_resets -- ---------- -- Output clocks which come from input clocks should be substituted substOutputClk (clk_id, aclk) | aclk == child_clk = (clk_id, parent_clk) substOutputClk c = c output_clks' = map substOutputClk output_clks -- ---------- -- Substitute in the clock substitutions and add this substitution substClockSubst (orig_clk, new_clk) | new_clk == child_clk = (orig_clk, parent_clk) substClockSubst s = s clk_substs' = [(child_clk, parent_clk)] ++ (map substClockSubst clk_substs) -- ---------- in DomainInfo { di_clocks = clocks', di_domains = domains', di_rules = rules', di_clock_crossing_rules = cross_rules', di_prims = prims', di_prim_resets = prim_resets', di_output_clocks = output_clks', di_clock_substs = clk_substs' } -- ---------- substOutputClockInDomainInfo :: AClock -> AClock -> DomainInfo -> DomainInfo substOutputClockInDomainInfo parent_clk child_clk parent_dom_info = let clocks = di_clocks parent_dom_info domains = di_domains parent_dom_info rules = di_rules parent_dom_info cross_rules = di_clock_crossing_rules parent_dom_info prims = di_prims parent_dom_info prim_resets = di_prim_resets parent_dom_info output_clks = di_output_clocks parent_dom_info clk_substs = di_clock_substs parent_dom_info -- ---------- -- clocks are unchanged -- (the child clock will be added when we join the domain infos) clocks' = clocks domains' = domains -- ---------- -- the set of rules remains the same rules' = rules cross_rules' = cross_rules -- ---------- -- Replace the parent clock with the child clock in primitives substPrim (inst, (arg_id, clk)) | clk == parent_clk = (inst, (arg_id, child_clk)) substPrim p = p prims' = map substPrim prims -- reset ids are unchanged prim_resets' = prim_resets -- ---------- -- Output clocks substOutputClk (clk_id, aclk) | aclk == parent_clk = (clk_id, child_clk) substOutputClk c = c output_clks' = map substOutputClk output_clks -- ---------- -- Substitute in the clock substitutions and add this substitution substClockSubst (orig_clk, new_clk) | new_clk == parent_clk = (orig_clk, child_clk) substClockSubst s = s clk_substs' = [(parent_clk, child_clk)] ++ (map substClockSubst clk_substs) -- ---------- in DomainInfo { di_clocks = clocks', di_domains = domains', di_rules = rules', di_clock_crossing_rules = cross_rules', di_prims = prims', di_prim_resets = prim_resets', di_output_clocks = output_clks', di_clock_substs = clk_substs' } -- ---------- mergeSchedules :: [(String, ABinModInfo)] -> HierMap -> InstModMap -> String -> IO [(AClock, CombSchedInfo)] mergeSchedules abis hiermap instmap topmod = do -- ---------- -- trace let showSched abi = traceM ("sched (" ++ ppReadable (apkg_name (abmi_apkg abi)) ++ "): " ++ ppReadable (asi_sched_graph (abmi_aschedinfo abi))) when trace_mergesched $ mapM_ showSched (map snd abis) -- ---------- let pu_map = mkParentUseModMap abis smap = combineSchedInfos abis hiermap instmap pu_map topmod M.empty combschedinfo = case (M.lookup topmod smap) of Just x -> x Nothing -> internalError "combschedinfo" -- ---------- -- trace of the result when trace_mergesched $ do traceM ("comb sched_map = " ++ ppReadable (csi_sched_map combschedinfo)) traceM ("comb conflicts = " ++ ppReadable (csi_conflicts combschedinfo)) -- ---------- -- return the result -- XXX combineSchedInfos could have been splitting the CSIs by domain -- XXX as it was building up from the leaves. Here, we have built one -- XXX graph and kept rule domain info alongside, so that we can split -- XXX the graph at the end. -- since the domain info hasn't been built with methods, we'll need to -- pass them in, to add them. (we didn't build with them, because for -- each submodule, we throw the method info away, so it's wasted work) let res = let topabi = getABI topmod abis topifc = apkg_interface (abmi_apkg topabi) in splitCSIByClock topifc combschedinfo when trace_bs_mcd $ do let getSchedIds es = nub $ concat $ [ [getSchedNodeId n1] ++ map getSchedNodeId n2s | (n1, n2s) <- es ] domain_tuples = [ (cd, rs) | (cd, csi) <- res, let rs = getSchedIds (M.toList (csi_sched_map csi)) ] traceM ("merged domains = " ++ ppReadable domain_tuples) return res -- ---- splitCSIByClock :: [AIFace] -> CombSchedInfo -> [(AClock, CombSchedInfo)] splitCSIByClock topifc csi = let confls = csi_conflicts csi -- ConflictMap drdb = csi_drdb csi -- DisjointRulesDB smap = csi_sched_map csi -- SchedMap dmap = csi_domain_info_map csi -- DomainInfoMap rrmap = csi_rule_rel_map csi -- RuleRelationMap -- make a map from domain to the top-level methods in that domain ifc_dmap = let accumMeth (AIClock {}) map_so_far = map_so_far accumMeth (AIReset {}) map_so_far = map_so_far accumMeth m map_so_far = let mid = aif_name m cd = getWPropDomain mid (aif_props m) in M.insertWith (++) cd [mid] map_so_far in foldr accumMeth M.empty topifc getDomainMeths cd = case (M.lookup (snd cd) ifc_dmap) of Nothing -> [] Just ms -> ms -- from all the clocks in a domain, choose the best countChars :: Char -> String -> Int countChars _ [] = 0 countChars t (c:cs) = (if (c == t) then 1 else 0) + (countChars t cs) numLevels :: Char -> AExpr -> Int numLevels d e@(ASPort _ i) = 1 + ((countChars d) . getIdString) i numLevels d e@(AMGate _ i1 i2) = 1 + ((countChars d) . getIdString) i1 + ((countChars d) . getIdString) i2 numLevels _ _ = 0 cmp_clk :: AClock -> AClock -> Ordering cmp_clk (AClock o1 g1) (AClock o2 g2) | (numLevels '.' g1) < (numLevels '.' g2) = LT | (numLevels '.' g1) > (numLevels '.' g2) = GT | (numLevels '.' o1) < (numLevels '.' o2) = LT | (numLevels '.' o1) > (numLevels '.' o2) = GT | otherwise = (numLevels '$' o1) `compare` (numLevels '$' o2) findBestClock :: [AClock] -> AClock findBestClock aclks = let sorted_clks = sortBy cmp_clk aclks in headOrErr "splitCSIByClock: no clocks found" sorted_clks domains :: [(DomainId, DomainInfo)] --domains = filter clocks_something $ M.toList dmap domains = M.toList dmap -- for each domain, extract the CSI for that domain extractCSI (cd, dinfo) = let aclk = findBestClock (di_clocks dinfo) cd_rules = di_rules dinfo cd_methods = getDomainMeths cd cd_rules_and_meths = cd_rules ++ cd_methods csi = CombSchedInfo { csi_conflicts = extractConflicts cd_rules_and_meths, csi_drdb = extractDRDB cd_rules_and_meths, csi_sched_map = extractSchedMap cd_rules_and_meths, csi_domain_info_map = M.singleton cd dinfo, csi_rule_rel_map = extractRuleRelMap cd_rules_and_meths } in (aclk, csi) -- XXX leave them as the full info for now extractConflicts _ = confls extractDRDB _ = drdb extractRuleRelMap _ = rrmap extractSchedMap :: [ARuleId] -> SchedMap extractSchedMap cd_rs = let cd_rs_set = S.fromList cd_rs -- func to see if a SchedNode is in the domain inDomain :: SchedNode -> Bool inDomain sn = (getSchedNodeId sn) `S.member` cd_rs_set -- flatten to a list es = M.toList smap -- remove the nodes which aren't in the list es' = filter (inDomain . fst) es -- if there are any outgoing edges not in the cd_rs, error checkKeys (r,vs) = let err_rs = filter (not . inDomain) vs in if (null err_rs) then (r,vs) else internalError ("schedMap not disjoint: " ++ ppReadable (r, err_rs)) in M.fromList (map checkKeys es') in map extractCSI domains -- ---------- {- -- Example sched_graph from mkGCD -- Note that the Sched nodes will eventually become RDY value methods, -- but at this point those separate "methods" don't exist. sched (mkGCD): [(Sched start, []), (Exec start, [Sched start, Exec result]), (Sched result, []), (Exec result, [Sched result]), (Sched RL_sub, [Sched start]), (Exec RL_sub, [Sched RL_sub]), (Sched RL_flip, [Sched start]), (Exec RL_flip, [Sched RL_flip])] -} -- Recursive function which merges the AScheduleInfos from -- all the ABinModInfos in the design, according to the hierarchy, -- to produce a CSIMap for all the module types in the design -- (from which we'll just take the CSI associated with the top -- module type, but the others are in the map for merging along -- the way). combineSchedInfos :: [(String, ABinModInfo)] -> HierMap -> InstModMap -> ParentUseModMap -> String -> CSIMap -> CSIMap combineSchedInfos abis hiermap instmap pu_map curmod smap = let -- the map for this module use_map = findParentUseMap pu_map curmod curmod_abi = getABI curmod abis -- this returns the Id map separately -- (no need for it to be stored an accumulated in the CSI; -- it's like the parent use map) (dom_id_map, curmod_csi) = makeCSIForModule curmod_abi -- map from inst name as String to its AVInst avi_map = let curmod_avis = apkg_state_instances (abmi_apkg curmod_abi) in M.fromList $ map (\i -> (getIdString (avi_vname i), i)) curmod_avis -- function to lookup an AVInst getAVInst s = case (M.lookup s avi_map) of Just avi -> avi Nothing -> internalError ("SimExpand.getAVInst: " ++ "cannot find " ++ s) -- don't follow prim modules prim_names = map sb_name primBlocks in case (M.lookup curmod smap) of Just cschedinfo -> smap Nothing -> case (M.lookup curmod hiermap) of Nothing -> internalError ("combineSchedInfos: " ++ curmod) -- the noinline instances don't have schedule info, -- so it's okay to ignore them Just ([],_) -> M.insert curmod curmod_csi smap Just (insts, _) -> let foldfunc :: (String, String) -> (ABinModInfo, CombSchedInfo, CSIMap) -> (ABinModInfo, CombSchedInfo, CSIMap) foldfunc (inst, mod) (p_abi, p_csi, smap) = let s_abi = getABI mod abis smap' = combineSchedInfos abis hiermap instmap pu_map mod smap s_csi = case (M.lookup mod smap') of Just x -> x Nothing -> internalError ("s_csi: " ++ mod) in if (mod `elem` prim_names) then let csi' = combinePrimClocks dom_id_map p_csi inst (getAVInst inst) mod in (p_abi, csi', smap) else let csi' = combineCombSchedInfo use_map dom_id_map p_abi p_csi inst (getAVInst inst) s_abi s_csi in (p_abi, csi', smap') (_, combined_csi, new_smap) = foldr foldfunc (curmod_abi, curmod_csi, smap) insts in M.insert curmod combined_csi new_smap -- Given a module ABI, construct the initial CSI for the module, -- from its schedule and package. makeCSIForModule :: ABinModInfo -> (DomainIdMap, CombSchedInfo) makeCSIForModule curmod_abi = let curmod_aschedinfo = abmi_aschedinfo curmod_abi curmod_graph = asi_sched_graph curmod_aschedinfo curmod_sched_map = M.fromList curmod_graph curmod_conflicts = case (asi_schedule curmod_aschedinfo) of (ASchedule [ASchedEsposito cs] _) -> M.fromList cs x -> internalError ("curmod_conflicts: " ++ ppReadable x) curmod_drdb = exclRulesDBToDisjRulesDB $ asi_exclusive_rules_db curmod_aschedinfo (RuleRelationDB _ curmod_rule_rel_map) = asi_rule_relation_db curmod_aschedinfo curmod_apkg = abmi_apkg curmod_abi curmod_domains = apkg_clock_domains curmod_apkg curmod_rules = apkg_rules curmod_apkg curmod_insts = apkg_state_instances curmod_apkg curmod_iface = apkg_interface curmod_apkg (curmod_dom_id_map, curmod_dmap) = makeDomainMaps curmod_domains curmod_rules curmod_insts curmod_iface csi = CombSchedInfo { csi_conflicts = curmod_conflicts, csi_drdb = curmod_drdb, csi_sched_map = curmod_sched_map, csi_rule_rel_map = curmod_rule_rel_map, csi_domain_info_map = curmod_dmap } in -- return the domain Id map separately -- we *could* store the Id map in the CSI, -- but right now we don't ever need the info from the children -- (it's like the parent use info) -- so it's not really something we accumulate and need at the end. -- conceivable, though, we *could* accumulate it, by qualifying -- the clocks ... in case someday we want the info? (curmod_dom_id_map, csi) -- ---------- -- Function to merge one submodule's CombSchedInfo into its parent's info. -- This will be folded across all the submodule instances in a parent mod. combineCombSchedInfo :: ParentUseMap -> DomainIdMap -> ABinModInfo -> CombSchedInfo -> String -> AVInst -> ABinModInfo -> CombSchedInfo -> CombSchedInfo combineCombSchedInfo use_map domain_id_map parent_abi parent_csi inst avinst child_abi child_csi = -- for each node of parent that references a method of the submod, -- add an edge from the parent node to all places pointed to from -- the Sched node for calls to RDY methods and Exec node for calls -- the actual non-RDY methods. let parent_nodes = M.keys (csi_sched_map parent_csi) -- mapping from Rdy Id back to its method Id -- XXX store this in the info for a module? rdy_map = mkRdyMap child_abi -- for each node in the parent schedule, find its uses in the child makeParentNodeUses node = (node, findUses use_map rdy_map inst node) parent_uses = map makeParentNodeUses parent_nodes -- once we join the child methods to the parent rules which use -- them, we need to remove all the methods from the child's -- schedule graph and conflicts (even the methods not used by -- any parent rules), so we need to know which are the method Ids child_apkg = abmi_apkg child_abi child_meth_set = S.fromList $ map aIfaceName (apkg_interface child_apkg) -- combine each part of the CSI comb_sched_map = combineSchedMap inst parent_uses child_meth_set (csi_sched_map parent_csi) (csi_sched_map child_csi) comb_conflicts = combineSchedConflicts inst parent_uses child_meth_set (csi_conflicts parent_csi) (csi_conflicts child_csi) comb_drdb = combineSchedDRDB inst parent_uses child_meth_set (csi_drdb parent_csi) (csi_drdb child_csi) comb_rule_rel_db = combineSchedRuleRelDB inst parent_uses child_meth_set (csi_rule_rel_map parent_csi) (csi_rule_rel_map child_csi) comb_domain_info_map = combineDomainInfoMap inst avinst domain_id_map (csi_domain_info_map parent_csi) (csi_domain_info_map child_csi) in CombSchedInfo { csi_conflicts = comb_conflicts, csi_drdb = comb_drdb, csi_sched_map = comb_sched_map, csi_rule_rel_map = comb_rule_rel_db, csi_domain_info_map = comb_domain_info_map } -- Function to merge one submodule's CombSchedInfo into its parent's info. -- This will be folded across all the submodule instances in a parent mod. combinePrimClocks :: DomainIdMap -> CombSchedInfo -> String -> AVInst -> String -> CombSchedInfo combinePrimClocks domain_id_map parent_csi inst avinst mod = let -- combine the domain info for the primitive comb_domain_info_map = case (getPrimDomainInfo avinst mod) of (Just (new_avinst, prim_domains, prim_output_clks)) -> combineDomainInfoMap inst new_avinst domain_id_map (csi_domain_info_map parent_csi) (snd (makeDomainMaps prim_domains [] -- no rules [] -- no subinstances prim_output_clks)) Nothing -> -- nothing to add, so pass parent through csi_domain_info_map parent_csi in parent_csi { csi_domain_info_map = comb_domain_info_map } -- ---------- -- Functions to merge the individual fields of the CombSchedInfo for -- a submodule into its parent module's CombSchedInfo. combineDomainInfoMap :: String -> AVInst -> DomainIdMap -> DomainInfoMap -> DomainInfoMap -> DomainInfoMap combineDomainInfoMap inst avinst parent_id_map parent_info_map child_info_map = let -- - remove the nodes for methods -- (calling rules in parent module will have the appropriate domain) -- - qualify rule names in the child module -- - substitute the child's domain names for their names from the -- parent module (for clocks coming from the parent) -- - XXX substitute parent's domain names for names from the child -- XXX module (for clocks coming from the child) child_edges = M.toList child_info_map -- there are no methods in the domain info (we only added rules) child_rule_edges = child_edges -- qualify the domain info qual_child_edges = let qualifyEdge (d, di) = (qualifyChildDomainId inst d, qualifyChildDomainInfo inst di) in map qualifyEdge child_rule_edges -- Make a map from the input clocks of the child module -- to the domain it is connected to in the parent module -- (and the gate of the particular clock in that domain). -- The value is Nothing if the input is noClock, and the -- child domain should therefore be removed. input_clock_substs :: [(AClock, Maybe (DomainId, AClock))] input_clock_substs = let vmi = avi_vmi avinst mkInputAClock osc mgate = let osc_expr = ASPort aTBool (vName_to_id osc) gate_expr = case (mgate) of Nothing -> aTrue Just gate -> ASPort aTBool (vName_to_id gate) in AClock osc_expr gate_expr -- substitute the input argument with substs so far substArgClk dom_id aclk = let dinfo = findDomainInfo parent_info_map dom_id in applyClockSubst (di_clock_substs dinfo) aclk in [ (qual_child_aclk, maybe_domain) | (ClockArg child_clk_id, clk_expr) <- getInstArgs avinst, -- this filters out clocks which aren't connected (osc, mgate) <- maybeToList $ lookupInputClockWires child_clk_id vmi, let qual_child_aclk = qualifyChildAClock inst $ mkInputAClock osc mgate, let aclk = getClkFromAExpr clk_expr, let maybe_domain = if (isNoClock aclk) then Nothing else let dom_id = findDomainId parent_id_map aclk aclk' = substArgClk dom_id aclk in Just (dom_id, aclk') ] -- pairs domains in the parent module with child output clocks output_clock_substs :: [(DomainId, (AId, AClock))] output_clock_substs = let child_id = avi_vname avinst out_clocks = getOutputClockWires avinst mkAClock clk_id osc_wire Nothing = AClock (ASPort (ATBit 1) osc_wire) (aSBool True) mkAClock clk_id osc_wire (Just gate_wire) = AClock (ASPort (ATBit 1) osc_wire) (AMGate (ATBit 1) child_id clk_id) pairWithParentDomain (clk_id, clk_info, maybe_gate_info) = let aclk = mkAClock clk_id clk_info maybe_gate_info in case (findMaybeDomainId parent_id_map aclk) of Nothing -> Nothing Just dom_id -> Just (dom_id, (clk_id, aclk)) in mapMaybe pairWithParentDomain out_clocks -- pair a child output clock name with the parent domain and -- the aclk as seen by the parent -- if an output clock couldn't be found in the parent domain, -- then it will not be in this list (but that's OK, because it -- either means that the output is unused or that it is defined -- from an input clock which is noClock) parent_outclk_map :: [(AId, (DomainId, AClock))] parent_outclk_map = [ (clk_id, (dom_id, aclk)) | (dom_id, (clk_id, aclk)) <- output_clock_substs ] -- ---------- -- Now we do two things: -- For each child domain, -- * if the domain has an input clock, then change the domain Id -- to the parent Id, and subst the parent clock/gate in the info -- * else if the domain has an output clock, then change the -- domain Id to the parent Id (if it's both an input and output, -- then the first case will handle it) -- * otherwise, do nothing -- For each parent domain, -- * if the domain includes an output clock, then substitute any -- references to the clock/gate in the info with the clock used -- in the child to define the output clock -- (do this for each output clock in the domain) -- (if the expression is noClock ... subst appropriately?) -- * output clocks which are input clocks need to be properly -- handled in the parent domain: the substitution in the -- parent should use the value connected to the input and -- if the input is noClock, then ... such uses should be -- removed? or the domain won't exist anyway in the parent? -- * otherwise, do nothing -- Then the new child edges are added to the updated parent map -- (any child edges which have been renamed to have parent domain -- names will have their info merged with the existing parent info). -- ---------- -- find if a child AClock is an input clock -- and return the parent domain (Nothing if the argument was noClock) findInputClockInfo :: AClock -> Maybe (AClock, Maybe (DomainId, AClock)) findInputClockInfo aclk = lookup aclk input_clock_substs >>= \v -> Just (aclk, v) -- find if a child AClock is an output clock -- and return the parent domain findOutputClockInfo :: AId -> Maybe (DomainId, AClock) findOutputClockInfo clk_id = lookup clk_id parent_outclk_map -- function to see if any clocks in the given child domain are -- input clocks and, if so, what parent domain they belong to findInputParentDomain :: DomainInfo -> [(AClock, Maybe (DomainId, AClock))] findInputParentDomain child_dom_info = let child_clks = di_clocks child_dom_info in mapMaybe findInputClockInfo child_clks -- function to see if any clocks in the given child domain are -- output clocks and, if so, what parent domain they belong to findOutputParentDomain :: DomainInfo -> Maybe DomainId findOutputParentDomain child_dom_info = let child_outclks = map fst $ di_output_clocks child_dom_info parent_domains :: [DomainId] parent_domains = nub $ map fst $ mapMaybe findOutputClockInfo child_outclks in case (parent_domains) of -- no output clock in this domain [] -> Nothing -- one output domain [d] -> Just d -- multiple output domains should not be possible? ds -> internalError ("combineDomainInfoMap: " ++ "output clocks in same domain in the child " ++ "but different domains in the parent") -- substitute for clocks coming from the parent -- (domains which are connected to noClock are removed) subst_qual_child_edges = let -- for child domains which contains clocks coming from the -- parent, replace the child domain id with the parent's -- domain id (so that this DomainInfo is added to the -- existing entry for that domain) substDomain :: (DomainId, DomainInfo) -> Maybe (DomainId, DomainInfo) substDomain edge@(child_dom_id, child_dom_info) = case (findInputParentDomain child_dom_info) of [] -> case (findOutputParentDomain child_dom_info) of Nothing -> -- no change Just edge Just parent_dom_id -> -- same info, but add to the parent domain Just (parent_dom_id, child_dom_info) ds | any (\(_,md) -> isNothing md) ds -> -- remove this clock Nothing ds -> -- substitute each (child,parent) clock pair -- to create the new domain info let (_, Just (parent_dom_id,_)) = head ds ps = [ (c,p) | (c, Just(_,p)) <- ds ] sub dom_info (child_clk,parent_clk) = substInputClockInDomainInfo child_clk parent_clk dom_info new_dom_info = foldl sub child_dom_info ps in Just (parent_dom_id, new_dom_info) in catMaybes $ map substDomain qual_child_edges -- pair a child output clock name with the aclk as seen by the child -- (uses the substituted child edges, to account for input clocks -- which are used by output clocks; if the input clock was noClock, -- then the clk_id won't be found in this map, so assume noClock -- if not found) child_outclk_map :: [(AId, AClock)] child_outclk_map = concatMap (di_output_clocks . snd) subst_qual_child_edges -- update the parent map, with any output clocks subst_parent_info_map = let -- returns Nothing if the info is not to be changed -- and otherwise returns Just the updated info substDomain :: (DomainId, DomainInfo) -> Maybe (DomainId, DomainInfo) substDomain edge@(parent_dom_id, parent_dom_info) = case (lookup parent_dom_id output_clock_substs) of Nothing -> Nothing Just (clk_id, aclk_in_parent) -> case (lookup clk_id child_outclk_map) of Just aclk_in_child -> Just $ (parent_dom_id, substOutputClockInDomainInfo aclk_in_parent aclk_in_child parent_dom_info) Nothing -> -- the domain is empty, so substitute noClock Just $ (parent_dom_id, substOutputClockInDomainInfo aclk_in_parent noClock parent_dom_info) -- get the changed edges changed_edges = catMaybes $ map substDomain (M.toList parent_info_map) in -- update the parent map -- (taking advantage of the fact that "add" overwrites) (M.fromList changed_edges) `M.union` parent_info_map -- ---------- -- remove output clocks from the child edges before joining -- to the parent, since they are not outputs of the parent subst_qual_child_edges_no_outclks = let rmOutClks dinfo = dinfo { di_output_clocks = [] } in mapSnd rmOutClks subst_qual_child_edges subst_child_info_map = M.fromListWith joinDomainInfo subst_qual_child_edges_no_outclks combinedInfo = M.unionWith joinDomainInfo subst_child_info_map subst_parent_info_map in combinedInfo combineSchedDRDB :: String -> [(SchedNode,[SchedNode])] -> S.Set AId -> DisjointRulesDB -> DisjointRulesDB -> DisjointRulesDB combineSchedDRDB inst parent_use_map child_meth_set parent_map child_map = let -- start by adding all nodes in the child map to the parent map, -- which requires qualifying all the nodes of the child -- (but don't include methods) isMethId i = i `S.member` child_meth_set child_edges = mapSnd S.toList (M.toList child_map) child_rule_edges = let -- first remove edges from method Ids edges' = filter (not . isMethId . fst) child_edges in -- then remove edges to method Ids map (\ (n,ns) -> (n, filter (not . isMethId) ns)) edges' -- qualify the remaining edges qual_child_edges = mapSnd (S.fromList) $ qualifyChildDRDBGraph inst child_rule_edges start_comb_map = (M.fromList qual_child_edges) `M.union` parent_map -- the disjoint map should be the same in both directions, -- so no need to reverse it! -- but combine sched and exec nodes of parent rules and -- remove uses of sched node (RDY signals) and flatten to just AId flat_use_map = let convEdge (snode, ns) = (getSchedNodeId snode, map getSchedNodeId (filter (not . isSchedNode) ns)) flat_edges = map convEdge parent_use_map in foldr (uncurry (M.insertWith union)) M.empty flat_edges -- but we do need to reverse the use map rev_flat_use_map = reverseMap flat_use_map findDisjointChildRules :: AId -> [AId] findDisjointChildRules methId = case (M.lookup methId child_map) of Nothing -> [] Just nset -> filter (not . isMethId) (S.toList nset) findDisjointParentRules :: AId -> [AId] findDisjointParentRules methId = case (M.lookup methId child_map) of Nothing -> [] Just nset -> let meths = filter isMethId (S.toList nset) lookupMeth m = case (M.lookup m rev_flat_use_map) of Nothing -> [] Just parent_ns -> parent_ns in foldr union [] (map lookupMeth meths) handleParentNode :: (AId, [AId]) -> DisjointRulesDB -> DisjointRulesDB handleParentNode (parentId, uses) dmap = let handleUse :: AId -> DisjointRulesDB -> DisjointRulesDB handleUse useId dmap = let child_disjoints = map (qualifyChildId inst) (findDisjointChildRules useId) parent_disjoints = findDisjointParentRules useId disjoints = child_disjoints ++ parent_disjoints edges = [(parentId, S.fromList disjoints)] ++ [(d, S.singleton parentId) | d <- disjoints] in M.unionWith S.union (M.fromListWith S.union edges) dmap in foldr handleUse dmap uses in foldr handleParentNode start_comb_map (M.toList flat_use_map) combineSchedRuleRelDB :: String -> [(SchedNode,[SchedNode])] -> S.Set AId -> RuleRelationMap -> RuleRelationMap -> RuleRelationMap combineSchedRuleRelDB inst parent_use_map child_meth_set parent_map child_map = let isMethId i = i `S.member` child_meth_set -- combine sched and exec nodes of parent rules and -- remove uses of sched node (RDY signals) and flatten to just AId flat_use_map = let convEdge (snode, ns) = (getSchedNodeId snode, map getSchedNodeId (filter (not . isSchedNode) ns)) flat_edges = map convEdge parent_use_map in foldr (uncurry (M.insertWith union)) M.empty flat_edges -- reverse to make it a map from child Id to parent uses rev_flat_use_map = reverseMap flat_use_map -- make a new set of edges (with possible duplicates) by qualifying -- children IDs and replacing methods with parent rules that call them expandMeth i = if (isMethId i) then case (M.lookup i rev_flat_use_map) of Nothing -> [] Just parent_ns -> parent_ns else [qualifyChildId inst i] makePairs i1s i2s = [ (i1, i2) | i1 <- i1s, i2 <- i2s ] new_map_pairs = let expandFn ((i1, i2), rri) = let qual_rri = qualifyChildRuleRelationInfo inst rri ks = makePairs (expandMeth i1) (expandMeth i2) in [ (k, qual_rri) | k <- ks ] in concatMap expandFn (M.toList child_map) in map_insertManyWith unionRuleRelationInfo new_map_pairs parent_map combineSchedConflicts :: String -> [(SchedNode,[SchedNode])] -> S.Set AId -> ConflictMap -> ConflictMap -> ConflictMap combineSchedConflicts inst parent_uses child_meth_set parent_cs child_cs = let -- start by adding all conflicts in the child list to the parent list, -- which requires qualifying all the conflicts of the child -- (but don't add conflicts from or to methods!) isMethId i = i `S.member` child_meth_set child_edges = M.toList child_cs child_rule_edges = let -- first remove edges from method nodes edges' = filter (not . isMethId . fst) child_edges in -- then remove any ingoing nodes map (\ (n,ns) -> (n, filter (not . isMethId) ns)) edges' -- qualify the remaining edges qual_child_edges = qualifyChildConflictGraph inst child_rule_edges -- add them to the parent start_comb_cs = M.union (M.fromList qual_child_edges) parent_cs -- for finding incoming edges, reverse the child list -- XXX are we constructing this more than once, if we instantiate -- XXX the same module multiple times? rev_child_cmap = reverseConflictMap child_cs -- XXX until rules can block methods, this is empty findBlockers :: AId -> [AId] findBlockers methId = [] findBlockees :: AId -> [AId] findBlockees methId = case (M.lookup methId rev_child_cmap) of Nothing -> [] -- value methods will not be found, so don't error --internalError ("findBlockees: " ++ ppReadable methId) Just ns -> ns -- don't reintroduce edges to methods -- XXX can't happen because method conflicts are -- XXX annotated and not in the conflicts list --filter (not . isMethId) ns -- for each use of a given node in the parent schedule, -- we do two things: -- * If there are any conflicts which block the used method -- (not possible until rules can be more urgent), we add those -- blockers to the parent rule's list. -- * If there are any rules which are blocked by the method, -- they now have to be blocked by all the parent rules which -- use the method. -- XXX does it matter if the parent node is a sched or exec node? -- XXX Can ignore uses in sched nodes, since they are only value -- XXX methods, and so any blocker would show up in the RDY -- XXX (that is, for now value methods don't have a CF/WF, and -- XXX don't appear in the conflicts in the schedule). handleParentNode :: (SchedNode, [SchedNode]) -> ConflictMap -> ConflictMap -- XXX ignore sched nodes as described above handleParentNode (Sched _, _) cmap = cmap handleParentNode (Exec parentId, uses) cmap = let handleUse :: SchedNode -> ConflictMap -> ConflictMap -- XXX ignore sched node as described above handleUse (Sched _) cmap = cmap handleUse (Exec useId) cmap = let outs = findBlockers useId q_outs = map (qualifyChildId inst) outs ins = findBlockees useId q_ins = map (qualifyChildId inst) ins edges = [(parentId, q_outs)] ++ [(q_in, [parentId]) | q_in <- q_ins] trace_dump = if (trace_mergesched) then trace("combine conflicts: (pnode,use) = " ++ ppReadable (parentId,useId)) $ trace(" ins: " ++ ppReadable ins) $ trace(" outs: " ++ ppReadable outs) else id in trace_dump $ M.unionWith (++) (M.fromListWith (++) edges) cmap in foldr handleUse cmap uses in foldr handleParentNode start_comb_cs parent_uses combineSchedMap :: String -> [(SchedNode,[SchedNode])] -> S.Set AId -> SchedMap -> SchedMap -> SchedMap combineSchedMap inst parent_uses child_meth_set parent_smap child_smap = let -- start by adding all nodes in the child to the parent, -- which requires qualifying all the nodes of the child -- (but don't add edges from or to methods!) isMethSN sn = (getSchedNodeId sn) `S.member` child_meth_set child_edges = M.toList child_smap child_rule_edges = let -- first remove edges from method nodes edges' = filter (not . isMethSN . fst) child_edges in -- then remove any ingoing nodes map (\ (n,ns) -> (n, filter (not . isMethSN) ns)) edges' -- qualify the remaining edges qual_child_edges = qualifyChildSchedGraph inst child_rule_edges start_comb_smap = M.union (M.fromList qual_child_edges) parent_smap -- for finding incoming edges, reverse the child map -- XXX are we constructing this more than once, if we instantiate -- XXX the same module multiple times? rev_child_smap = reverseSchedMap child_smap -- XXX maybe the best thing to do here is to first add all -- XXX edges from parent rules to methods they use. -- XXX *then* remove all methods, one at a time, by reconnecting -- XXX ingoing and outgoing nodes. -- XXX this allows for two rules to get an edge because two methods -- XXX had an edge, etc. -- find outgoing edges findOutEdges use_node = case (M.lookup use_node child_smap) of Nothing -> internalError ("findOutEdges") Just [] -> [] Just ns -> -- don't reintroduce edges to methods filter (not . isMethSN) ns -- find ingoing edges findInEdges use_node = case (M.lookup use_node rev_child_smap) of Nothing -> internalError ("findInEdges: " ++ ppReadable (use_node, M.toList rev_child_smap)) Just [] -> [] Just ns -> -- don't reintroduce edges to methods filter (not . isMethSN) ns -- for each use of a given node in the parent schedule, -- figure out whether to use Sched or Exec node -- and lookup the outgoing edges and add them to the parent schedule handleParentNode :: (SchedNode, [SchedNode]) -> SchedMap -> SchedMap handleParentNode (pnode, uses) sched_map = let handleUse :: SchedNode -> SchedMap -> SchedMap handleUse use_node sched_map = let outs = findOutEdges use_node q_outs = map (qualifyChildSchedNode inst) outs ins = findInEdges use_node q_ins = map (qualifyChildSchedNode inst) ins edges = [(pnode, q_outs)] ++ [(q_in, [pnode]) | q_in <- q_ins] trace_dump = if (trace_mergesched) then trace("pnode: " ++ ppReadable pnode) $ trace(" uses: " ++ ppReadable use_node) $ trace(" ins: " ++ ppReadable ins) $ trace(" outs: " ++ ppReadable outs) $ trace(" edges: " ++ ppReadable edges) else id in trace_dump $ M.unionWith (++) (M.fromListWith (++) edges) sched_map in foldr handleUse sched_map uses in foldr handleParentNode start_comb_smap parent_uses -- from the submodule whose edges should be merged with this SchedNode. -- (Note that we merge an Exec node of a parent rule with the Sched and -- Exec for the methods that the rule calls, not just the Exec. This is -- to account for the possibility that the method is called conditionally -- inside the rule, and so the rule body must execute to compute whether -- the method is scheduled -- so the rule must execute before anything -- which depends on the scheduling of the method, such as the scheduling -- of a less-urgent conflicting rule.) findUses :: ParentUseMap -> RdyMap -> String -> SchedNode -> [SchedNode] findUses use_map rdy_map inst snode = let rId = getSchedNodeId snode (pred_uses, body_uses) = findParentUses use_map (rId, inst) convertUseToNode mId = if (isRdyId mId) then [Sched (findRdyMeth rdy_map mId)] else [Sched mId, Exec mId] -- see comment uses = if (isSchedNode snode) then pred_uses else body_uses in concatMap convertUseToNode uses -- =============== -- Rather than hardcode the remove of fs_rdy to get the the Id for which -- a ready method is associated, we can create an authoritative map by -- looking at the def references of the individual methods. type RdyMap = M.Map AId AId mkRdyMap :: ABinModInfo -> RdyMap mkRdyMap abi = let apkg = abmi_apkg abi ifcs = apkg_interface apkg -- clocks and resets don't have Rdy methods mkPair (AIClock {}) = [] mkPair (AIReset {}) = [] mkPair ifc = let name = aIfaceName ifc pred_e = aIfacePred ifc in if (isRdyId name) then [] -- Rdy methods don't have Rdy methods else case (pred_e) of (ASDef _ pred_i) -> [(pred_i, name)] (ASInt {}) -> [] _ -> internalError ("mkRdyMap: pred is not a def or const: " ++ ppReadable (name, pred_e)) in M.fromList $ concatMap mkPair ifcs -- This takes a Rdy Id and returns the Id of the method for which it -- is the Rdy. findRdyMeth :: RdyMap -> AId -> AId findRdyMeth rdy_map rdyId = case M.lookup rdyId rdy_map of Just mId -> mId Nothing -> internalError ("SimExpand.findRdyMeth: cannot find " ++ ppReadable rdyId ++ ppReadable (M.toList rdy_map)) -- =============== -- Functions for qualifying Ids in data from a submodule with its instance -- so that it will not clash when added into the parent module's data. -- Qualify an Id by using the qualifier field of the Id, -- leaving the base identifier unchanged. -- This allows us to extract the base Id and manipulate it, independent -- of the qualifier (like adding "CAN_FIRE_" to a rule Id). -- Hierarchy is indicated with "." between the instance names, -- so if there is already a qualifier, add the instance in front with dot. -- XXX what happens if there's a dot in an escaped name? "\foo.bar" qualifyChildId :: String -> AId -> AId qualifyChildId inst i = let q_str = getIdQualString i q_str' = if (q_str == "") then inst else inst ++ "." ++ q_str in setIdQualString i q_str' -- Functions to qualify Ids in CombSchedInfo data qualifyChildSchedNode :: String -> SchedNode -> SchedNode qualifyChildSchedNode inst (Sched i) = (Sched (qualifyChildId inst i)) qualifyChildSchedNode inst (Exec i) = (Exec (qualifyChildId inst i)) qualifyChildSchedGraph :: String -> [(SchedNode,[SchedNode])] -> [(SchedNode,[SchedNode])] qualifyChildSchedGraph inst edges = let qualifyEdge (n, ns) = (qualifyChildSchedNode inst n, map (qualifyChildSchedNode inst) ns) in map qualifyEdge edges qualifyChildConflictGraph :: String -> [(AId,[AId])] -> [(AId,[AId])] qualifyChildConflictGraph inst edges = let qualifyEdge (i, is) = (qualifyChildId inst i, map (qualifyChildId inst) is) in map qualifyEdge edges qualifyChildDRDBGraph :: String -> [(AId,[AId])] -> [(AId,[AId])] qualifyChildDRDBGraph inst edges = let qualifyEdge (r, rs) = (qualifyChildId inst r, map (qualifyChildId inst) rs) in map qualifyEdge edges qualifyChildDomainId :: String -> DomainId -> DomainId qualifyChildDomainId inst (i,d) = (qualifyChildId inst i, d) qualifyChildDomainInfo :: String -> DomainInfo -> DomainInfo qualifyChildDomainInfo inst dinfo = let qualifyClocks = map (qualifyChildAClock inst) qualifyDomains = map (qualifyChildDomainId inst) qualifyRules = let qualifyRule rule_id = qualifyChildId inst rule_id in map qualifyRule qualifyPrims = let qualifyPrim (prim_id, (clk_arg, aclk)) = (qualifyChildId inst prim_id, (clk_arg, qualifyChildAClock inst aclk)) in map qualifyPrim qualifyResets = mapFst (qualifyChildId inst) qualifyOutputClks = mapSnd (qualifyChildAClock inst) qualifyClkSubsts = let qualSubst (a,b) = (qualifyChildAClock inst a, qualifyChildAClock inst b) in map qualSubst in DomainInfo { di_clocks = qualifyClocks (di_clocks dinfo), di_domains = qualifyDomains (di_domains dinfo), di_rules = qualifyRules (di_rules dinfo), di_clock_crossing_rules = qualifyRules (di_clock_crossing_rules dinfo), di_prims = qualifyPrims (di_prims dinfo), di_prim_resets = qualifyResets (di_prim_resets dinfo), di_output_clocks = qualifyOutputClks (di_output_clocks dinfo), di_clock_substs = qualifyClkSubsts (di_clock_substs dinfo) } -- XXX alternatively, we can declare QualifiedAClock, -- XXX to be a qualifier plus the underlying AClock ? qualifyChildAClock :: String -> AClock -> AClock -- This is called on substitution pairs where the value might be "noClock" -- instead of a port, so don't call "qualifyChildOsc" in that situation. qualifyChildAClock inst aclk | isNoClock aclk = aclk qualifyChildAClock inst (AClock osc gate) = AClock (qualifyChildOsc inst osc) (qualifyChildGate inst gate) qualifyChildOsc :: String -> AExpr -> AExpr qualifyChildOsc inst (ASPort t pid) = (ASPort t (qualifyChildId inst pid)) qualifyChildOsc inst e = internalError ("qualifyChildOsc: unexpected expr " ++ ppReadable e) qualifyChildGate :: String -> AExpr -> AExpr qualifyChildGate inst (AMGate t oid cid) = (AMGate t (qualifyChildId inst oid) cid) qualifyChildGate inst (ASPort t g) = (ASPort t (qualifyChildId inst g)) qualifyChildGate inst e | isTrue e = e qualifyChildGate inst e = internalError ("qualifyChildGate: unexpected expr " ++ ppReadable e) qualifyChildRuleRelationInfo :: String -> RuleRelationInfo -> RuleRelationInfo qualifyChildRuleRelationInfo inst rri = RuleRelationInfo { mCF = fmap (qualifyChildConflicts inst) (mCF rri), mSC = fmap (qualifyChildConflicts inst) (mSC rri), mRes = fmap (qualifyChildConflicts inst) (mRes rri), mCycle = fmap (qualifyChildConflicts inst) (mCycle rri), mPragma = fmap (qualifyChildConflicts inst) (mPragma rri), mArb = fmap (qualifyChildConflicts inst) (mArb rri) } qualifyChildConflicts :: String -> Conflicts -> Conflicts qualifyChildConflicts inst (CUse mpairs) = let mapFn (m1, m2) = (qualifyChildMethodId inst m1, qualifyChildMethodId inst m2) in CUse (map mapFn mpairs) qualifyChildConflicts inst (CCycle rIds) = CCycle (map (qualifyChildId inst) rIds) qualifyChildConflicts inst c@(CResource mId) = CResource (qualifyChildMethodId inst mId) qualifyChildConflicts inst c@(CMethodsBeforeRules) = c qualifyChildConflicts inst c@(CUserEarliness _) = c qualifyChildConflicts inst c@(CUserAttribute _) = c qualifyChildConflicts inst c@(CUserPreempt _) = c qualifyChildConflicts inst c@(CArbitraryChoice) = c qualifyChildConflicts inst c@(CFFuncArbitraryChoice) = c qualifyChildMethodId :: String -> MethodId -> MethodId qualifyChildMethodId inst (MethodId objId methId) = MethodId (qualifyChildId inst objId) methId -- =============== -- Functions for creating the maps in SimPackage mkDefMap :: [ADef] -> DefMap mkDefMap ds = M.fromList $ map (\d -> (adef_objid d,d)) ds mkAVInstMap :: [AVInst] -> AVInstMap mkAVInstMap avis = M.fromList $ map (\inst -> (avi_vname inst, inst)) avis mkMethodOrderMap :: [AVInst] -> MethodOrderMap mkMethodOrderMap avis = let mkMethodOrderSet avi = S.fromList $ sSB (methodConflictInfo (vSched (avi_vmi avi))) in M.fromList $ map (\avi -> (avi_vname avi, mkMethodOrderSet avi)) avis -- =============== -- Data and functions for creating method use maps -- the code for creating the map is similar to AUses.aRuleUseMap, -- but this creates the data structure that's better here, -- and we choose to re-compute the info to both be sure that it's -- up-to-date and to not have to write the info the .ba file -- --------------- -- map from a submod instance name to a map from each rule/method in -- the parent module to uses in the child module (pred uses, body uses) type ParentUseModMap = M.Map String ParentUseMap -- given (ruleId, instId), return the (sched uses, exec uses) -- of that rule/method on that submodule instance type ParentUseMap = M.Map (AId, String) Uses -- The uses by a rule/method are (sched uses, exec uses) type Uses = ([AId], [AId]) findParentUseMap :: ParentUseModMap -> String -> ParentUseMap findParentUseMap pumod_map mod = case M.lookup mod pumod_map of Just pumap -> pumap Nothing -> internalError ("SimExpand.findParentUseMap: cannot find " ++ mod) findParentUses :: ParentUseMap -> (AId, String) -> Uses findParentUses use_map idx = case M.lookup idx use_map of Just uses -> uses Nothing -> -- no entry means there are no uses of that rule with -- that module, so return empty uses -- XXX if we wanted some sanity checking, we could have -- XXX put in empty entries; but it would also slow down -- XXX lookup ([], []) {- internalError ("SimExpand.findParentUses: cannot find " ++ ppReadable idx ++ ppReadable (M.toList use_map)) -} -- --------------- mkParentUseModMap :: [(String, ABinModInfo)] -> ParentUseModMap mkParentUseModMap abis = let edges = [ (mod, mkParentUseMap abi) | (mod, abi) <- abis ] in M.fromList edges mkParentUseMap :: ABinModInfo -> ParentUseMap mkParentUseMap parent_abi = let apkg = abmi_apkg parent_abi local_defs = apkg_local_defs apkg ifcs = apkg_interface apkg rs = apkg_rules apkg -- definitions of the value methods in the interface ifc_defs = [d | (AIDef { aif_value = d }) <- ifcs] ++ [d | (AIActionValue { aif_value = d }) <- ifcs] defs = ifc_defs ++ local_defs defUseMap = M.fromList [(d, eDomain defUseMap e) | ADef d _ e _<- defs] use_infos = (concatMap cvtIfc ifcs) ++ (map cvtARule rs) -- This is a map from ruleId to uses on all submodules raw_use_pairs = [ (rId, raw_uses) | uinfo <- use_infos, let rId = user_name uinfo, let raw_uses = rUses defUseMap uinfo ] -- convert a list of raw uses into a map for pairs (rId,inst) cvtRawUses (rId, (pred_raw_uses, body_raw_uses)) map_so_far = let -- function for adding uses to an existing list -- (the 2nd pair will be shorted, so start with it) comb (as1, bs1) (as2, bs2) = ((as2 ++ as1), (bs2 ++ bs1)) cvtOnePredRawUse (inst,meth) m = M.insertWith comb (rId, getIdString inst) ([meth],[]) m cvtOneBodyRawUse (inst,meth) m = M.insertWith comb (rId, getIdString inst) ([],[meth]) m map_with_pred_uses = foldr cvtOnePredRawUse map_so_far pred_raw_uses map_with_all_uses = foldr cvtOneBodyRawUse map_with_pred_uses body_raw_uses in map_with_all_uses rUseMap = foldr cvtRawUses M.empty raw_use_pairs in rUseMap -- --------------- -- Returns the (pred uses, body uses) for a given rule/method useinfo. -- A use is a method Id on a particular instance (instId, methId). rUses :: M.Map AId [(AId,AId)] -> UseInfo -> ([(AId,AId)], [(AId,AId)]) rUses m (UseInfo _ pred_reads body_reads body_writes) = let body_action_uses = mergeUses $ map (aUses m) body_writes body_read_uses = mergeUses $ map (eDomain m) body_reads pred_read_uses = mergeUses $ map (eDomain m) pred_reads in (pred_read_uses, body_action_uses `union` body_read_uses) mergeUses :: [[(AId, AId)]] -> [(AId, AId)] mergeUses = stableOrdNub . concat -- Returns the method uses in an action. -- A use is a method Id on a particular instance (instId, methId) aUses :: M.Map AId [(AId,AId)] -> AAction -> [(AId,AId)] aUses m a@(ACall i mi es) = [(i, unQualId mi)] ++ mergeUses (map (eDomain m) es) aUses m a@(AFCall i _ _ es isAssump) = if isAssump then [] else mergeUses $ map (eDomain m) es aUses m a@(ATaskAction i _ _ _ es _ _ isAssump) = if isAssump then [] else mergeUses $ map (eDomain m) es -- Returns the method uses in an expression. -- A use is a method Id on a particular instance (instId, methId) eDomain :: M.Map AId [(AId,AId)] -> AExpr -> [(AId,AId)] eDomain m (APrim _ _ _ es) = mergeUses $ map (eDomain m) es eDomain m e@(AMethCall _ i mi es) = mergeUses ([(i, unQualId mi)] : map (eDomain m) es) -- don't count the return value uses of actionvalue, only the action part eDomain m (AMethValue _ _ _) = [] eDomain m (ANoInlineFunCall _ _ _ es) = mergeUses $ map (eDomain m) es eDomain m (AFunCall _ _ _ _ es) = mergeUses $ map (eDomain m) es eDomain _ e@(ASPort _ i) = [] eDomain _ e@(ASParam _ i) = [] eDomain m (ASDef _ d) = M.findWithDefault err d m where err = internalError $ "SimExpand.eDomain: no definition for " ++ ppReadable d ++ ppReadable (M.toList m) eDomain _ (ASInt _ _ _) = [] eDomain _ (ASReal _ _ _) = [] eDomain _ (ASStr _ _ _) = [] eDomain _ (ASAny _ _) = [] -- the uses are counted on the action side eDomain _ (ATaskValue { }) = [] eDomain _ e@(ASClock { }) = internalError ("SimExpand.eDomain unexpected clock" ++ ppReadable e) eDomain _ e@(ASReset { }) = internalError ("SimExpand.eDomain unexpected reset" ++ ppReadable e) eDomain _ e@(ASInout { }) = internalError ("SimExpand.eDomain unexpected inout" ++ ppReadable e) eDomain _ (AMGate { }) = [] -- --------------- -- extract from a rule or method: -- (predicate reads, body reads, body actions) data UseInfo = UseInfo { user_name :: AId , pred_reads :: [AExpr] , body_reads :: [AExpr] , body_actions :: [AAction] } cvtARule :: ARule -> UseInfo cvtARule (ARule rId _ _ _ rPred rActs _ rOrig) = UseInfo { user_name = rId , pred_reads = [rPred] , body_reads = [] , body_actions = rActs } cvtIfc :: AIFace -> [UseInfo] cvtIfc (AIAction _ _ ifPred ifId ifRs _) = -- note that if we had used cvtIfc from AUses, we wouldn't -- have been able to distinguish pred reads from non-pred reads [(UseInfo rId [ifPred, rPred] [] rActs) | (ARule rId _ _ _ rPred rActs _ _) <- ifRs] cvtIfc (AIActionValue _ _ ifPred ifId ifRs (ADef dId t _ _) _) = -- similar to converting an action, but include the return value -- in the body value uses of each split rule -- (note that, if the method body is not split into multiple -- rule, dId and rId will be the same) [(UseInfo rId [ifPred, rPred] [dExpr] rActs) | (ARule rId _ _ _ rPred rActs _ _) <- ifRs] where dExpr = ASDef t dId cvtIfc (AIDef _ _ _ ifPred (ADef dId t _ _) _ _) | isRdyId dId = [] | otherwise = [(UseInfo dId [ifPred] [dExpr] [])] where dExpr = ASDef t dId cvtIfc (AIClock {}) = [] cvtIfc (AIReset {}) = [] cvtIfc (AIInout {}) = [] -- =============== getABI :: String -> [(String, ABinModInfo)] -> ABinModInfo getABI mod abis = case (lookup mod abis) of Nothing -> internalError ("getABI: " ++ mod ++ "\n" ++ ppReadable (map fst abis)) Just x -> x -- =============== -- If the backend is Bluesim, -- check that the package does not contain any features not supported -- by the Bluesim backend: -- - Inout not supported in the provided interface -- - Inout not supported as a module argument -- - Dynamic expressions for ports on submodule instantiations -- (for this, we also inline the -- Returns the package, possibly with submod port expressions inlined. -- When compiling for Verilog, we just return the package, unchanged. -- XXX Note that when the backend is not Bluesim, but the .ba file is not -- XXX marked Verilog-only, then the following Bluesim-only checks -- XXX could still be done, but would taint the .ba file to be -- XXX Verilog-only and we would issue a warning. -- The first argument is whether the backend is Bluesim simCheckPackage :: ErrorHandle -> Bool -> APackage -> IO APackage simCheckPackage errh False apkg = return apkg simCheckPackage errh True apkg = do -- check for unsupported primitives (such as MCD) checkBluesimPrimitives errh apkg -- check for Inout in the ifc and the arguments checkInout errh apkg -- check for split methods checkSplitMethods errh apkg -- check for dynamic ports (and also inline submodule port/param exprs) apkg' <- simExpandParams errh apkg return apkg' -- ---------- checkInout :: ErrorHandle -> APackage -> IO () checkInout errh apkg = do let pos = getPosition (apkg_name apkg) -- check for Inout in the ifc let inout_ifcs = [ i | (AIInout i _ _) <- apkg_interface apkg ] ifc_errs = if (null inout_ifcs) then [] else [(pos, EBSimInoutIfc (map getIdString inout_ifcs))] -- check for Inout arguments let inout_args = [ i | (AAI_Inout i _) <- apkg_inputs apkg ] arg_errs = if (null inout_args) then [] else [(pos, EBSimInoutArg Nothing (map getIdString inout_args))] -- report all the Inout errors together (rather than stop at the first) let errs = ifc_errs ++ arg_errs when (not (null errs)) $ bsError errh errs -- ---------- checkSplitMethods :: ErrorHandle -> APackage -> IO () checkSplitMethods errh apkg = do let pos = getPosition (apkg_name apkg) ifcs = apkg_interface apkg let split_methods = [ i | (AIAction { aif_name = i, aif_body = rs }) <- ifcs, length rs > 1 ] ++ [ i | (AIActionValue { aif_name = i, aif_body = rs }) <- ifcs, length rs > 1 ] when (not (null split_methods)) $ bsError errh [(pos, EBSimSplitMethods (map getIdString split_methods))] -- ---------- simExpandParams :: ErrorHandle -> APackage -> IO APackage simExpandParams errh apkg = let defs = apkg_local_defs apkg dmap = M.fromList [ (i, aSubst dmap e) | ADef i _ e _ <- defs ] port_ids = [ i | AAI_Port (i,_) <- apkg_inputs apkg ] inlineArg (Param {}, expr) = aSubst dmap expr inlineArg (Port {}, expr) = aSubst dmap expr inlineArg (_, expr) = expr inlineArgs avi = let varginfo = vArgs (avi_vmi avi) es = avi_iargs avi es' = map inlineArg (zip varginfo es) in avi { avi_iargs = es' } insts = apkg_state_instances apkg insts' = map inlineArgs insts apkg' = apkg { apkg_state_instances = insts' } emsgs = concatMap (checkInstArgs port_ids) insts' in if (null emsgs) then return apkg' else bsError errh emsgs -- The first argument is a list of ports to the parent module -- (we will check later that they are constant, so we can assume -- that they are constant here) -- We also go ahead and do a (redundant) check that none of the submodule -- arguments are Inout. checkInstArgs :: [AId] -> AVInst -> [EMsg] checkInstArgs port_ids avi = let inst_name = avi_vname avi iarg_pairs = getInstArgs avi -- 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 -- separate Inout from normal ports/params (iarg_pairs_inout, iarg_pairs_port_or_param) = partition (\ (i,e) -> isInout i ) iarg_pairs_no_clk getIArgNames ia_pairs = map (getIdString . getVArgInfoName . fst) ia_pairs -- Bluesim does not support Inout, so create errors inout_iarg_names = getIArgNames iarg_pairs_inout inout_iarg_errs = if (null iarg_pairs_inout) then [] else [(getPosition inst_name, EBSimInoutArg (Just (getIdString inst_name)) inout_iarg_names)] -- Bluesim does not support dynamic ports, so create errors dynamic_iarg_pairs = filter (not . isConstAExpr port_ids . snd) iarg_pairs_port_or_param -- the names of any ports with dynamic exprs dynamic_iarg_names = getIArgNames dynamic_iarg_pairs dynamic_iarg_errs = if (null dynamic_iarg_pairs) then [] else [(getPosition inst_name, EBSimDynamicArg (getIdString inst_name) dynamic_iarg_names)] in -- report as many at once inout_iarg_errs ++ dynamic_iarg_errs -- =============== -- Lift AIActionValue return values which are method calls -- and any method return value which is a foreign call to -- local defs. makeMethodTemps :: APackage -> APackage makeMethodTemps apkg = let (defs', iface') = cvt 1 (apkg_local_defs apkg) [] (apkg_interface apkg) in apkg { apkg_local_defs = defs', apkg_interface = iface' } where cvt _ defs iface [] = (defs, reverse iface) cvt seqNo defs iface (aif:aifs) = let (is_def, is_av) = case aif of (AIDef {}) -> (True,False) (AIActionValue {}) -> (False,True) otherwise -> (False,False) in if is_def || is_av then case process is_av (aif_value aif) (aif_name aif) seqNo of (Just t@(ADef tid ty e props)) -> let aid = adef_objid (aif_value aif) -- unclear if propagating the props is correct new_def = (ADef aid ty (ASDef ty tid) props) aif' = aif { aif_value = new_def } in cvt (seqNo + 1) (t:defs) (aif':iface) aifs Nothing -> cvt seqNo defs (aif:iface) aifs else cvt seqNo defs (aif:iface) aifs process is_av (ADef aid ty e@(AMethCall {}) props) name seqNo = if is_av then let tid = mkIdTempReturn is_av name seqNo in (Just (ADef tid ty e props)) else Nothing process is_av (ADef aid ty e@(AFunCall {}) props) name seqNo = if (ae_isC e) then let tid = mkIdTempReturn is_av name seqNo in (Just (ADef tid ty e props)) else Nothing process _ _ _ _ = Nothing -- =============== -- Convert noinline function uses into method calls on module instances -- Assumes that noinline funcs are all top-level defs, -- which aNoInline ensures. -- Returns new defs (that call methods, not noinline functions) -- and pairs of info for each instance (inst name, mod name) getNoInlineInfo :: [ADef] -> ( [ADef], [(String, String)] ) getNoInlineInfo defs = let -- extract the output port name getOutPortName (_,[(oname,_)]) = oname getOutPortName _ = internalError "getNoInlineInfo: invalid ports" cvtDef (ADef di dt (ANoInlineFunCall ft fi (ANoInlineFun mod_name _ ports (Just inst_name)) es) props) = let pos = getPosition fi -- XXX because noinline "foreign" Id is escaped with an "_", -- XXX we can't get the method name from "fi" --methId = fi methId = mkId pos (mkFString (getOutPortName ports)) instId = mkId pos (mkFString inst_name) new_def = ADef di dt (AMethCall ft instId methId es) props in (new_def, Just (inst_name, mod_name)) cvtDef def = (def, Nothing) (new_defs, maybe_inst_infos) = unzip (map cvtDef defs) noinline_instances = catMaybes maybe_inst_infos in (new_defs, noinline_instances) -- =============== -- Extract the clock from a clock arg instantiation expr getClkFromAExpr :: AExpr -> AClock getClkFromAExpr (ASClock _ aclk) = aclk getClkFromAExpr e = internalError ("SimExpand: getClkFromAExpr: " ++ "not clock expr: " ++ ppReadable e) isNoClock :: AClock -> Bool isNoClock aclk = isFalse (aclock_osc aclk) noClock :: AClock noClock = AClock aFalse aFalse {- -- Given the expr for a clk, gate, or reset, -- extract the port that the expr refers to getPortId :: AExpr -> AId getPortId (ASPort _ i) = i getPortId e = internalError ("SimExpand getPortId: not a port: " ++ show e) -- Alias for extracting an oscillator (in case the representation changes) getOscId :: AExpr -> AId getOscId = getPortId -- Or get the oscillator Id in String form getOscStr :: AExpr -> String getOscStr = getIdString . getOscId -- Alias for extracting a gate getGateId :: AExpr -> AId getGateId = getPortId -- Or get the gate Id in String form getGateStr :: AExpr -> String getGateStr = getIdString . getGateId -} -- =============== getWPropDomain :: AId -> WireProps -> ClockDomain getWPropDomain i wprops = case (wpClockDomain wprops) of Just x -> x Nothing -> internalError ("getWPropDomain: " ++ "rule/method with no clock: " ++ ppReadable i) -- =============== -- check whether a module has a method which is required to be enabled -- (so that Bluesim can reject simulating a design with always_enabled or -- enabled_when_ready methods at the top-level) hasEnabledMethod :: ABinModInfo -> Bool hasEnabledMethod modInfo = let pps = abmi_pps modInfo apkg = abmi_apkg modInfo ifcs = apkg_interface apkg -- get just the methods with Action component getActionIfcs (AIAction { aif_name = i }) = [i] getActionIfcs (AIActionValue { aif_name = i }) = [i] getActionIfcs _ = [] action_ifcs = concatMap getActionIfcs ifcs -- get just the pps for method enables isEnPragma (PPalwaysEnabled {}) = True isEnPragma (PPenabledWhenReady {}) = True isEnPragma _ = False en_pps = filter isEnPragma pps isEn i = (isAlwaysEn en_pps i) || (isEnWhenRdy en_pps i) in -- are any action methods required to be enabled (not (null en_pps)) && (any isEn action_ifcs) -- =============== -- Get the module arguments and parameters, so that Bluesim can reject -- designs with top-level args. getArgsAndParams :: ABinModInfo -> ([String],[String]) getArgsAndParams modInfo = let inputs = getAPackageInputs (abmi_apkg modInfo) params = filter (isParam . snd) inputs ports = filter (isPort . snd) inputs params' = [ getIdBaseString i | (AAI_Port (i,_),_) <- params ] ports' = [ getIdBaseString i | (AAI_Port (i,_),_) <- ports ] in (ports',params') -- =============== findGates :: [AAbstractInput] -> [AIFace] -> [ADef] -> [AExpr] findGates is fs ds = let in_gate_map = S.fromList [ g | (AAI_Clock _ (Just g)) <- is ] findGate e@(AMGate {}) gs = (e:gs) findGate e@(ASPort t i) gs | (S.member i in_gate_map) = (e:gs) findGate e gs = gs def_gate_uses = findAExprs (exprFold findGate []) ds ifc_gate_uses = findAExprs (exprFold findGate []) fs in -- combine and remove duplicates S.toList $ S.union (S.fromList def_gate_uses) (S.fromList ifc_gate_uses) -- ===============