Add +RTS -AL<size>

+RTS -AL<size> controls the total size of large objects that can be
allocated before a GC is triggered.  Previously this was always just the
value of -A, and the limit mainly existed to prevent runaway allocation
in pathalogical programs that allocate a lot of large objects.  However,
since the limit is shared between all cores, on a large multicore the
default becomes more restrictive, and can end up triggering GC well
before it would normally have been.

Arguably a better default would be A*N, but this is probably excessive.
Adding a flag lets you choose, and I've left the default as it was.

See docs for usage.

4 files changed, 56 insertions, 15 deletions

diff --git a/docs/users_guide/runtime_control.rst b/docs/users_guide/runtime_control.rst
index 09e0afd1ae..19135c61ce 100644
--- a/docs/users_guide/runtime_control.rst
+++ b/docs/users_guide/runtime_control.rst
@@ -285,6 +285,34 @@ performance.
     allocation area will be resized according to the amount of data in the heap
     (see :rts-flag:`-F`, below).
 
+.. rts-flag:: -AL ⟨size⟩
+
+    :default: ``-A`` value
+    :since: 8.2.1
+
+    .. index::
+       single: allocation area for large objects, size
+
+    Sets the limit on the total size of "large objects" (objects
+    larger than about 3KB) that can be allocated before a GC is
+    triggered.  By default this limit is the same as the ``-A`` value.
+
+    Large objects are not allocated from the normal allocation area
+    set by the ``-A`` flag, which is why there is a separate limit for
+    these.  Large objects tend to be much rarer than small objects, so
+    most programs hit the ``-A`` limit before the ``-AL`` limit.  However,
+    the ``-A`` limit is per-capability, whereas the ``-AL`` limit is global,
+    so as ``-N`` gets larger it becomes more likely that we hit the
+    ``-AL`` limit first.  To counteract this, it might be necessary to
+    use a larger ``-AL`` limit when using a large ``-N``.
+
+    To see whether you're making good use of all the memory reseverd
+    for the allocation area (``-A`` times ``-N``), look at the output of
+    ``+RTS -S`` and check whether the amount of memory allocated between
+    GCs is equal to ``-A`` times ``-N``. If not, there are two possible
+    remedies: use ``-n`` to set a nursery chunk size, or use ``-AL`` to
+    increase the limit for large objects.
+
 .. rts-flag:: -O ⟨size⟩
 
     :default: 1m
diff --git a/includes/rts/Flags.h b/includes/rts/Flags.h
index 16417ce34e..d3bc001ca1 100644
--- a/includes/rts/Flags.h
+++ b/includes/rts/Flags.h
@@ -41,6 +41,7 @@ typedef struct _GC_FLAGS {
 
     nat	    maxHeapSize;        /* in *blocks* */
     nat     minAllocAreaSize;   /* in *blocks* */
+    nat     largeAllocLim;      /* in *blocks* */
     nat     nurseryChunkSize;   /* in *blocks* */
     nat     minOldGenSize;      /* in *blocks* */
     nat     heapSizeSuggestion; /* in *blocks* */
diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c
index 73c5b4564a..084fc210be 100644
--- a/rts/RtsFlags.c
+++ b/rts/RtsFlags.c
@@ -136,6 +136,7 @@ void initRtsFlagsDefaults(void)
     RtsFlags.GcFlags.stkChunkBufferSize = (1 * 1024) / sizeof(W_);
 
     RtsFlags.GcFlags.minAllocAreaSize   = (512 * 1024)        / BLOCK_SIZE;
+    RtsFlags.GcFlags.largeAllocLim      = 0; /* defaults to minAllocAreasize */
     RtsFlags.GcFlags.nurseryChunkSize   = 0;
     RtsFlags.GcFlags.minOldGenSize      = (1024 * 1024)       / BLOCK_SIZE;
     RtsFlags.GcFlags.maxHeapSize        = 0;    /* off by default */
@@ -261,14 +262,16 @@ usage_text[] = {
 "  -kc<size> Sets the stack chunk size (default 32k)",
 "  -kb<size> Sets the stack chunk buffer size (default 1k)",
 "",
-"  -A<size> Sets the minimum allocation area size (default 512k) Egs: -A1m -A10k",
-"  -n<size> Allocation area chunk size (0 = disabled, default: 0)",
-"  -O<size> Sets the minimum size of the old generation (default 1M)",
-"  -M<size> Sets the maximum heap size (default unlimited)  Egs: -M256k -M1G",
-"  -H<size> Sets the minimum heap size (default 0M)   Egs: -H24m  -H1G",
-"  -m<n>    Minimum % of heap which must be available (default 3%)",
-"  -G<n>    Number of generations (default: 2)",
-"  -c<n>    Use in-place compaction instead of copying in the oldest generation",
+"  -A<size>  Sets the minimum allocation area size (default 512k) Egs: -A1m -A10k",
+"  -AL<size> Sets the amount of large-object memory that can be allocated",
+"            before a GC is triggered (default: the value of -A)",
+"  -n<size>  Allocation area chunk size (0 = disabled, default: 0)",
+"  -O<size>  Sets the minimum size of the old generation (default 1M)",
+"  -M<size>  Sets the maximum heap size (default unlimited)  Egs: -M256k -M1G",
+"  -H<size>  Sets the minimum heap size (default 0M)   Egs: -H24m  -H1G",
+"  -m<n>     Minimum % of heap which must be available (default 3%)",
+"  -G<n>     Number of generations (default: 2)",
+"  -c<n>     Use in-place compaction instead of copying in the oldest generation",
 "           when live data is at least <n>% of the maximum heap size set with",
 "           -M (default: 30%)",
 "  -c       Use in-place compaction for all oldest generation collections",
@@ -750,11 +753,17 @@ error = rtsTrue;
                   break;
               case 'A':
                   OPTION_UNSAFE;
-                  // minimum two blocks in the nursery, so that we have one to
-                  // grab for allocate().
-                  RtsFlags.GcFlags.minAllocAreaSize
-                      = decodeSize(rts_argv[arg], 2, 2*BLOCK_SIZE, HS_INT_MAX)
-                           / BLOCK_SIZE;
+                  if (rts_argv[arg][2] == 'L') {
+                      RtsFlags.GcFlags.largeAllocLim
+                          = decodeSize(rts_argv[arg], 3, 2*BLOCK_SIZE,
+                                       HS_INT_MAX) / BLOCK_SIZE;
+                  } else {
+                      // minimum two blocks in the nursery, so that we have one
+                      // to grab for allocate().
+                      RtsFlags.GcFlags.minAllocAreaSize
+                          = decodeSize(rts_argv[arg], 2, 2*BLOCK_SIZE,
+                                       HS_INT_MAX) / BLOCK_SIZE;
+                  }
                   break;
               case 'n':
                   OPTION_UNSAFE;
diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c
index 18ae796864..3e421a6e9b 100644
--- a/rts/sm/Storage.c
+++ b/rts/sm/Storage.c
@@ -179,8 +179,11 @@ initStorage (void)
   debug_caf_list = (StgIndStatic*)END_OF_CAF_LIST;
   revertible_caf_list = (StgIndStatic*)END_OF_CAF_LIST;
    
-  /* initialise the allocate() interface */
-  large_alloc_lim = RtsFlags.GcFlags.minAllocAreaSize * BLOCK_SIZE_W;
+  if (RtsFlags.GcFlags.largeAllocLim > 0) {
+      large_alloc_lim = RtsFlags.GcFlags.largeAllocLim * BLOCK_SIZE_W;
+  } else {
+      large_alloc_lim = RtsFlags.GcFlags.minAllocAreaSize * BLOCK_SIZE_W;
+  }
 
   exec_block = NULL;