[Git][ghc/ghc][wip/T24512] 4 commits: ghc-internal: Eliminate GHC.Internal.Data.Kind

Ben Gamari (@bgamari) gitlab at gitlab.haskell.org
Fri Mar 8 19:38:06 UTC 2024



Ben Gamari pushed to branch wip/T24512 at Glasgow Haskell Compiler / GHC


Commits:
50454a29 by Ben Gamari at 2024-03-08T03:32:42-05:00
ghc-internal: Eliminate GHC.Internal.Data.Kind

This was simply reexporting things from `ghc-prim`. Instead reexport
these directly from `Data.Kind`. Also add build ordering dependency to
work around #23942.

- - - - -
38a4b6ab by Ben Gamari at 2024-03-08T03:33:18-05:00
rts: Fix SET_HDR initialization of retainer set

This fixes a regression in retainer set profiling introduced by
b0293f78cb6acf2540389e22bdda420d0ab874da. Prior to that commit
the heap traversal word would be initialized by `SET_HDR` using
`LDV_RECORD_CREATE`. However, the commit added a `doingLDVProfiling`
check in `LDV_RECORD_CREATE`, meaning that this initialization no longer
happened.

Given that this initialization was awkwardly indirectly anyways, I have
fixed this by explicitly initializating the heap traversal word to
`NULL` in `SET_PROF_HDR`. This is equivalent to the previous behavior,
but much more direct.

Fixes #24513.

- - - - -
dbb0be97 by Ben Gamari at 2024-03-08T14:37:41-05:00
rts/linker: Don't unload code when profiling is enabled

The heap census may contain references (e.g. `Counter.identity`) to
static data which must be available when the census is reported at the
end of execution.

Fixes #24512.

- - - - -
0c6dc060 by Ben Gamari at 2024-03-08T14:37:59-05:00
rts/linker: Don't unload native objects when dlinfo isn't available

To do so is unsafe as we have no way of identifying references to
symbols provided by the object.

Fixes #24513. Fixes #23993.

- - - - -


11 changed files:

- libraries/base/src/Data/Kind.hs
- libraries/ghc-internal/ghc-internal.cabal
- rts/CheckUnload.c
- rts/Linker.c
- rts/LinkerInternals.h
- rts/include/rts/storage/ClosureMacros.h
- rts/linker/Elf.c
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32


Changes:

=====================================
libraries/base/src/Data/Kind.hs
=====================================
@@ -1,4 +1,4 @@
-{-# LANGUAGE Safe #-}
+{-# LANGUAGE Trustworthy #-}
 
 -- |
 --
@@ -19,4 +19,6 @@ module Data.Kind
      FUN
      ) where
 
-import GHC.Internal.Data.Kind
\ No newline at end of file
+import GHC.Num.BigNat () -- for build ordering (#23942)
+import GHC.Prim (FUN)
+import GHC.Types (Type, Constraint)


=====================================
libraries/ghc-internal/ghc-internal.cabal
=====================================
@@ -120,7 +120,6 @@ Library
         GHC.Internal.Data.Functor.Utils
         GHC.Internal.Data.IORef
         GHC.Internal.Data.Ix
-        GHC.Internal.Data.Kind
         GHC.Internal.Data.List
         GHC.Internal.Data.Maybe
         GHC.Internal.Data.Monoid


=====================================
rts/CheckUnload.c
=====================================
@@ -165,6 +165,18 @@ ObjectCode *loaded_objects;
 // map static closures to their ObjectCode.
 static OCSectionIndices *global_s_indices = NULL;
 
+// Is it safe for us to unload code?
+static bool safeToUnload(void)
+{
+    if (RtsFlags.ProfFlags.doHeapProfile != NO_HEAP_PROFILING) {
+        // We mustn't unload anything as the heap census may contain
+        // references into static data (e.g. cost centre names).
+        // See #24512.
+        return false;
+    }
+    return true;
+}
+
 static OCSectionIndices *createOCSectionIndices(void)
 {
     // TODO (osa): Maybe initialize as empty (without allocation) and allocate
@@ -457,6 +469,8 @@ void checkUnload(void)
 {
     if (global_s_indices == NULL) {
         return;
+    } else if (!safeToUnload()) {
+        return;
     }
 
     // At this point we've marked all dynamically loaded static objects
@@ -478,8 +492,6 @@ void checkUnload(void)
         next = oc->next;
         ASSERT(oc->status == OBJECT_UNLOADED);
 
-        removeOCSectionIndices(s_indices, oc);
-
         // Symbols should be removed by unloadObj_.
         // NB (osa): If this assertion doesn't hold then freeObjectCode below
         // will corrupt symhash as keys of that table live in ObjectCodes. If
@@ -487,8 +499,17 @@ void checkUnload(void)
         // RTS) then it's probably because this assertion did not hold.
         ASSERT(oc->symbols == NULL);
 
-        freeObjectCode(oc);
-        n_unloaded_objects -= 1;
+        if (oc->unloadable) {
+            removeOCSectionIndices(s_indices, oc);
+            freeObjectCode(oc);
+            n_unloaded_objects -= 1;
+        } else {
+            // If we don't have enough information to
+            // accurately determine the reachability of
+            // the object then hold onto it.
+            oc->next = objects;
+            objects = oc;
+        }
     }
 
     old_objects = NULL;


=====================================
rts/Linker.c
=====================================
@@ -1385,6 +1385,7 @@ mkOc( ObjectType type, pathchar *path, char *image, int imageSize,
    oc->prev              = NULL;
    oc->next_loaded_object = NULL;
    oc->mark              = object_code_mark_bit;
+   oc->unloadable        = false;
    oc->dependencies      = allocHashSet();
 
 #if defined(NEED_M32)
@@ -1527,6 +1528,12 @@ preloadObjectFile (pathchar *path)
    /* FIXME (AP): =mapped= parameter unconditionally set to true */
    oc = mkOc(STATIC_OBJECT, path, image, fileSize, true, NULL, misalignment);
 
+   /* assume that static objects are safely unloadable since
+    * we have know of all references to symbols provided by
+    * the object. These are tracked by lookupDependentSymbol.
+    */
+   oc->unloadable = true;
+
 #if defined(OBJFORMAT_MACHO)
    if (ocVerifyImage_MachO( oc ))
        ocInit_MachO( oc );


=====================================
rts/LinkerInternals.h
=====================================
@@ -313,8 +313,14 @@ struct _ObjectCode {
     struct _ObjectCode *next_loaded_object;
 
     // Mark bit
+    // N.B. This is a full word as we CAS it.
     StgWord mark;
 
+    // Can this object be safely unloaded? Not true for
+    // dynamic objects when dlinfo is not available as
+    // we cannot determine liveness.
+    bool unloadable;
+
     // Set of dependencies (ObjectCode*) of the object file. Traverse
     // dependencies using `iterHashTable`.
     //
@@ -376,7 +382,9 @@ struct _ObjectCode {
     /* handle returned from dlopen */
     void *dlopen_handle;
 
-    /* virtual memory ranges of loaded code */
+    /* virtual memory ranges of loaded code. NULL if no range information is
+     * available (e.g. if dlinfo is unavailable on the current platform).
+     */
     NativeCodeRange *nc_ranges;
 };
 


=====================================
rts/include/rts/storage/ClosureMacros.h
=====================================
@@ -147,17 +147,10 @@ EXTERN_INLINE StgHalfWord GET_TAG(const StgClosure *con)
 #if defined(PROFILING)
 /*
   The following macro works for both retainer profiling and LDV profiling. For
- retainer profiling, 'era' remains 0, so by setting the 'ldvw' field we also set
- 'rs' to zero.
-
- Note that we don't have to bother handling the 'flip' bit properly[1] since the
- retainer profiling code will just set 'rs' to NULL upon visiting a closure with
- an invalid 'flip' bit anyways.
-
- See Note [Profiling heap traversal visited bit] for details.
-
- [1]: Technically we should set 'rs' to `NULL | flip`.
+ retainer profiling, we set 'trav' to 0, which is an invalid
+ RetainerSet.
  */
+
 /*
   MP: Various other places use the check era > 0 to check whether LDV profiling
   is enabled. The use of these predicates here is the reason for including RtsFlags.h in
@@ -168,17 +161,14 @@ EXTERN_INLINE StgHalfWord GET_TAG(const StgClosure *con)
 */
 #define SET_PROF_HDR(c, ccs_) \
   { \
-  (c)->header.prof.ccs = ccs_; \
-  if (doingLDVProfiling()) { \
-    LDV_RECORD_CREATE((c)); \
-  } \
-\
-  if (doingRetainerProfiling()) { \
-    LDV_RECORD_CREATE((c)); \
-  }; \
-  if (doingErasProfiling()){ \
-    ERA_RECORD_CREATE((c)); \
-  }; \
+    (c)->header.prof.ccs = ccs_; \
+    if (doingLDVProfiling()) { \
+      LDV_RECORD_CREATE((c)); \
+    } else if (doingRetainerProfiling()) { \
+      (c)->header.prof.hp.trav = 0; \
+    } else if (doingErasProfiling()){ \
+      ERA_RECORD_CREATE((c)); \
+    } \
   }
 
 #else


=====================================
rts/linker/Elf.c
=====================================
@@ -2190,6 +2190,10 @@ void * loadNativeObj_ELF (pathchar *path, char **errmsg)
      copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj");
      goto dl_iterate_phdr_fail;
    }
+   nc->unloadable = true;
+#else
+   nc->nc_ranges = NULL;
+   nc->unloadable = false;
 #endif /* defined (HAVE_DLINFO) */
 
    insertOCSectionIndices(nc);


=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -1276,7 +1276,7 @@ module Data.Ix where
     {-# MINIMAL range, (index | GHC.Internal.Ix.unsafeIndex), inRange #-}
 
 module Data.Kind where
-  -- Safety: Safe
+  -- Safety: Trustworthy
   type Constraint :: *
   type Constraint = GHC.Prim.CONSTRAINT GHC.Types.LiftedRep
   type role FUN nominal representational representational


=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -1276,7 +1276,7 @@ module Data.Ix where
     {-# MINIMAL range, (index | GHC.Internal.Ix.unsafeIndex), inRange #-}
 
 module Data.Kind where
-  -- Safety: Safe
+  -- Safety: Trustworthy
   type Constraint :: *
   type Constraint = GHC.Prim.CONSTRAINT GHC.Types.LiftedRep
   type role FUN nominal representational representational


=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -1276,7 +1276,7 @@ module Data.Ix where
     {-# MINIMAL range, (index | GHC.Internal.Ix.unsafeIndex), inRange #-}
 
 module Data.Kind where
-  -- Safety: Safe
+  -- Safety: Trustworthy
   type Constraint :: *
   type Constraint = GHC.Prim.CONSTRAINT GHC.Types.LiftedRep
   type role FUN nominal representational representational


=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -1276,7 +1276,7 @@ module Data.Ix where
     {-# MINIMAL range, (index | GHC.Internal.Ix.unsafeIndex), inRange #-}
 
 module Data.Kind where
-  -- Safety: Safe
+  -- Safety: Trustworthy
   type Constraint :: *
   type Constraint = GHC.Prim.CONSTRAINT GHC.Types.LiftedRep
   type role FUN nominal representational representational



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7d3edc79eb17250515550344f3d75cf897eae880...0c6dc060c39a14e4eb4679aab655c2bcd32a87df

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7d3edc79eb17250515550344f3d75cf897eae880...0c6dc060c39a14e4eb4679aab655c2bcd32a87df
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/20240308/e90730b0/attachment-0001.html>


More information about the ghc-commits mailing list