[Git][ghc/ghc][wip/orig-thunk-info] compiler: Record original thunk info tables on stack
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Wed Apr 12 16:03:11 UTC 2023
Ben Gamari pushed to branch wip/orig-thunk-info at Glasgow Haskell Compiler / GHC
Commits:
21ccc687 by Ben Gamari at 2023-04-12T12:03:04-04:00
compiler: Record original thunk info tables on stack
- - - - -
5 changed files:
- compiler/GHC/Cmm/CLabel.hs
- compiler/GHC/StgToCmm/Bind.hs
- rts/StgMiscClosures.cmm
- rts/include/rts/storage/Closures.h
- 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/StgToCmm/Bind.hs
=====================================
@@ -754,12 +754,33 @@ pushUpdateFrame lbl updatee body
= do
updfr <- getUpdFrameOff
profile <- getProfile
- let
+ let platform = profilePlatform profile
+
+ let push_orig_thunk_info = True
hdr = fixedHdrSize profile
- frame = updfr + hdr + pc_SIZEOF_StgUpdateFrame_NoHdr (profileConstants 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
--
- emitUpdateFrame (CmmStackSlot Old frame) lbl updatee
- withUpdFrameOff frame body
+ 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_orig_info (profileConstants profile)
+ align_check = stgToCmmAlignCheck cfg
+ info_ptr = cmmLoadBWord platform (closureInfoPtr platform align_check updatee)
+ emitStore frame (mkLblExpr mkOrigThunkInfoLabel)
+ emitStore (cmmOffset platform frame off_orig_info) info_ptr
+ initUpdFrameProf frame
emitUpdateFrame :: CmmExpr -> CLabel -> CmmExpr -> FCode ()
emitUpdateFrame frame lbl updatee = do
=====================================
rts/StgMiscClosures.cmm
=====================================
@@ -45,6 +45,16 @@ import CLOSURE stg_ret_t_info;
import CLOSURE stg_ret_v_info;
#endif
+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 {
=====================================
utils/deriveConstants/Main.hs
=====================================
@@ -438,6 +438,7 @@ wanteds os = concat
,structField Both "StgEntCounter" "entry_count"
,closureSize Both "StgUpdateFrame"
+ ,closureSize Both "StgOrigThunkInfoFrame"
,closureSize C "StgCatchFrame"
,closureSize C "StgStopFrame"
,closureSize C "StgDeadThreadFrame"
@@ -480,6 +481,7 @@ wanteds os = concat
,structSize C "StgTSOProfInfo"
,closureField Both "StgUpdateFrame" "updatee"
+ ,closureField Both "StgOrigThunkInfoFrame" "orig_info"
,closureField C "StgCatchFrame" "handler"
,closureField C "StgCatchFrame" "exceptions_blocked"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/21ccc687996f0f8e6ff504644ad2339adba886af
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/21ccc687996f0f8e6ff504644ad2339adba886af
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/b6285801/attachment-0001.html>
More information about the ghc-commits
mailing list