From 3704620a9078bbcc429229e29242b7352647ee89 Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Fri, 17 Aug 2007 14:45:31 +0000 Subject: [PATCH] Fix description and type profiling Consistently make the type and description in the info table an offset or a pointer, depending on whether tables are next to code or not. --- compiler/cmm/CmmInfo.hs | 123 ++++++++++++++++++++-------------------- compiler/codeGen/CgInfoTbls.hs | 8 +-- 2 files changed, 64 insertions(+), 67 deletions(-) diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs index 017efe4..520566d 100644 --- a/compiler/cmm/CmmInfo.hs +++ b/compiler/cmm/CmmInfo.hs @@ -76,73 +76,72 @@ mkInfoTable uniq (CmmProc (CmmInfo _ _ info) entry_label arguments blocks) = -- | Code without an info table. Easy. CmmNonInfoTable -> [CmmProc [] entry_label arguments blocks] - -- | A function entry point. - CmmInfoTable (ProfilingInfo ty_prof cl_prof) type_tag - (FunInfo (ptrs, nptrs) srt fun_type fun_arity - pap_bitmap slow_entry) -> - mkInfoTableAndCode info_label std_info fun_extra_bits entry_label - arguments blocks - where - fun_extra_bits = - [packHalfWordsCLit fun_type fun_arity] ++ - case pap_bitmap of + CmmInfoTable (ProfilingInfo ty_prof cl_prof) type_tag type_info -> + let info_label = entryLblToInfoLbl entry_label + ty_prof' = if tablesNextToCode + then makeRelativeRefTo info_label ty_prof + else ty_prof + cl_prof' = if tablesNextToCode + then makeRelativeRefTo info_label cl_prof + else cl_prof + in case type_info of + -- | A function entry point. + FunInfo (ptrs, nptrs) srt fun_type fun_arity pap_bitmap slow_entry -> + mkInfoTableAndCode info_label std_info fun_extra_bits entry_label + arguments blocks + where + fun_extra_bits = + [packHalfWordsCLit fun_type fun_arity] ++ + case pap_bitmap of ArgGen liveness -> (if null srt_label then [mkIntCLit 0] else srt_label) ++ [makeRelativeRefTo info_label $ mkLivenessCLit liveness, makeRelativeRefTo info_label slow_entry] _ -> srt_label - std_info = mkStdInfoTable ty_prof cl_prof type_tag srt_bitmap layout - info_label = entryLblToInfoLbl entry_label - (srt_label, srt_bitmap) = mkSRTLit info_label srt - layout = packHalfWordsCLit ptrs nptrs - - -- | A constructor. - CmmInfoTable (ProfilingInfo ty_prof cl_prof) type_tag - (ConstrInfo (ptrs, nptrs) con_tag descr) -> - mkInfoTableAndCode info_label std_info [con_name] entry_label - arguments blocks - where - std_info = mkStdInfoTable ty_prof cl_prof type_tag con_tag layout - info_label = entryLblToInfoLbl entry_label - con_name = makeRelativeRefTo info_label descr - layout = packHalfWordsCLit ptrs nptrs - - -- | A thunk. - CmmInfoTable (ProfilingInfo ty_prof cl_prof) type_tag - (ThunkInfo (ptrs, nptrs) srt) -> - mkInfoTableAndCode info_label std_info srt_label entry_label - arguments blocks - where - std_info = mkStdInfoTable ty_prof cl_prof type_tag srt_bitmap layout - info_label = entryLblToInfoLbl entry_label - (srt_label, srt_bitmap) = mkSRTLit info_label srt - layout = packHalfWordsCLit ptrs nptrs - - -- | A selector thunk. - CmmInfoTable (ProfilingInfo ty_prof cl_prof) type_tag - (ThunkSelectorInfo offset srt) -> - mkInfoTableAndCode info_label std_info [{- no SRT -}] entry_label - arguments blocks - where - std_info = mkStdInfoTable ty_prof cl_prof type_tag 0 (mkWordCLit offset) - info_label = entryLblToInfoLbl entry_label - - -- A continuation/return-point. - CmmInfoTable (ProfilingInfo ty_prof cl_prof) type_tag - (ContInfo stack_layout srt) -> - liveness_data ++ - mkInfoTableAndCode info_label std_info srt_label entry_label - arguments blocks - where - std_info = mkStdInfoTable ty_prof cl_prof maybe_big_type_tag srt_bitmap - (makeRelativeRefTo info_label liveness_lit) - info_label = entryLblToInfoLbl entry_label - (liveness_lit, liveness_data, liveness_tag) = - mkLiveness uniq stack_layout - maybe_big_type_tag = if type_tag == rET_SMALL - then liveness_tag - else type_tag - (srt_label, srt_bitmap) = mkSRTLit info_label srt + std_info = mkStdInfoTable ty_prof' cl_prof' type_tag srt_bitmap + layout + (srt_label, srt_bitmap) = mkSRTLit info_label srt + layout = packHalfWordsCLit ptrs nptrs + + -- | A constructor. + ConstrInfo (ptrs, nptrs) con_tag descr -> + mkInfoTableAndCode info_label std_info [con_name] entry_label + arguments blocks + where + std_info = mkStdInfoTable ty_prof' cl_prof' type_tag con_tag layout + con_name = makeRelativeRefTo info_label descr + layout = packHalfWordsCLit ptrs nptrs + + -- | A thunk. + ThunkInfo (ptrs, nptrs) srt -> + mkInfoTableAndCode info_label std_info srt_label entry_label + arguments blocks + where + std_info = mkStdInfoTable ty_prof' cl_prof' type_tag srt_bitmap layout + (srt_label, srt_bitmap) = mkSRTLit info_label srt + layout = packHalfWordsCLit ptrs nptrs + + -- | A selector thunk. + ThunkSelectorInfo offset srt -> + mkInfoTableAndCode info_label std_info [{- no SRT -}] entry_label + arguments blocks + where + std_info = mkStdInfoTable ty_prof' cl_prof' type_tag 0 (mkWordCLit offset) + + -- A continuation/return-point. + ContInfo stack_layout srt -> + liveness_data ++ + mkInfoTableAndCode info_label std_info srt_label entry_label + arguments blocks + where + std_info = mkStdInfoTable ty_prof' cl_prof' maybe_big_type_tag srt_bitmap + (makeRelativeRefTo info_label liveness_lit) + (liveness_lit, liveness_data, liveness_tag) = + mkLiveness uniq stack_layout + maybe_big_type_tag = if type_tag == rET_SMALL + then liveness_tag + else type_tag + (srt_label, srt_bitmap) = mkSRTLit info_label srt -- Handle the differences between tables-next-to-code -- and not tables-next-to-code diff --git a/compiler/codeGen/CgInfoTbls.hs b/compiler/codeGen/CgInfoTbls.hs index e9751fa..1780f51 100644 --- a/compiler/codeGen/CgInfoTbls.hs +++ b/compiler/codeGen/CgInfoTbls.hs @@ -74,13 +74,11 @@ dataConTagZ con = dataConTag con - fIRST_TAG -- Not used for return points. (The 'smRepClosureTypeInt' call would panic.) mkCmmInfo :: ClosureInfo -> FCode CmmInfo mkCmmInfo cl_info = do - prof <- - if opt_SccProfilingOn + prof <- + if opt_SccProfilingOn then do ty_descr_lit <- mkStringCLit (closureTypeDescr cl_info) cl_descr_lit <- mkStringCLit (closureValDescr cl_info) - return $ ProfilingInfo - (makeRelativeRefTo info_lbl ty_descr_lit) - (makeRelativeRefTo info_lbl cl_descr_lit) + return $ ProfilingInfo ty_descr_lit cl_descr_lit else return $ ProfilingInfo (mkIntCLit 0) (mkIntCLit 0) case cl_info of -- 1.7.10.4