[Git][ghc/ghc][wip/orig-thunk-info] compiler: Record original thunk info tables on stack
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Fri Jul 7 14:17:18 UTC 2023
Ben Gamari pushed to branch wip/orig-thunk-info at Glasgow Haskell Compiler / GHC
Commits:
b68b9814 by Ben Gamari at 2023-07-07T10:16:58-04:00
compiler: Record original thunk info tables on stack
- - - - -
13 changed files:
- compiler/GHC/Cmm/CLabel.hs
- compiler/GHC/Driver/Config/StgToCmm.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/StgToCmm/Bind.hs
- compiler/GHC/StgToCmm/Config.hs
- docs/users_guide/debugging.rst
- rts/StgMiscClosures.cmm
- rts/include/rts/storage/Closures.h
- + testsuite/tests/codeGen/should_run/OrigThunkInfo.hs
- + testsuite/tests/codeGen/should_run/OrigThunkInfo.stdout
- testsuite/tests/codeGen/should_run/all.T
- utils/deriveConstants/Main.hs
Changes:
=====================================
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
=====================================
compiler/GHC/Driver/Config/StgToCmm.hs
=====================================
@@ -41,6 +41,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
=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -338,6 +338,7 @@ data GeneralFlag
| Opt_IgnoreHpcChanges
| Opt_ExcessPrecision
| Opt_EagerBlackHoling
+ | Opt_OrigThunkInfo
| Opt_NoHsMain
| Opt_SplitSections
| Opt_StgStats
@@ -576,6 +577,7 @@ codeGenFlags = EnumSet.fromList
-- Flags that affect debugging information
, Opt_DistinctConstructorTables
, Opt_InfoTableMap
+ , Opt_OrigThunkInfo
]
data WarningFlag =
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -2355,6 +2355,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,
=====================================
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
@@ -773,6 +774,47 @@ emitUpdateFrame frame lbl updatee = do
emitStore (cmmOffset platform frame off_updatee) updatee
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
--
=====================================
compiler/GHC/StgToCmm/Config.hs
=====================================
@@ -50,6 +50,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
=====================================
docs/users_guide/debugging.rst
=====================================
@@ -1115,6 +1115,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
=====================================
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
------------------------------------------------------------------------- */
=====================================
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 {
=====================================
testsuite/tests/codeGen/should_run/OrigThunkInfo.hs
=====================================
@@ -0,0 +1,4 @@
+module Main where
+xs = iterate (+1) 0
+ten = xs !! 10
+main = print ten
=====================================
testsuite/tests/codeGen/should_run/OrigThunkInfo.stdout
=====================================
@@ -0,0 +1,2 @@
+10
+
=====================================
testsuite/tests/codeGen/should_run/all.T
=====================================
@@ -225,3 +225,4 @@ test('T22296',[only_ways(llvm_ways)
,unless(arch('x86_64'), skip)],compile_and_run,[''])
test('T22798', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['-fregs-graph'])
test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds'])
+test('OrigThunkInfo', normal, compile_and_run, ['-forig-thunk-info'])
=====================================
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"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b68b981494d140bab48b523146a892217bc94c3f
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b68b981494d140bab48b523146a892217bc94c3f
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230707/c3aff8c1/attachment-0001.html>
More information about the ghc-commits
mailing list