[Git][ghc/ghc][wip/orig-thunk-info] Refactor

[Ben Gamari (@bgamari)]

Ben Gamari pushed to branch wip/orig-thunk-info at Glasgow Haskell Compiler / GHC


Commits:
fd91d387 by Ben Gamari at 2023-04-12T15:54:30-04:00
Refactor

- - - - -


2 changed files:

- compiler/GHC/StgToCmm/Bind.hs
- docs/users_guide/debugging.rst


Changes:

=====================================
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,32 +756,11 @@ pushUpdateFrame lbl updatee body
   = do
        updfr  <- getUpdFrameOff
        profile <- getProfile
-       cfg <- getStgToCmmConfig
-       let push_orig_thunk_info = stgToCmmOrigThunkInfo cfg
-           hdr         = fixedHdrSize profile
-           orig_info_frame_sz
-             | push_orig_thunk_info
-                              = hdr + pc_SIZEOF_StgOrigThunkInfoFrame_NoHdr (profileConstants profile)
-             | otherwise      = 0
-           frame1      = updfr + hdr + pc_SIZEOF_StgUpdateFrame_NoHdr (profileConstants profile)
-           frame2      = frame1 + orig_info_frame_sz
+       let hdr         = fixedHdrSize profile
+           frame       = updfr + hdr + pc_SIZEOF_StgUpdateFrame_NoHdr (profileConstants profile)
        --
-       emitUpdateFrame (CmmStackSlot Old frame1) lbl updatee
-       when push_orig_thunk_info $
-           emitOrigThunkInfoFrame (CmmStackSlot Old frame2) updatee
-       withUpdFrameOff frame2 body
-
-emitOrigThunkInfoFrame :: CmmExpr -> CmmExpr -> FCode ()
-emitOrigThunkInfoFrame frame updatee = do
-  profile <- getProfile
-  cfg <- getStgToCmmConfig
-  let platform      = profilePlatform profile
-      hdr           = fixedHdrSize profile
-      off_orig_info = hdr + pc_OFFSET_StgOrigThunkInfoFrame_info_ptr (profileConstants profile)
-      align_check   = stgToCmmAlignCheck cfg
-      info_ptr      = closureInfoPtr platform align_check updatee
-  emitStore frame (mkLblExpr mkOrigThunkInfoLabel)
-  emitStore (cmmOffset platform frame off_orig_info) info_ptr
+       emitUpdateFrame (CmmStackSlot Old frame) lbl updatee
+       withUpdFrameOff frame body
 
 emitUpdateFrame :: CmmExpr -> CLabel -> CmmExpr -> FCode ()
 emitUpdateFrame frame lbl updatee = do
@@ -793,6 +774,34 @@ emitUpdateFrame frame lbl updatee = do
   emitStore (cmmOffset platform frame off_updatee) updatee
   initUpdFrameProf frame
 
+-----------------------------------------------------------------------------
+-- Original thunk info table frames
+--
+-- Support for -forig-thunk-info
+
+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
 --


=====================================
docs/users_guide/debugging.rst
=====================================
@@ -1072,6 +1072,17 @@ 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.
+
 .. ghc-flag:: -fcheck-prim-bounds
     :shortdesc: Instrument array primops with bounds checks.
     :type: dynamic



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fd91d3872914e8a813b08032ec4241114b0b0f35

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fd91d3872914e8a813b08032ec4241114b0b0f35
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/20230412/0e75a551/attachment-0001.html>