GitLab

David Eichmann pushed to branch wip/davide/windows-dlls at Glasgow Haskell Compiler / GHC

Commits:

8ad3341a
by David Eichmann at 2026-05-14T17:19:15+01:00
```
WIP static CAFs
```

2 changed files:

compiler/GHC/Cmm/Info/Build.hs
compiler/GHC/StgToCmm/Bind.hs

Changes:

@@ -1295,15 +1295,17 @@ updInfoSRTs profile srt_env funSRTEnv caffy (CmmProc top_info top_l live g)
        | l == g_entry g, Just (inf, _) <- maybeStaticClosure = inf
        | otherwise  = info_tbl { cit_srt = mapLookup l srt_env }
 -    -- Generate static closures [FUN].  Note that this also generates
 -    -- static closures for thunks (CAFs), because it's easier to treat
 -    -- them uniformly in the code generator.
 +    -- Generate static closures [FUN].  CAF thunks are excluded: they are
 +    -- treated as dynamic closures and have their closure data emitted in
 +    -- GHC.StgToCmm.Bind.cgTopRhsClosure; the cit_clo guard below is
 +    -- sufficient to rule them out since dynamic thunks have cit_clo=Nothing.
      maybeStaticClosure :: Maybe (CmmInfoTable, CmmDeclSRTs)
      maybeStaticClosure
        | Just info_tbl@CmmInfoTable{..} <-
             mapLookup (g_entry g) (info_tbls top_info)
        , Just (id, ccs) <- cit_clo
 -      , isStaticRep cit_rep =
 +      , isStaticRep cit_rep
 +      , not (isThunkRep cit_rep) =
          let
            (newInfo, srtEntries) = case mapLookup (g_entry g) funSRTEnv of
              Nothing ->

compiler/GHC/StgToCmm/Bind.hs

@@ -129,17 +129,24 @@ cgTopRhsClosure platform rec id ccs upd_flag args body =
           emitDecl $ CmmData (Section Data closure_label) $
               CmmStatics closure_label info ccs [] [lit]
 -  gen_code lf_info _closure_label
 +  gen_code lf_info closure_label
     = do { profile <- getProfile
          ; let name = idName id
          ; mod_name <- getModuleName
          ; let descr         = closureDescription mod_name name
 -              closure_info  = mkClosureInfo profile True id lf_info 0 0 descr
+-
 -        -- We don't generate the static closure here, because we might
 -        -- want to add references to static closures to it later.  The
 -        -- static closure is generated by GHC.Cmm.Info.Build.updInfoSRTs,
 -        -- See Note [SRTs], specifically the [FUN] optimisation.
 +              -- CAFs (top-level updatable thunks with no arguments) are treated
 +              -- as dynamic closures: they use heap-style thunk update semantics
 +              -- and do not call newCAF/link_caf.
 +              is_caf        = isLFThunk lf_info && lfUpdatable lf_info
 +              closure_info  = mkClosureInfo profile (not is_caf) id lf_info 0 0 descr
++
 +        -- We don't generate the static closure here for non-CAF top-level
 +        -- closures, because we might want to add references to static closures
 +        -- to it later.  The static closure is generated by
 +        -- GHC.Cmm.Info.Build.updInfoSRTs, See Note [SRTs], specifically the
 +        -- [FUN] optimisation.
 +        -- For CAFs we generate the closure data immediately: they are dynamic
 +        -- (heap-style thunks) so maybeStaticClosure will not pick them up.
          ; let fv_details :: [(NonVoid Id, ByteOff)]
                header = if isLFThunk lf_info then ThunkHeader else StdHeader
@@ -148,6 +155,10 @@ cgTopRhsClosure platform rec id ccs upd_flag args body =
          ; forkClosureBody (closureCodeBody True id closure_info ccs
                                  args body fv_details)
 +        ; when is_caf $
 +            emitDecl $ CmmData (Section Data closure_label) $
 +                CmmStatics closure_label (mkCmmInfo closure_info id ccs) ccs [] []
++
          ; return () }
    unLit (CmmLit l) = l