RTS: Auto-size the allocation area depending on CPU cache sizearcpatch-D4679

Summary:
Looks for L3 and L2 caches and sets the size of the allocation area
to the size of the largest cache found.
If we can't find anything, use the existing default of 1MB.

Implemented for Linux, Windows, and Darwin.
Tested on Linux and 64bit Windows only so far.

Reviewers: bgamari, erikd, simonmar

Subscribers: dfeuer, Phyx, AndreasK, rwbarton, thomie, carter

GHC Trac Issues: #13362

Differential Revision: https://phabricator.haskell.org/D4679

2 files changed, 81 insertions, 6 deletions

diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c
index 7c292d2044..d000c498f0 100644
--- a/rts/RtsFlags.c
+++ b/rts/RtsFlags.c
@@ -33,6 +33,14 @@
 
 #include <fs_rts.h>
 
+#if defined(mingw32_HOST_OS)
+#include <windows.h>
+#endif
+
+#if defined(darwin_HOST_OS)
+#include <sys/sysctl.h>
+#endif
+
 // Flag Structure
 RTS_FLAGS RtsFlags;
 
@@ -124,6 +132,8 @@ static void setProgName (char *argv[]);
 
 static void errorRtsOptsDisabled (const char *s);
 
+static StgWord32 largestCpuCacheSize(void);
+
 /* -----------------------------------------------------------------------------
  * Command-line option parsing routines.
  * ---------------------------------------------------------------------------*/
@@ -135,6 +145,10 @@ void initRtsFlagsDefaults(void)
     if (maxStkSize == 0)
         maxStkSize = 8 * 1024 * 1024;
 
+    StgWord32 minAllocAreaSize = largestCpuCacheSize();
+    if (minAllocAreaSize == 0)
+        minAllocAreaSize = 1024 * 1024;
+
     RtsFlags.GcFlags.statsFile          = NULL;
     RtsFlags.GcFlags.giveStats          = NO_GC_STATS;
 
@@ -143,7 +157,7 @@ void initRtsFlagsDefaults(void)
     RtsFlags.GcFlags.stkChunkSize       = (32 * 1024) / sizeof(W_);
     RtsFlags.GcFlags.stkChunkBufferSize = (1 * 1024) / sizeof(W_);
 
-    RtsFlags.GcFlags.minAllocAreaSize   = (1024 * 1024)       / BLOCK_SIZE;
+    RtsFlags.GcFlags.minAllocAreaSize   = minAllocAreaSize / BLOCK_SIZE;
     RtsFlags.GcFlags.largeAllocLim      = 0; /* defaults to minAllocAreasize */
     RtsFlags.GcFlags.nurseryChunkSize   = 0;
     RtsFlags.GcFlags.minOldGenSize      = (1024 * 1024)       / BLOCK_SIZE;
@@ -2235,6 +2249,67 @@ void freeRtsArgs(void)
     freeRtsArgv();
 }
 
+// Return the size in bytes of the largest L3 or L2 CPU cache on the system.
+// Returns 0 if the cache size can't be determined.
+static StgWord32 largestCpuCacheSize(void)
+{
+#if defined(linux_HOST_OS)
+    int args[2] = {
+        _SC_LEVEL3_CACHE_SIZE,
+        _SC_LEVEL2_CACHE_SIZE,
+    };
+    for (int i = 0; i < 2; i++) {
+        long size = sysconf(args[i]);
+        if (size > 0L)
+            return (StgWord32)size;
+    }
+#elif defined(mingw32_HOST_OS)
+    DWORD max_cache_size = 0;
+
+    DWORD buffer_size = 0;
+    // Determine the necessary buffer size
+    GetLogicalProcessorInformationEx(RelationCache, NULL, &buffer_size);
+
+    SYSTEM_LOGICAL_PROCESSOR_INFORMATION_EX* buffer =
+        (SYSTEM_LOGICAL_PROCESSOR_INFORMATION_EX*)malloc(buffer_size);
+
+    BOOL ok =
+        GetLogicalProcessorInformationEx(RelationCache, buffer, &buffer_size);
+    if (!ok)
+        sysErrorBelch("GetLogicalProcessorInformationEx failed");
+
+    // SYSTEM_LOGICAL_PROCESSOR_INFORMATION_EX is a variable-size structure, so
+    // we progress by adding the size of the current SLPIE to the pointer.
+    for (SYSTEM_LOGICAL_PROCESSOR_INFORMATION_EX* p = buffer;
+            (char*)p < (char*)buffer + buffer_size;
+            p = (SYSTEM_LOGICAL_PROCESSOR_INFORMATION_EX*)
+                ((char*)p + p->Size)) {
+
+        if (p->Relationship == RelationCache) {
+            CACHE_RELATIONSHIP cache = p->Cache;
+            if ((cache.Type == CacheUnified || cache.Type == CacheData) &&
+                    (cache.Level == 2 || cache.Level == 3) &&
+                    cache.CacheSize > max_cache_size)
+                max_cache_size = cache.CacheSize;
+        } else
+            debugBelch("Unexpected Relationship %u", p->Relationship);
+    }
+    free(buffer);
+    return (StgWord32)max_cache_size;
+#elif defined(darwin_HOST_OS)
+    // TODO: The following code might also work on FreeBSD.
+    // Enable it if you can test it.
+    char* args[2] = { "hw.l3cachesize", "hw.l2cachesize" };
+    StgWord32 cache_size = 0;
+    size_t data_size = sizeof(cache_size);
+    for (int i = 0; i < 2; i++) {
+        int ret = sysctlbyname(args[i], &cache_size, &data_size, NULL, 0);
+        if (ret == 0 && cache_size > 0)
+            return cache_size;
+    }
+#endif
+    return 0;
+}
 
 /*
 Note [OPTION_SAFE vs OPTION_UNSAFE]
diff --git a/rts/ghc.mk b/rts/ghc.mk
index e96e14760b..95e602fc15 100644
--- a/rts/ghc.mk
+++ b/rts/ghc.mk
@@ -22,10 +22,10 @@ rts_VERSION = 1.0
 # Minimum supported Windows version.
 # These numbers can be found at:
 #  https://msdn.microsoft.com/en-us/library/windows/desktop/aa383745(v=vs.85).aspx
-# If we're compiling on windows, enforce that we only support Vista SP1+
+# If we're compiling on windows, enforce that we only support Windows 7 and newer.
 # Adding this here means it doesn't have to be done in individual .c files
 # and also centralizes the versioning.
-rts_WINVER = 0x06000100
+rts_WINVER = 0x0601
 
 # merge GhcLibWays and GhcRTSWays but strip out duplicates
 rts_WAYS = $(GhcLibWays) $(filter-out $(GhcLibWays),$(GhcRTSWays))
@@ -192,11 +192,10 @@ endif
 
 rts_dist_$1_CC_OPTS += -DRtsWay=\"rts_$1\"
 
-# If we're compiling on windows, enforce that we only support XP+
-# Adding this here means it doesn't have to be done in individual .c files
-# and also centralizes the versioning.
+# Windows version requirement
 ifeq "$$(TargetOS_CPP)" "mingw32"
 rts_dist_$1_CC_OPTS += -DWINVER=$(rts_WINVER)
+rts_dist_$1_CC_OPTS += -D_WIN32_WINNT=$(rts_WINVER)
 endif
 
 ifneq "$$(UseSystemLibFFI)" "YES"
@@ -372,6 +371,7 @@ endif
 # Set Windows version
 ifeq "$$(TargetOS_CPP)" "mingw32"
 rts_CC_OPTS += -DWINVER=$(rts_WINVER)
+rts_CC_OPTS += -D_WIN32_WINNT=$(rts_WINVER)
 endif
 
 #-----------------------------------------------------------------------------