Sebastian Graf pushed to branch wip/sg/enter-data at Glasgow Haskell Compiler / GHC Commits: 75d4e387 by Sebastian Graf at 2026-08-03T13:18:41+02:00 StgToCmm: force unknown data pointers through stg_enter_data emitEnter's Return case entered the closure unconditionally, so a pointer that is tagged already got entered anyway. It now jumps to stg_enter_data, a new RTS stub that tests the tag first. See Note [Forcing an unknown data pointer] in rts/Apply.cmm. Implements #27594, unblocks #23173. nofib imaginary+spectral is a wash: allocations unchanged, instructions +0.07% geometric mean, compile time unchanged. - - - - - 5 changed files: - + changelog.d/27594 - compiler/GHC/StgToCmm/Expr.hs - rts/Apply.cmm - rts/RtsSymbols.c - rts/include/stg/MiscClosures.h Changes: ===================================== changelog.d/27594 ===================================== @@ -0,0 +1,8 @@ +section: codegen +synopsis: Tagged data pointers are no longer entered when forced in tail position +issues: #27594 +mrs: !16445 +description: + Forcing a data pointer of statically unknown form in tail position now goes + through the new RTS stub ``stg_enter_data``, which returns the pointer if it + is tagged already. ===================================== compiler/GHC/StgToCmm/Expr.hs ===================================== @@ -36,6 +36,8 @@ import GHC.Cmm.BlockId import GHC.Cmm hiding ( succ ) import GHC.Cmm.Info import GHC.Cmm.Utils ( cmmTagMask, mkWordCLit ) +import GHC.Cmm.CLabel ( mkCmmCodeLabel ) +import GHC.Unit ( rtsUnitId ) import GHC.Platform.Tag ( mAX_PTR_TAG ) import GHC.Core import GHC.Core.DataCon @@ -1190,22 +1192,14 @@ emitEnter fun = do ; adjustHpBackwards ; sequel <- getSequel ; updfr_off <- getUpdFrameOff - ; align_check <- stgToCmmAlignCheck <$> getStgToCmmConfig ; case sequel of - -- For a return, we have the option of generating a tag-test or - -- not. If the value is tagged, we can return directly, which - -- is quicker than entering the value. This is a code - -- size/speed trade-off: when optimising for speed rather than - -- size we could generate the tag test. - -- - -- Right now, we do what the old codegen did, and omit the tag - -- test, just generating an enter. + -- For a return we jump to stg_enter_data, which returns an already + -- tagged pointer to our caller and enters an untagged one. + -- See Note [Forcing an unknown data pointer] in rts/Apply.cmm. Return -> do - { let entry = entryCode platform - $ closureInfoPtr platform align_check - $ CmmReg (nodeReg platform) - ; emit $ mkJump profile NativeNodeCall entry - [cmmUntag platform fun] updfr_off + { let enter_data = CmmLit (CmmLabel + (mkCmmCodeLabel rtsUnitId (fsLit "stg_enter_data"))) + ; emit $ mkJump profile NativeNodeCall enter_data [fun] updfr_off ; return AssignedDirectly } ===================================== rts/Apply.cmm ===================================== @@ -47,6 +47,31 @@ import CLOSURE stg_apply_interp_info; import CLOSURE stg_restore_cccs_eval_info; #endif +/* Note [Forcing an unknown data pointer] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * stg_enter_data forces a pointer to a thunk, a constructor, or an + * indirection to one, and returns the result to the caller's continuation. + * emitEnter (GHC.StgToCmm.Expr) jumps here for the pointers getCallMethod + * classifies as EnterIt: lifted ones whose type rules out functions, so + * whether they are forced already is unknown until the tag is tested. + * + * The stub is stg_ap_0_fast specialised to that domain, where its + * FUN/PAP/BCO arms are unreachable and an indirection's own entry code + * follows the indirection. What remains is the tag test and an entry jump. + * + * Whether the pointer turns out to be tagged decides which way a program moves: + * nofib imaginary+spectral is a wash overall, with primetest and exact-reals a + * percent faster and fft2 and fft a percent slower. + */ + +stg_enter_data ( P_ x ) +{ + if (GETTAG(x) != 0) { + return (x); + } + jump %GET_ENTRY(x) (x); +} + /* ---------------------------------------------------------------------------- * Evaluate a closure and return it. * ===================================== rts/RtsSymbols.c ===================================== @@ -842,6 +842,7 @@ extern char **environ; SymI_HasDataProto(stg_ap_ppppp_info) \ SymI_HasDataProto(stg_ap_pppppp_info) \ SymI_HasDataProto(stg_ap_0_fast) \ + SymI_HasDataProto(stg_enter_data) \ SymI_HasDataProto(stg_ap_v_fast) \ SymI_HasDataProto(stg_ap_f_fast) \ SymI_HasDataProto(stg_ap_d_fast) \ ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -300,6 +300,7 @@ RTS_RET(stg_ap_ppppp); RTS_RET(stg_ap_pppppp); RTS_FUN_DECL(stg_ap_0_fast); +RTS_FUN_DECL(stg_enter_data); RTS_FUN_DECL(stg_ap_v_fast); RTS_FUN_DECL(stg_ap_f_fast); RTS_FUN_DECL(stg_ap_d_fast); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/75d4e38727ee604623cc8f4889265220... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/75d4e38727ee604623cc8f4889265220... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help