Sebastian Graf pushed to branch wip/sg/enter-data at Glasgow Haskell Compiler / GHC Commits: add5a749 by Sebastian Graf at 2026-08-05T09:35:16+02:00 StgToCmm: force lifted data through stg_enter_data emitEnter's Return case entered the closure unconditionally, so a thunk that had been evaluated already got entered anyway. It now jumps to stg_enter_data, a new RTS stub that tests the tag first and returns the pointer when it is set. See Note [Forcing lifted data] in GHC.StgToCmm.Expr. 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,10 @@ +section: codegen +synopsis: Returning lifted, already evaluated data no longer enters its closure +issues: #27594 +mrs: !16445 +description: + In ``f (Just x) = x``, GHC must evaluate ``x`` before returning it, and used + to do so by entering ``x``'s closure unconditionally. It now tests ``x``'s + pointer tag first and returns ``x`` directly when it is evaluated already, + entering the closure only otherwise. Scrutinising a value, as in + ``case x of ...``, has always tested the tag this way. ===================================== 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 @@ -1183,6 +1185,47 @@ cgIdApp fun_id args = do -- DynFlags, then passed to StgToCmmConfig for this phase. +{- Note [Forcing lifted data] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + + f :: Maybe Bool -> Bool + f (Just x) = x + +After `f` pattern-matches on the `Just` it must then evaluate `x` and +return it to the caller. It could do so by unconditionally entering the +code in x's closure, but we don't want to do so for two reasons: + +* If the RHS had been `case x of (a,b) -> blah`, GHC generates an inline test + for EPT; for non-tagged pointers, it then pushes a return address and + enters it (see the AssignTo case of emitEnter, below). It would be + consistent to do the same for tail calls too. + +* Finally, if we adopt the design described in #23173, if x is untagged, its + entry code might warn or panic. In that case we definitely should not to enter + it. + +Where are these decisions taken? getCallMethod (GHC.StgToCmm.Closure) +classifies the application and cgIdApp dispatches on the result. +Since `Bool` is not a function type and `x` is not statically EPT +(See Note [EPT enforcement]), we land in the EnterIt case under a Return +sequel. In that case, emitEnter emits a jump to the RTS stub stg_enter_data +(rts/Apply.cmm), which tests the tag, returns the pointer if it is set and +enters the closure otherwise. + +Why a stub here, when the AssignTo case inlines it? There the continuation is +a known address that the code can directly jump to. If we were creating a stub +as well, it would become a register-indirect jump that would be difficult to +predict by the CPU. +Under Return, the continuation's address is unknown, so inlining the stub has +no specialisation effect, yet incur more code to generate and place in +potentially tight loops. +That costs 2.6% more compiler allocation on eval-heavy T13960 and about 19 bytes +per site, while nofib stays within +-0.2% runtime either way. + +See #27594. +-} + emitEnter :: CmmExpr -> FCode ReturnKind emitEnter fun = do { platform <- getPlatform @@ -1190,22 +1233,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 lifted data] 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,21 @@ import CLOSURE stg_apply_interp_info; import CLOSURE stg_restore_cccs_eval_info; #endif +/* Force a lifted closure whose type rules out functions: return it if it is already + * tagged, enter it otherwise. The code generator jumps here to evaluate + * lifted data in tail position; see Note [Forcing lifted data] in + * GHC.StgToCmm.Expr for why. + * NB: Function-typed closures must go through the more general stg_ap_0_fast. + */ + +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/add5a749088a82191bad32524242aab8... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/add5a749088a82191bad32524242aab8... 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