GitLab

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

 +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);