[Git][ghc/ghc][wip/T24515] rts: Drop .wasm suffix from .prof file names

[Ben Gamari (@bgamari)]

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


Commits:
3c3e02f8 by Ben Gamari at 2024-03-07T12:02:25-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.

- - - - -


4 changed files:

- rts/ProfHeap.c
- rts/Profiling.c
- rts/RtsUtils.c
- rts/RtsUtils.h


Changes:

=====================================
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(wasi32_HOST_OS)
+        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(wasi32_HOST_OS)
+        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"



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3c3e02f83edf7fc92e7514f2f05eb0f5c4e9d582

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3c3e02f83edf7fc92e7514f2f05eb0f5c4e9d582
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/20240307/8f61e115/attachment-0001.html>