module SystemCWrapper (checkSystemCIfc, wrapSystemC) where import Flags(Flags(..), verbose) import Error(internalError, ErrMsg(..), ErrorHandle, bsError) import Position(noPosition) import Id(getIdBaseString, getIdString, isRdyId, dropReadyPrefixId) import Pragma(isAlwaysRdy, isEnWhenRdy) import FileNameUtil(mkCxxName, mkHName) import ASyntax(AAbstractInput(..), AIFace(..), AExpr(..), AClock(..), aIfaceArgs, aIfaceName, aIfaceProps) import ASyntaxUtil import VModInfo(vName_to_id, VPathInfo(..)) import Wires import AScheduleInfo(AScheduleInfo(..)) import SchedInfo(SchedInfo(..)) import SimPackage(SimSystem(..), SimPackage(..), findPkg, getPortInfo) import SimCCBlock(pfxPort, pfxMeth, pfxMod) import CCSyntax import TopUtils(putStrLnF) import Control.Monad(when) import Data.Maybe(maybeToList, mapMaybe) import PPrint import Data.List(intersperse, partition) import qualified Data.Map as M --import Debug.Trace checkSystemCIfc :: ErrorHandle -> Flags -> SimSystem -> IO () checkSystemCIfc errh flags sim_system = do let top_pkg = findPkg (ssys_packages sim_system) (ssys_top sim_system) pps = sp_pps top_pkg let pathinfo@(VPathInfo paths) = sp_pathinfo top_pkg path_desc = ppReadable pathinfo path_err = (noPosition,ESystemCWrapperComboPaths path_desc) when (not (null paths)) $ bsError errh [path_err] let isBad m@(AIDef {}) = not (null (aIfaceArgs m)) isBad m@(AIActionValue {}) = -- we allow ActionValue methods only -- if they have no arguments and no enable not ((null (aIfaceArgs m)) && (isEnWhenRdy pps (aIfaceName m))) isBad _ = False bad_methods = [ getIdBaseString (aif_name m) | m <- sp_interface top_pkg , isBad m ] method_err = (noPosition,ESystemCWrapperInvalidMethods bad_methods) when (not (null bad_methods)) $ bsError errh [method_err] let is_value_method m d@(AIDef {}) = (aif_name d) == m is_value_method m d@(AIActionValue {}) = (aif_name d) == m is_value_method _ _ = False rbms = [ (m,rb) | (m,rb) <- rulesBeforeMethods (asi_v_sched_info (sp_schedule top_pkg)) , any (is_value_method m) (sp_interface top_pkg) ] describe (m,rs) = let mname = pPrint PDReadable 0 m rnames = [ pPrint PDReadable 0 r | (Left r) <- rs ] vmnames = [ pPrint PDReadable 0 vm | (Right vm) <- rs ] rdoc = (text "schedules after the rule(s):") <+> (hsep rnames) mdoc = (text "schedules after rules via the method call(s):") <+> (hsep vmnames) in case (rnames,vmnames) of ([],[]) -> internalError "checkSystemCIfc: no rules or methods" (_,[]) -> (mname, rdoc) ([],_) -> (mname, mdoc) (_,_) -> (mname, rdoc <+> (text "and") <+> mdoc) rbms_desc = map describe rbms rbm_err = (noPosition,ESystemCWrapperRuleBeforeMethod rbms_desc) when (not (null rbms)) $ bsError errh [rbm_err] wrapSystemC:: Flags -> SimSystem -> IO [(String,String)] wrapSystemC flags sim_system = do when (verbose flags) $ putStrLnF "generating SystemC file" let top_pkg = findPkg (ssys_packages sim_system) (ssys_top sim_system) pps = sp_pps top_pkg name = getIdBaseString (sp_name top_pkg) h_name = mkHName Nothing "" (name ++ "_systemc") cxx_name = mkCxxName Nothing "" (name ++ "_systemc") h_includes = [ cpp_include "bluesim_kernel_api.h" , cpp_include (mkHName Nothing "" name) , cpp_include ("model_" ++ name ++ ".h") ] cxx_includes = [ cpp_include "bluesim_systemc.h" , cpp_include h_name ] class_name = "SC_MODULE(" ++ name ++ ")" -- utility fns obj_ref o m = (var o) `cArrow` m obj_call o m args = (obj_ref o m) `cCall` args cvt_wide n x = let sc_type = if (n == 1) then boolType else classType "sc_bv" `templatedT` [ numType n ] conv = (var "bs_convert_wide_to_sysc") `templated` [sc_type] in if (n > 64) then conv `cCall` [x] else x read_port i = obj_call (getIdBaseString i) "read" [] write_port (_,i,n,True) = let nm = getIdBaseString i arg = cvt_wide n $ obj_ref "_model_inst" (pfxPort ++ nm) in obj_call nm "write" [ arg ] write_port (mid,i,n,False) = let nm = getIdBaseString i meth = pfxMeth ++ (getIdBaseString mid) arg = cvt_wide n $ obj_call "_model_inst" meth [] in obj_call nm "write" [ arg ] sample_port (n,i) = let nm = getIdBaseString i sc_type = if (n == 1) then boolType else classType "sc_bv" `templatedT` [ numType n ] bs_type = bitsType n CTunsigned conv = (var "bs_convert_from_sysc") `templated` [sc_type, bs_type] rhs = conv `cCall` [ read_port i ] in stmt (obj_ref "_model_inst" (pfxPort ++ nm)) `assign` rhs -- clk and reset ports clk_inputs = concat [ (osc:(maybeToList mgate)) | (AAI_Clock osc mgate) <- sp_inputs top_pkg ] rst_inputs = [ rst | (AAI_Reset rst) <- sp_inputs top_pkg ] bool_in_port_type = classType "sc_in" `templatedT` [classType "bool"] clk_rst_decls = [ decl $ (mkVar (getIdBaseString i)) `ofType` bool_in_port_type | i <- (clk_inputs ++ rst_inputs) ] -- module ports method_info = mapMaybe (getPortInfo pps) (sp_interface top_pkg) mk_port_map_entry (mid, (en, ins, ri, act, _)) = let en_list = maybe [] (\vn -> [(1,vName_to_id vn,True,False)]) en in_list = [ (aSize t,i,True,False) | (t,i,_) <- ins ] ret_list = maybe [] (\(t,vn) -> [(aSize t,vName_to_id vn,False,act)]) ri ports = filter (\(n,_,_,_) -> n>0) (en_list ++ in_list ++ ret_list) always_rdy = (isRdyId mid) && (isAlwaysRdy pps mid) in if ((null ports) || always_rdy) then Nothing else Just (mid, ports) port_entries = mapMaybe mk_port_map_entry method_info port_map = M.fromList port_entries merged_port_map = let (rs,nrs) = partition (isRdyId . fst) port_entries non_rdy_map = M.fromList nrs rdy_map = M.fromList [ (dropReadyPrefixId mid, ps) | (mid,ps) <- rs ] in M.unionWith (++) non_rdy_map rdy_map mk_port_decl (n,i,is_input,_) = let t = if (n == 1) then boolType else classType "sc_bv" `templatedT` [numType n] pt = if is_input then classType "sc_in" `templatedT` [t] else classType "sc_out" `templatedT` [t] in decl $ (mkVar (getIdBaseString i)) `ofType` pt port_decls = concat [ [comment ((getIdBaseString m) ++ " method ports") (blankLines 0)] ++ (map mk_port_decl ps) | (m,ps) <- M.toList merged_port_map ] -- utility functions for grouping methods by domain meth_domains = M.fromList [ (aIfaceName aif, dom) | aif <- (sp_interface top_pkg) , let wp = aIfaceProps aif , let dom = wpClockDomain wp ] clock_domains = [ (getIdString (ae_objid (aclock_osc clk)), dom) | (dom, clks) <- sp_clock_domains top_pkg , clk <- clks ] same_dom clk mid = case (lookup clk clock_domains) of Nothing -> internalError $ "SystemCWrapper: unknown clock " ++ clk (Just cd) -> case (M.lookup mid meth_domains) of Nothing -> internalError $ "SystemCWrapper: unknown method " ++ (getIdString mid) (Just Nothing) -> internalError $ "SystemCWrapper: no clock domain for method " ++ (getIdString mid) (Just (Just cd2)) -> (cd == cd2) || ((cd2 == noClockDomain) && (cd == initClockDomain)) -- bluesim model instance sub_mod_type = classType (pfxMod ++ name) sub_mod = decl $ ptr $ (mkVar "_model_inst") `ofType` sub_mod_type -- bluesim model handle model_hdl = decl $ (userType "tModel") (mkVar "_model_hdl") -- bluesim kernel state handle sim_hdl = decl $ (userType "tSimStateHdl") (mkVar "_sim_hdl") -- constructor & destructor -- XXX: this is an ugly hack to deal with the macro ctor_hack = ctor (mkVar "SC_CTOR") [mkVar name] mk_init i = let nm = getIdBaseString i in (var nm) `cCall` [mkStr nm] meth_ports = [ i | ports <- M.elems merged_port_map, (_,i,_,_) <- ports ] ilist = map mk_init (clk_inputs ++ rst_inputs ++ meth_ports) ++ [ (var "_model_inst") `cCall` [mkNULL] , (var "_model_hdl") `cCall` [mkNULL] , (var "_sim_hdl") `cCall` [mkNULL] ] setup_handler do_init i = let nm = getIdBaseString i change = (var nm) `cDot` "value_changed" `cCall` [] in [ blankLines 1 , stmt $ (var "SC_METHOD") `cCall` [var ("handle_" ++ nm)] , stmt $ (var "sensitive") `cLShift` change ] ++ ( if do_init then [] else [ stmt $ (var "dont_initialize") `cCall` [] ] ) ctor_stmts = (concatMap (setup_handler False) clk_inputs) ++ (concatMap (setup_handler True) rst_inputs) constructor = (define ctor_hack (block ctor_stmts)) `withInits` ilist dtor_stmts = [] destructor = define (dtor (mkVar name)) (block dtor_stmts) -- simulation callbacks start_of_sim_stmts = [ (mkVar "_model_hdl") `assign` ((var ("new_MODEL_" ++ name)) `cCall` []) , (mkVar "_sim_hdl") `assign` ((var "bk_init") `cCall` [ var "_model_hdl", mkBool False]) , stmt $ (var "bk_set_interactive") `cCall` [var "_sim_hdl"] , (mkVar "_model_inst") `assign` (cCast (ptrType sub_mod_type) ((var "bk_get_model_instance") `cCall` [var "_sim_hdl"])) ] sos_type = function void (mkVar "start_of_simulation") [] start_of_sim_fn = virtual $ define sos_type (block start_of_sim_stmts) end_of_sim_stmts = [ stmt $ (var "bk_shutdown") `cCall` [var "_sim_hdl"] ] eos_type = function void (mkVar "end_of_simulation") [] end_of_sim_fn = virtual $ define eos_type (block end_of_sim_stmts) -- clock and reset functions handler_type pfx i = let nm = getIdBaseString i pfx' = if (pfx == "") then "" else (pfx ++ "::") in function void (mkVar (pfx' ++ "handle_" ++ nm)) [] clk_stmts i = let nm = getIdBaseString i ins = [ (n,id) | (mid,ports) <- M.toList port_map , same_dom nm mid , (n,id,True,_) <- ports ] outs = [ (mid,id,n,act) | (mid,ports) <- M.toList port_map , same_dom nm mid , (n,id,False,act) <- ports ] get_clk = [ static . decl . (userType "tClock") $ (mkVar "_clk_hdl") `assign` ((var "bk_get_clock_by_name") `cCall` [var "_sim_hdl", mkStr nm]) ] next_edge = ((var "bk_clock_edge_count") `cCall` [var "_sim_hdl", var "_clk_hdl", var "dir"]) `cAdd` (mkUInt64 1) sample_inputs = [ comment "sample method input ports" (blankLines 0) ] ++ (map sample_port ins) do_vcd = [ comment "update VCD waveforms for ports" (blankLines 0) , decl . (userType "tTime") $ (mkVar "now") `assign` ((((var "sc_time_stamp") `cCall` []) `cDot` "value") `cCall` []) , stmt $ (var "bk_VCD_combo_update") `cCall` [var "_sim_hdl", var "now"] ] stop_cond = cOr ((var "bk_stopped") `cCall` [ var "_sim_hdl" ]) $ cOr ((var "bk_finished") `cCall` [ var "_sim_hdl" ]) $ ((var "bk_aborted") `cCall` [ var "_sim_hdl" ]) exec = [ comment "execute schedule" (blankLines 0) , decl . (userType "tEdgeDirection") $ (mkVar "dir") `assign` (cTernary (read_port i) (var "POSEDGE") (var "NEGEDGE")) , stmt $ (var "bk_quit_after_edge") `cCall` [ var "_sim_hdl", var "_clk_hdl", var "dir", next_edge ] , stmt $ (var "bk_trigger_clock_edge") `cCall` [ var "_sim_hdl", var "_clk_hdl", var "dir", var "now" ] , stmt $ (var "bk_advance") `cCall` [ var "_sim_hdl", mkBool False ] , if_cond stop_cond (stmt $ (var "sc_stop") `cCall` []) Nothing ] update_outputs = [ comment "update method output ports" (blankLines 0) ] ++ [ stmt $ write_port out | out <- outs ] in get_clk ++ sample_inputs ++ do_vcd ++ exec ++ update_outputs reset_call i = let nm = getIdBaseString i in stmt $ obj_call "_model_inst" ("reset_" ++ nm) [read_port i] clk_fn_decls = map (decl . (handler_type "")) clk_inputs clk_fn_defs = [ define (handler_type name i) (block (clk_stmts i)) | i <- clk_inputs ] rst_fn_decls = map (decl . (handler_type "")) rst_inputs rst_fn_defs = [ define (handler_type name i) (block [reset_call i]) | i <- rst_inputs ] -- put it all together class_sects = [ comment "clock and reset inputs" (public clk_rst_decls) , comment "method ports" (public port_decls) , comment "implementation class" (public [sub_mod]) , comment "Bluesim kernel state" (private [model_hdl, sim_hdl]) , comment "constructor" (public [constructor]) , comment "destructor" (public [destructor]) , comment "simulation callbacks" (public [start_of_sim_fn, end_of_sim_fn]) , comment "clock and reset handlers" (private (clk_fn_decls ++ rst_fn_decls)) ] h_fragments = h_includes ++ [ comment "SystemC model definition" $ c_macro_class class_name Nothing class_sects ] cxx_fragments = cxx_includes ++ [blankLines 1] ++ (intersperse (blankLines 1) (clk_fn_defs ++ rst_fn_defs)) h_contents = ppReadable $ program [protect_header (name ++ "_systemc") h_fragments] cxx_contents = ppReadable $ program cxx_fragments return [(h_name,h_contents), (cxx_name,cxx_contents)]