diff options
| -rw-r--r-- | compiler/GHC/Cmm/CLabel.hs | 4 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Config/StgToCmm.hs | 1 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Flags.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Session.hs | 1 | ||||
| -rw-r--r-- | compiler/GHC/StgToCmm/Bind.hs | 50 | ||||
| -rw-r--r-- | compiler/GHC/StgToCmm/Config.hs | 1 | ||||
| -rw-r--r-- | docs/users_guide/debugging.rst | 12 | ||||
| -rw-r--r-- | rts/StgMiscClosures.cmm | 11 | ||||
| -rw-r--r-- | rts/include/rts/storage/Closures.h | 7 | ||||
| -rw-r--r-- | utils/deriveConstants/Main.hs | 2 |
10 files changed, 86 insertions, 5 deletions
diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs index e1e69a6296..0666b98db4 100644 --- a/compiler/GHC/Cmm/CLabel.hs +++ b/compiler/GHC/Cmm/CLabel.hs @@ -53,6 +53,7 @@ module GHC.Cmm.CLabel ( mkDirty_MUT_VAR_Label, mkMUT_VAR_CLEAN_infoLabel, mkNonmovingWriteBarrierEnabledLabel, + mkOrigThunkInfoLabel, mkUpdInfoLabel, mkBHUpdInfoLabel, mkIndStaticInfoLabel, @@ -641,7 +642,7 @@ mkBlockInfoTableLabel name c = IdLabel name c BlockInfoTable -- Constructing Cmm Labels mkDirty_MUT_VAR_Label, mkNonmovingWriteBarrierEnabledLabel, - mkUpdInfoLabel, + mkOrigThunkInfoLabel, mkUpdInfoLabel, mkBHUpdInfoLabel, mkIndStaticInfoLabel, mkMainCapabilityLabel, mkMAP_FROZEN_CLEAN_infoLabel, mkMAP_FROZEN_DIRTY_infoLabel, mkMAP_DIRTY_infoLabel, @@ -655,6 +656,7 @@ mkDirty_MUT_VAR_Label, mkDirty_MUT_VAR_Label = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction mkNonmovingWriteBarrierEnabledLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "nonmoving_write_barrier_enabled") CmmData +mkOrigThunkInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_orig_thunk_info_frame") CmmInfo mkUpdInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_upd_frame") CmmInfo mkBHUpdInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_bh_upd_frame" ) CmmInfo mkIndStaticInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_IND_STATIC") CmmInfo diff --git a/compiler/GHC/Driver/Config/StgToCmm.hs b/compiler/GHC/Driver/Config/StgToCmm.hs index 283ece1d50..2a3a64b97c 100644 --- a/compiler/GHC/Driver/Config/StgToCmm.hs +++ b/compiler/GHC/Driver/Config/StgToCmm.hs @@ -37,6 +37,7 @@ initStgToCmmConfig dflags mod = StgToCmmConfig , stgToCmmFastPAPCalls = gopt Opt_FastPAPCalls dflags , stgToCmmSCCProfiling = sccProfilingEnabled dflags , stgToCmmEagerBlackHole = gopt Opt_EagerBlackHoling dflags + , stgToCmmOrigThunkInfo = gopt Opt_OrigThunkInfo dflags , stgToCmmInfoTableMap = gopt Opt_InfoTableMap dflags , stgToCmmOmitYields = gopt Opt_OmitYields dflags , stgToCmmOmitIfPragmas = gopt Opt_OmitInterfacePragmas dflags diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs index f08cb37d43..d67f026fc4 100644 --- a/compiler/GHC/Driver/Flags.hs +++ b/compiler/GHC/Driver/Flags.hs @@ -329,6 +329,7 @@ data GeneralFlag | Opt_IgnoreHpcChanges | Opt_ExcessPrecision | Opt_EagerBlackHoling + | Opt_OrigThunkInfo | Opt_NoHsMain | Opt_SplitSections | Opt_StgStats @@ -565,6 +566,7 @@ codeGenFlags = EnumSet.fromList -- Flags that affect debugging information , Opt_DistinctConstructorTables , Opt_InfoTableMap + , Opt_OrigThunkInfo ] data WarningFlag = diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs index dbd1f542ca..e44a543b13 100644 --- a/compiler/GHC/Driver/Session.hs +++ b/compiler/GHC/Driver/Session.hs @@ -3482,6 +3482,7 @@ fFlagsDeps = [ flagSpec "do-eta-reduction" Opt_DoEtaReduction, flagSpec "do-lambda-eta-expansion" Opt_DoLambdaEtaExpansion, flagSpec "eager-blackholing" Opt_EagerBlackHoling, + flagSpec "orig-thunk-info" Opt_OrigThunkInfo, flagSpec "embed-manifest" Opt_EmbedManifest, flagSpec "enable-rewrite-rules" Opt_EnableRewriteRules, flagSpec "enable-th-splice-warnings" Opt_EnableThSpliceWarnings, diff --git a/compiler/GHC/StgToCmm/Bind.hs b/compiler/GHC/StgToCmm/Bind.hs index 1181ed0597..ce022a092b 100644 --- a/compiler/GHC/StgToCmm/Bind.hs +++ b/compiler/GHC/StgToCmm/Bind.hs @@ -730,7 +730,8 @@ setupUpdate closure_info node body lbl | bh = mkBHUpdInfoLabel | otherwise = mkUpdInfoLabel - pushUpdateFrame lbl (CmmReg (CmmLocal node)) body + pushOrigThunkInfoFrame closure_info + $ pushUpdateFrame lbl (CmmReg (CmmLocal node)) body | otherwise -- A static closure = do { tickyUpdateBhCaf closure_info @@ -738,7 +739,8 @@ setupUpdate closure_info node body ; if closureUpdReqd closure_info then do -- Blackhole the (updatable) CAF: { upd_closure <- link_caf node - ; pushUpdateFrame mkBHUpdInfoLabel upd_closure body } + ; pushOrigThunkInfoFrame closure_info + $ pushUpdateFrame mkBHUpdInfoLabel upd_closure body } else do {tickyUpdateFrameOmitted; body} } @@ -754,8 +756,7 @@ pushUpdateFrame lbl updatee body = do updfr <- getUpdFrameOff profile <- getProfile - let - hdr = fixedHdrSize profile + let hdr = fixedHdrSize profile frame = updfr + hdr + pc_SIZEOF_StgUpdateFrame_NoHdr (profileConstants profile) -- emitUpdateFrame (CmmStackSlot Old frame) lbl updatee @@ -774,6 +775,47 @@ emitUpdateFrame frame lbl updatee = do initUpdFrameProf frame ----------------------------------------------------------------------------- +-- Original thunk info table frames +-- +-- Note [Original thunk info table frames] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- In some debugging scenarios (e.g. when debugging cyclic thunks) it can be very +-- useful to know which thunks the program is in the process of evaluating. +-- However, in the case of updateable thunks this can be very difficult +-- to determine since the process of blackholing overwrites the thunk's +-- info table pointer. +-- +-- To help in such situations we provide the -forig-thunk-info flag. This enables +-- code generation logic which pushes a stg_orig_thunk_info_frame stack frame to +-- accompany each update frame. As the name suggests, this frame captures the +-- the original info table of the thunk being updated. The entry code for these +-- frames has no operational effects; the frames merely exist as breadcrumbs +-- for debugging. + +pushOrigThunkInfoFrame :: ClosureInfo -> FCode () -> FCode () +pushOrigThunkInfoFrame closure_info body = do + cfg <- getStgToCmmConfig + if stgToCmmOrigThunkInfo cfg + then do_it + else body + where + orig_itbl = mkLblExpr (closureInfoLabel closure_info) + do_it = do + updfr <- getUpdFrameOff + profile <- getProfile + let platform = profilePlatform profile + hdr = fixedHdrSize profile + orig_info_frame_sz = + hdr + pc_SIZEOF_StgOrigThunkInfoFrame_NoHdr (profileConstants profile) + off_orig_info = hdr + pc_OFFSET_StgOrigThunkInfoFrame_info_ptr (profileConstants profile) + frame_off = updfr + orig_info_frame_sz + frame = CmmStackSlot Old frame_off + -- + emitStore frame (mkLblExpr mkOrigThunkInfoLabel) + emitStore (cmmOffset platform frame off_orig_info) orig_itbl + withUpdFrameOff frame_off body + +----------------------------------------------------------------------------- -- Entering a CAF -- -- See Note [CAF management] in rts/sm/Storage.c diff --git a/compiler/GHC/StgToCmm/Config.hs b/compiler/GHC/StgToCmm/Config.hs index f2bd349ae7..f6ec53c760 100644 --- a/compiler/GHC/StgToCmm/Config.hs +++ b/compiler/GHC/StgToCmm/Config.hs @@ -49,6 +49,7 @@ data StgToCmmConfig = StgToCmmConfig , stgToCmmFastPAPCalls :: !Bool -- ^ , stgToCmmSCCProfiling :: !Bool -- ^ Check if cost-centre profiling is enabled , stgToCmmEagerBlackHole :: !Bool -- ^ + , stgToCmmOrigThunkInfo :: !Bool -- ^ Push @stg_orig_thunk_info@ frames during thunk update. , stgToCmmInfoTableMap :: !Bool -- ^ true means generate C Stub for IPE map, See note [Mapping -- Info Tables to Source Positions] , stgToCmmOmitYields :: !Bool -- ^ true means omit heap checks when no allocation is performed diff --git a/docs/users_guide/debugging.rst b/docs/users_guide/debugging.rst index e2acac340f..a972cb8ff0 100644 --- a/docs/users_guide/debugging.rst +++ b/docs/users_guide/debugging.rst @@ -1072,6 +1072,18 @@ Checking for consistency cases. This is helpful when debugging demand analysis or type checker bugs which can sometimes manifest as segmentation faults. +.. ghc-flag:: -forig-thunk-info + :shortdesc: Generate ``stg_orig_thunk_info`` stack frames on thunk entry + :type: dynamic + + When debugging cyclic thunks it can be helpful to know the original + info table of a thunk being evaluated. This flag enables code generation logic + to facilitate this, producing a ``stg_orig_thunk_info`` stack frame alongside + the usual update frame; such ``orig_thunk`` frames have no operational + effect but capture the original info table of the updated thunk for inspection + by debugging tools. See ``Note [Original thunk info table frames]`` in + ``GHC.StgToCmm.Bind`` for details. + .. ghc-flag:: -fcheck-prim-bounds :shortdesc: Instrument array primops with bounds checks. :type: dynamic diff --git a/rts/StgMiscClosures.cmm b/rts/StgMiscClosures.cmm index 222a12e9c6..c07bf977a4 100644 --- a/rts/StgMiscClosures.cmm +++ b/rts/StgMiscClosures.cmm @@ -45,6 +45,17 @@ import CLOSURE stg_ret_t_info; import CLOSURE stg_ret_v_info; #endif +/* See Note [Original thunk info table frames] in GHC.StgToCmm.Bind. */ +INFO_TABLE_RET (stg_orig_thunk_info_frame, RET_SMALL, + W_ info_ptr, + W_ thunk_info_ptr) + /* no args => explicit stack */ +{ + unwind Sp = W_[Sp + WDS(2)]; + Sp_adj(2); + jump %ENTRY_CODE(Sp(0)) [*]; // NB. all registers live! +} + /* ---------------------------------------------------------------------------- Stack underflow ------------------------------------------------------------------------- */ diff --git a/rts/include/rts/storage/Closures.h b/rts/include/rts/storage/Closures.h index 1af689e5f1..cf1e6973be 100644 --- a/rts/include/rts/storage/Closures.h +++ b/rts/include/rts/storage/Closures.h @@ -261,6 +261,13 @@ typedef struct _StgUpdateFrame { StgClosure *updatee; } StgUpdateFrame; +// Thunk update frame +// +// Closure types: RET_SMALL +typedef struct _StgOrigThunkInfoFrame { + StgHeader header; + StgInfoTable *info_ptr; +} StgOrigThunkInfoFrame; // Closure types: RET_SMALL typedef struct { diff --git a/utils/deriveConstants/Main.hs b/utils/deriveConstants/Main.hs index c51f14382c..c4a592957c 100644 --- a/utils/deriveConstants/Main.hs +++ b/utils/deriveConstants/Main.hs @@ -437,6 +437,7 @@ wanteds os = concat ,structField Both "StgEntCounter" "entry_count" ,closureSize Both "StgUpdateFrame" + ,closureSize Both "StgOrigThunkInfoFrame" ,closureSize C "StgCatchFrame" ,closureSize C "StgStopFrame" ,closureSize C "StgDeadThreadFrame" @@ -479,6 +480,7 @@ wanteds os = concat ,structSize C "StgTSOProfInfo" ,closureField Both "StgUpdateFrame" "updatee" + ,closureField Both "StgOrigThunkInfoFrame" "info_ptr" ,closureField C "StgCatchFrame" "handler" ,closureField C "StgCatchFrame" "exceptions_blocked" |