[Git][ghc/ghc][wip/ghc-9.10] 6 commits: rts/linker: Don't unload code when profiling is enabled

Ben Gamari (@bgamari) gitlab at gitlab.haskell.org
Tue Mar 12 14:16:55 UTC 2024



Ben Gamari pushed to branch wip/ghc-9.10 at Glasgow Haskell Compiler / GHC


Commits:
09d92280 by Ben Gamari at 2024-03-12T10:14:28-04: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.

- - - - -
a27a477d by Ben Gamari at 2024-03-12T10:14:28-04: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.

- - - - -
63928aeb by Ben Gamari at 2024-03-12T10:14:28-04:00
rel_eng/upload: Purge both $rel_name/ and $ver/

This is necessary for prereleases, where GHCup accesses the release via
`$ver/`

- - - - -
2e713fdb by Ben Gamari at 2024-03-12T10:14:28-04:00
gitlab-ci: Allow test-primops to fail

It's still a bit sensitive to warnings, unfortunately.

- - - - -
66c51e75 by Ben Gamari at 2024-03-12T10:14:28-04:00
hadrian: Package mingw toolchain in expected location

This fixes #24525, a regression due to 41cbaf44a6ab5eb9fa676d65d32df8377898dc89.
Specifically, GHC expects to find the mingw32 toolchain in the binary distribution
root. However, after this patch it was packaged in the `lib/` directory.

- - - - -
d574a10d by Ben Gamari at 2024-03-12T10:14:28-04:00
hadrian/bindist: Eliminate extraneous `dirname` invocation

Previously we would call `dirname` twice per installed library file.
We now instead reuse this result. This helps appreciably on Windows, where
processes are quite expensive.

- - - - -


9 changed files:

- .gitlab-ci.yml
- .gitlab/rel_eng/upload.sh
- hadrian/bindist/Makefile
- hadrian/src/Rules/BinaryDist.hs
- rts/CheckUnload.c
- rts/Linker.c
- rts/LinkerInternals.h
- rts/linker/Elf.c
- testsuite/tests/rts/linker/unload_multiple_objs/linker_unload_multiple_objs.c


Changes:

=====================================
.gitlab-ci.yml
=====================================
@@ -899,6 +899,7 @@ test-primops-nightly:
 
 test-primops-release:
   extends: .test-primops
+  allow_failure: true
   rules:
     - if: '$RELEASE_JOB == "yes"'
 


=====================================
.gitlab/rel_eng/upload.sh
=====================================
@@ -136,7 +136,7 @@ function upload() {
 }
 
 function purge_all() {
-    dir="$(echo $rel_name | sed s/-release//)"
+    local dir="$(echo $rel_name | sed s/-release//)"
     # Purge CDN cache
     curl -X PURGE http://downloads.haskell.org/ghc/
     curl -X PURGE http://downloads.haskell.org/~ghc/
@@ -150,12 +150,18 @@ function purge_all() {
 }
 
 function purge_file() {
-    curl -X PURGE http://downloads.haskell.org/~ghc/$rel_name/$i
-    curl -X PURGE http://downloads.haskell.org/~ghc/$rel_name/$i/
-    curl -X PURGE http://downloads.haskell.org/~ghc/$rel_name/$i/docs/
-    curl -X PURGE http://downloads.haskell.org/ghc/$rel_name/$i
-    curl -X PURGE http://downloads.haskell.org/ghc/$rel_name/$i/
-    curl -X PURGE http://downloads.haskell.org/ghc/$rel_name/$i/docs/
+    dirs=(
+        "~ghc/$rel_name"
+        "ghc/$rel_name"
+        "~ghc/$ver"
+        "ghc/$ver"
+    )
+
+    for dir in ${dirs[@]}; do
+        curl -X PURGE http://downloads.haskell.org/$dir/$i
+        curl -X PURGE http://downloads.haskell.org/$dir/$i/
+        curl -X PURGE http://downloads.haskell.org/$dir/$i/docs/
+    done
 }
 
 function prepare_docs() {


=====================================
hadrian/bindist/Makefile
=====================================
@@ -175,18 +175,19 @@ install_lib: lib/settings
 	@dest="$(DESTDIR)$(ActualLibsDir)"; \
 	cd lib; \
 	for i in `$(FIND) . -type f`; do \
-		$(INSTALL_DIR) "$$dest/`dirname $$i`" ; \
+		dir="`dirname $$i`" ; \
+		$(INSTALL_DIR) "$$dest/$$dir" ; \
 		case $$i in \
 		  *.a) \
-		    $(INSTALL_DATA) $$i "$$dest/`dirname $$i`" ; \
+		    $(INSTALL_DATA) $$i "$$dest/$$dir" ; \
 		    $(RANLIB_CMD) "$$dest"/$$i ;; \
 		  *.dll) \
-		    $(INSTALL_PROGRAM) $$i "$$dest/`dirname $$i`" ; \
+		    $(INSTALL_PROGRAM) $$i "$$dest/$$dir" ; \
 		    $(STRIP_CMD) "$$dest"/$$i ;; \
 		  *.so) \
-		    $(INSTALL_SHLIB) $$i "$$dest/`dirname $$i`" ;; \
+		    $(INSTALL_SHLIB) $$i "$$dest/$$dir" ;; \
 		  *.dylib) \
-		    $(INSTALL_SHLIB) $$i "$$dest/`dirname $$i`" ;; \
+		    $(INSTALL_SHLIB) $$i "$$dest/$$dir" ;; \
 		  *.mjs) \
 		    $(INSTALL_SCRIPT) $$i "$$dest/`dirname $$i`" ;; \
 		  *) \


=====================================
hadrian/src/Rules/BinaryDist.hs
=====================================
@@ -135,7 +135,8 @@ bindistRules = do
         let ghcVersionPretty = "ghc-" ++ version ++ "-" ++ targetPlatform
         let prefix = cwd -/- root -/- "reloc-bindist" -/- ghcVersionPretty
         installTo Relocatable prefix
-
+        copyDirectory (root -/- "mingw") prefix
+        liftIO $ IO.removeDirectoryRecursive (prefix -/- "lib" -/- "mingw")
 
     phony "install" $ do
         need ["binary-dist-dir"]
@@ -145,8 +146,6 @@ bindistRules = do
         installTo NotRelocatable installPrefix
 
     phony "binary-dist-dir" $ do
-
-
         version        <- setting ProjectVersion
         targetPlatform <- setting TargetPlatformFull
         distDir        <- Context.distDir Stage1
@@ -309,7 +308,7 @@ bindistRules = do
 
     let buildBinDist compressor = do
           win_target <- isWinTarget
-          when win_target (error "normal binary-dist does not work for windows target, use `reloc-binary-dist-*` target instead.")
+          when win_target (error "normal binary-dist does not work for Windows targets, use `reloc-binary-dist-*` target instead.")
           buildBinDistX "binary-dist-dir" "bindist" compressor
         buildBinDistReloc = buildBinDistX "reloc-binary-dist-dir" "reloc-bindist"
 


=====================================
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,8 @@ mkOc( ObjectType type, pathchar *path, char *image, int imageSize,
    oc->prev              = NULL;
    oc->next_loaded_object = NULL;
    oc->mark              = object_code_mark_bit;
+   /* this will get cleared by the caller if object is not safely unloadable */
+   oc->unloadable        = true;
    oc->dependencies      = allocHashSet();
 
 #if defined(NEED_M32)


=====================================
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/linker/Elf.c
=====================================
@@ -2186,6 +2186,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/rts/linker/unload_multiple_objs/linker_unload_multiple_objs.c
=====================================
@@ -64,7 +64,7 @@ void check_object_freed(char *obj_path) {
     OStatus st;
     st = getObjectLoadStatus(toPathchar(obj_path));
     if (st != OBJECT_NOT_LOADED) {
-        errorBelch("object %s status != OBJECT_NOT_LOADED", obj_path);
+        errorBelch("object %s status != OBJECT_NOT_LOADED, is %d instead", obj_path, st);
         exit(1);
     }
 }



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/563fa0fd6d25b6187e763832adaae2659fe1f52e...d574a10dc96681f0aecccbbb218b9a4e11f511b8

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/563fa0fd6d25b6187e763832adaae2659fe1f52e...d574a10dc96681f0aecccbbb218b9a4e11f511b8
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/20240312/f6235585/attachment-0001.html>


More information about the ghc-commits mailing list