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

Ben Gamari (@bgamari) gitlab at gitlab.haskell.org
Fri Mar 8 13:30:33 UTC 2024



Ben Gamari pushed to branch wip/ghc-9.10 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.

- - - - -
59d808d6 by Ben Gamari at 2024-03-08T08:27:26-05:00
ci-images: Bump Alpine image to bootstrap with 9.8.2

- - - - -
d3f91b30 by Ben Gamari at 2024-03-08T08:27:35-05:00
testsuite: Mark T24171 as fragile due to #24512

I will fix this but not in time for 9.10.1-alpha1

- - - - -
10a1be48 by Cheng Shao at 2024-03-08T08:27:48-05:00
testsuite: drop exe extension from .hp & .prof filenames

See #24515 for details.

(cherry picked from commit 44922e4f735c8f3c3fa06e6b59d43ebaba9fa3c7)

- - - - -
5ebdf90a by Ben Gamari at 2024-03-08T08:27:54-05:00
rts: Drop .wasm suffix from .prof file names

This replicates the behavior on Windows, where `Hi.exe` will produce
profiling output named `Hi.prof` instead of `Hi.exe.prof`.

While in the area I also fixed the extension-stripping logic, which
incorrectly rewrote `Hi.exefoo` to `Hi.foo`.

Closes #24515.

(cherry picked from commit 9662651af3e5d24ae4e0bd275bdee1e718954c0b)

- - - - -
1da0bdcb by Ben Gamari at 2024-03-08T08:28:58-05:00
testsuite: Mark linker_unload_native as fragile

In particular this fails on platforms without `dlinfo`. I plan to
address this but not before 9.10.1-alpha1.

- - - - -


15 changed files:

- .gitlab-ci.yml
- libraries/base/src/Data/Kind.hs
- libraries/ghc-internal/ghc-internal.cabal
- rts/ProfHeap.c
- rts/Profiling.c
- rts/RtsUtils.c
- rts/RtsUtils.h
- rts/include/rts/storage/ClosureMacros.h
- testsuite/driver/testlib.py
- 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
- testsuite/tests/rts/linker/T24171/all.T
- testsuite/tests/rts/linker/all.T


Changes:

=====================================
.gitlab-ci.yml
=====================================
@@ -2,7 +2,7 @@ variables:
   GIT_SSL_NO_VERIFY: "1"
 
   # Commit of ghc/ci-images repository from which to pull Docker images
-  DOCKER_REV: 7f63b34ac87b85470eef9c668e9528e8e2f5b46a
+  DOCKER_REV: a9297a370025101b479cfd4977f8f910814e03ab
 
   # Sequential version number of all cached things.
   # Bump to invalidate GitLab CI cache.


=====================================
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/ProfHeap.c
=====================================
@@ -448,18 +448,14 @@ initHeapProfiling(void)
         stem = stgMallocBytes(strlen(RtsFlags.CcFlags.outputFileNameStem) + 1, "initHeapProfiling");
         strcpy(stem, RtsFlags.CcFlags.outputFileNameStem);
     } else {
-
         stem = stgMallocBytes(strlen(prog_name) + 1, "initHeapProfiling");
         strcpy(stem, prog_name);
+
+        // Drop the platform's executable suffix if there is one
 #if defined(mingw32_HOST_OS)
-            // on Windows, drop the .exe suffix if there is one
-            {
-                char *suff;
-                suff = strrchr(stem,'.');
-                if (suff != NULL && !strcmp(suff,".exe")) {
-                    *suff = '\0';
-                }
-            }
+        dropExtension(stem, ".exe");
+#elif defined(wasm32_HOST_ARCH)
+        dropExtension(stem, ".wasm");
 #endif
     }
 


=====================================
rts/Profiling.c
=====================================
@@ -245,19 +245,14 @@ initProfilingLogFile(void)
     if (RtsFlags.CcFlags.outputFileNameStem) {
         stem = RtsFlags.CcFlags.outputFileNameStem;
     } else {
-        char *prog;
-
-        prog = arenaAlloc(prof_arena, strlen(prog_name) + 1);
+        char *prog = arenaAlloc(prof_arena, strlen(prog_name) + 1);
         strcpy(prog, prog_name);
+
+        // Drop the platform's executable suffix if there is one
 #if defined(mingw32_HOST_OS)
-        // on Windows, drop the .exe suffix if there is one
-        {
-            char *suff;
-            suff = strrchr(prog,'.');
-            if (suff != NULL && !strcmp(suff,".exe")) {
-                *suff = '\0';
-            }
-        }
+        dropExtension(prog, ".exe");
+#elif defined(wasm32_HOST_ARCH)
+        dropExtension(prog, ".wasm");
 #endif
         stem = prog;
     }


=====================================
rts/RtsUtils.c
=====================================
@@ -456,3 +456,15 @@ void checkFPUStack(void)
     }
 #endif
 }
+
+// Drop the given extension from a filepath.
+void dropExtension(char *path, const char *extension) {
+    int ext_len = strlen(extension);
+    int path_len = strlen(path);
+    if (ext_len < path_len) {
+        char *s = &path[path_len - ext_len];
+        if (strcmp(s, extension) == 0) {
+            *s = '\0';
+        }
+    }
+}


=====================================
rts/RtsUtils.h
=====================================
@@ -62,4 +62,7 @@ void checkFPUStack(void);
 #define xstr(s) str(s)
 #define str(s) #s
 
+// Drop the given extension from a filepath.
+void dropExtension(char *path, const char *extension);
+
 #include "EndPrivate.h"


=====================================
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


=====================================
testsuite/driver/testlib.py
=====================================
@@ -2329,14 +2329,13 @@ def write_file(f: Path, s: str) -> None:
 
 async def check_hp_ok(name: TestName) -> bool:
     opts = getTestOpts()
-    actual_name = name + exe_extension() if not opts.ignore_extension else name
 
     # do not qualify for hp2ps because we should be in the right directory
-    hp2psCmd = 'cd "{opts.testdir}" && {{hp2ps}} {actual_name}'.format(**locals())
+    hp2psCmd = 'cd "{opts.testdir}" && {{hp2ps}} {name}'.format(**locals())
 
     hp2psResult = await runCmd(hp2psCmd, print_output=True)
 
-    actual_ps_path = in_testdir(actual_name, 'ps')
+    actual_ps_path = in_testdir(name, 'ps')
 
     if hp2psResult == 0:
         if actual_ps_path.exists():
@@ -2345,15 +2344,15 @@ async def check_hp_ok(name: TestName) -> bool:
                 if (gsResult == 0):
                     return True
                 else:
-                    print("hp2ps output for " + actual_name + " is not valid PostScript")
+                    print("hp2ps output for " + name + " is not valid PostScript")
                     return False
             else:
                 return True # assume postscript is valid without ghostscript
         else:
-            print("hp2ps did not generate PostScript for " + actual_name)
+            print("hp2ps did not generate PostScript for " + name)
             return  False
     else:
-        print("hp2ps error when processing heap profile for " + actual_name)
+        print("hp2ps error when processing heap profile for " + name)
         return False
 
 async def check_prof_ok(name: TestName, way: WayName) -> bool:
@@ -2365,7 +2364,7 @@ async def check_prof_ok(name: TestName, way: WayName) -> bool:
     if not expected_prof_path.exists():
         return True
 
-    actual_prof_file = add_suffix(name + exe_extension(), 'prof')
+    actual_prof_file = add_suffix(name, 'prof')
     actual_prof_path = in_testdir(actual_prof_file)
 
     if not actual_prof_path.exists():


=====================================
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


=====================================
testsuite/tests/rts/linker/T24171/all.T
=====================================
@@ -1,6 +1,7 @@
 test('T24171',
      [req_rts_linker,
       req_profiling,
-      extra_files(['Lib.hs', 'main.c'])],
+      extra_files(['Lib.hs', 'main.c']),
+      fragile(24512)],
      makefile_test,
      ['clean_build_and_run'])


=====================================
testsuite/tests/rts/linker/all.T
=====================================
@@ -113,6 +113,7 @@ test('linker_unload_native',
      [extra_files(['LinkerUnload.hs', 'Test.hs']),
       req_rts_linker,
       unless(have_dynamic(), skip),
+      fragile(23993),
       when(opsys('darwin') or opsys('mingw32'), skip)],
      makefile_test, ['linker_unload_native'])
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2739c799d0a9e4534372feed1e6e2e2d5c1ad34d...1da0bdcb4adbf4eb7d0584c0d76aee83bc7f5166

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2739c799d0a9e4534372feed1e6e2e2d5c1ad34d...1da0bdcb4adbf4eb7d0584c0d76aee83bc7f5166
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/7bef7f2f/attachment-0001.html>


More information about the ghc-commits mailing list