[Git][ghc/ghc][wip/T22965-9.2] 3 commits: rts: Statically assert alignment of Capability

[Ben Gamari (@bgamari)]

Ben Gamari pushed to branch wip/T22965-9.2 at Glasgow Haskell Compiler / GHC


Commits:
2f90abd4 by Ben Gamari at 2023-02-17T13:18:53-05:00
rts: Statically assert alignment of Capability

In #22965 we noticed that changes in the size of `Capability` can result
in unsound behavior due to the `align` pragma claiming an alignment
which we don't in practice observe. Avoid this by statically asserting
that the size is a multiple of the alignment.

We also drop the special-case for Windows.

- - - - -
8e330424 by Ben Gamari at 2023-02-17T13:18:53-05:00
rts: Introduce stgMallocAlignedBytes

(cherry picked from commit 04336d2f11e49f7d00392f05d4fd48abdd231fc0)

- - - - -
956b2c9f by Ben Gamari at 2023-02-17T13:18:53-05:00
rts: Correctly align Capability allocations

Previously we failed to tell the C allocator that `Capability`s needed
to be aligned, resulting in #22965.

(cherry picked from commit 4af27feabf482cf6b611951443e05ee7e53acb39)

- - - - -


4 changed files:

- rts/Capability.c
- rts/Capability.h
- rts/RtsUtils.c
- rts/RtsUtils.h


Changes:

=====================================
rts/Capability.c
=====================================
@@ -439,8 +439,9 @@ moreCapabilities (uint32_t from USED_IF_THREADS, uint32_t to USED_IF_THREADS)
             if (i < from) {
                 new_capabilities[i] = capabilities[i];
             } else {
-                new_capabilities[i] = stgMallocBytes(sizeof(Capability),
-                                                     "moreCapabilities");
+                new_capabilities[i] = stgMallocAlignedBytes(sizeof(Capability),
+                                                            CAPABILITY_ALIGNMENT,
+                                                            "moreCapabilities");
                 initCapability(new_capabilities[i], i);
             }
         }


=====================================
rts/Capability.h
=====================================
@@ -27,6 +27,14 @@
 
 #include "BeginPrivate.h"
 
+// We never want a Capability to overlap a cache line with
+// anything else, so round it up to a cache line size:
+#if defined(s390x_HOST_ARCH)
+#define CAPABILITY_ALIGNMENT 256
+#else
+#define CAPABILITY_ALIGNMENT 64
+#endif
+
 /* N.B. This must be consistent with CapabilityPublic in RtsAPI.h */
 struct Capability_ {
     // State required by the STG virtual machine when running Haskell
@@ -172,14 +180,12 @@ struct Capability_ {
     StgTRecHeader *free_trec_headers;
     uint32_t transaction_tokens;
 } // typedef Capability is defined in RtsAPI.h
-  // We never want a Capability to overlap a cache line with anything
-  // else, so round it up to a cache line size:
-#if defined(s390x_HOST_ARCH)
-  ATTRIBUTE_ALIGNED(256)
-#elif !defined(mingw32_HOST_OS)
-  ATTRIBUTE_ALIGNED(64)
-#endif
-  ;
+  ATTRIBUTE_ALIGNED(CAPABILITY_ALIGNMENT)
+;
+
+// We allocate arrays of Capabilities therefore we must ensure that the size is
+// a multiple of the claimed alignment
+GHC_STATIC_ASSERT(sizeof(struct Capability_) % CAPABILITY_ALIGNMENT == 0, "Capability size does not match cache size");
 
 #if defined(THREADED_RTS)
 #define ASSERT_TASK_ID(task) ASSERT(task->id == osThreadId())


=====================================
rts/RtsUtils.c
=====================================
@@ -58,10 +58,45 @@ extern char *ctime_r(const time_t *, char *);
 
 void *
 stgMallocBytes (size_t n, char *msg)
+{
+    void *space = malloc(n);
+
+    if (space == NULL) {
+      /* Quoting POSIX.1-2008 (which says more or less the same as ISO C99):
+       *
+       *   "Upon successful completion with size not equal to 0, malloc() shall
+       *   return a pointer to the allocated space. If size is 0, either a null
+       *   pointer or a unique pointer that can be successfully passed to free()
+       *   shall be returned. Otherwise, it shall return a null pointer and set
+       *   errno to indicate the error."
+       *
+       * Consequently, a NULL pointer being returned by `malloc()` for a 0-size
+       * allocation is *not* to be considered an error.
+       */
+      if (n == 0) return NULL;
+
+      /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
+      rtsConfig.mallocFailHook((W_) n, msg);
+      stg_exit(EXIT_INTERNAL_ERROR);
+    }
+    IF_DEBUG(zero_on_gc, memset(space, 0xbb, n));
+    return space;
+}
+
+void *
+stgMallocAlignedBytes (size_t n, size_t align, char *msg)
 {
     void *space;
 
-    if ((space = malloc(n)) == NULL) {
+#if defined(mingw32_HOST_OS)
+    space = _aligned_malloc(n, align);
+#else
+    if (posix_memalign(&space, align, n)) {
+        space = NULL; // Allocation failed
+    }
+#endif
+
+    if (space == NULL) {
       /* Quoting POSIX.1-2008 (which says more or less the same as ISO C99):
        *
        *   "Upon successful completion with size not equal to 0, malloc() shall


=====================================
rts/RtsUtils.h
=====================================
@@ -20,6 +20,8 @@ void shutdownAllocator(void);
 void *stgMallocBytes(size_t n, char *msg)
     GNUC3_ATTRIBUTE(__malloc__);
 
+void *stgMallocAlignedBytes(size_t n, size_t align, char *msg);
+
 void *stgReallocBytes(void *p, size_t n, char *msg);
 
 void *stgCallocBytes(size_t count, size_t size, char *msg)



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1741fd255842706a9f15c95cd8c1c6b7784c50ce...956b2c9f8f662381045c4e459b82531dd4e05dd6

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1741fd255842706a9f15c95cd8c1c6b7784c50ce...956b2c9f8f662381045c4e459b82531dd4e05dd6
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/20230217/53678938/attachment-0001.html>