Add OCAMLRUNPARAM d= parameter for max # domains

manual/src/cmds/runtime.etex

@@ -129,6 +129,9 @@ The following environment variables are also consulted:
         "caml_shutdown" in section~\ref{ss:c-embedded-code}). The option also enables
         pooling (as in "caml_startup_pooled"). This mode can be used to detect
         leaks with a third-party memory debugger.
+  \item[d] ("max_domains") Maximum number of domains that can be active
+        concurrently. Defaults to 128 on 64-bit platforms and 16 on 32-bit
+        platforms.
   \item[e] ("runtime_events_log_wsize") Size of the per-domain runtime events ring
         buffers in log powers of two words. Defaults to 16, giving 64k word or
         512kb buffers on 64-bit systems.

otherlibs/systhreads/st_pthreads.h

@@ -28,23 +28,16 @@
 
 typedef int st_retcode;
 
-/* Variables used to stop "tick" threads */
-static atomic_uintnat tick_thread_stop[Max_domains];
-#define Tick_thread_stop tick_thread_stop[Caml_state->id]
-
 /* OS-specific initialization */
-
 static int st_initialize(void)
 {
-  atomic_store_release(&Tick_thread_stop, 0);
   return 0;
 }
 
-/* Thread creation.  Created in detached mode if [res] is NULL. */
-
 typedef pthread_t st_thread_id;
 
 
+/* Thread creation. Created in detached mode if [res] is NULL. */
 static int st_thread_create(st_thread_id * res,
                             void * (*fn)(void *), void * arg)
 {
@@ -296,16 +289,24 @@ static int st_event_wait(st_event e)
   return rc;
 }
 
-/* The tick thread: interrupt the domain periodically to force preemption  */
+struct caml_thread_tick_args {
+  int domain_id;
+  atomic_uintnat* stop;
+};
 
+/* The tick thread: interrupt the domain periodically to force preemption  */
 static void * caml_thread_tick(void * arg)
 {
-  int *domain_id = (int *) arg;
+  struct caml_thread_tick_args* tick_thread_args =
+    (struct caml_thread_tick_args*) arg;
+  int domain_id = tick_thread_args->domain_id;
+  atomic_uintnat* stop = tick_thread_args->stop;
+  caml_stat_free(tick_thread_args);
 
-  caml_init_domain_self(*domain_id);
+  caml_init_domain_self(domain_id);
   caml_domain_state *domain = Caml_state;
 
-  while(! atomic_load_acquire(&Tick_thread_stop)) {
+  while(! atomic_load_acquire(stop)) {
     st_msleep(Thread_timeout);
 
     atomic_store_release(&domain->requested_external_interrupt, 1);

otherlibs/systhreads/st_stubs.c

@@ -44,6 +44,7 @@
 #include "caml/printexc.h"
 #include "caml/roots.h"
 #include "caml/signals.h"
+#include "caml/startup_aux.h"
 #include "caml/sync.h"
 #include "caml/sys.h"
 #include "caml/memprof.h"
@@ -162,10 +163,11 @@ struct caml_thread_table {
   int tick_thread_running;
   int tick_thread_disabled;
   st_thread_id tick_thread_id;
+  atomic_uintnat tick_thread_stop;
 };
 
-/* thread_table instance, up to Max_domains */
-static struct caml_thread_table thread_table[Max_domains];
+/* thread_table instance, up to caml_params->max_domains */
+static struct caml_thread_table* thread_table;
 
 #define Locking_scheme(dom_id) (thread_table[dom_id].locking_scheme)
 #define Default_lock(dom_id) (&thread_table[dom_id].default_lock)
@@ -199,6 +201,9 @@ static void thread_lock_release(int dom_id)
   s->unlock(s->context);
 }
 
+/* Used to signal that the "tick" thread for this domain should be stopped. */
+#define Tick_thread_stop thread_table[Caml_state->id].tick_thread_stop
+
 /* The remaining fields are accessed while holding the domain lock */
 
 /* The descriptor for the currently executing thread for this domain;
@@ -648,9 +653,9 @@ static void caml_thread_domain_spawn_hook(void)
    yet. */
 static void caml_thread_domain_initialize_hook(void)
 {
-
   caml_thread_t new_thread;
 
+  atomic_store_release(&Tick_thread_stop, 0);
   /* OS-specific initialization */
   st_initialize();
 
@@ -717,6 +722,12 @@ CAMLprim value caml_thread_initialize(value unit)
     caml_failwith("caml_thread_initialize: cannot initialize Thread "
                   "while several domains are running.");
 
+  thread_table = caml_stat_calloc_noexc(caml_params->max_domains,
+                                        sizeof(struct caml_thread_table));
+  if (thread_table == NULL)
+    caml_fatal_error("caml_thread_initialize: failed to allocate thread"
+                     " table");
+
   /* Initialize the key to the [caml_thread_t] structure */
   st_tls_newkey(&caml_thread_key);
 
@@ -839,8 +850,16 @@ static st_retcode create_tick_thread(void)
   pthread_sigmask(SIG_BLOCK, &mask, &old_mask);
 #endif
 
+  struct caml_thread_tick_args* tick_thread_args =
+    caml_stat_alloc_noexc(sizeof(struct caml_thread_tick_args));
+  if (tick_thread_args == NULL)
+    caml_fatal_error("create_tick_thread: failed to allocate thread args");
+
+  tick_thread_args->domain_id = Caml_state->id;
+  tick_thread_args->stop = &Tick_thread_stop;
+
   st_retcode err = st_thread_create(&Tick_thread_id, caml_thread_tick,
-                         (void *) &Caml_state->id);
+                                    (void *)tick_thread_args);
 
 #ifdef POSIX_SIGNALS
   pthread_sigmask(SIG_SETMASK, &old_mask, NULL);

runtime/caml/domain.h

@@ -28,14 +28,16 @@ extern "C" {
 #include "mlvalues.h"
 #include "domain_state.h"
 
-/* The runtime currently has a hard limit on the number of domains.
-   This hard limit may go away in the future. */
 #ifdef ARCH_SIXTYFOUR
-#define Max_domains 128
+#define Max_domains_def 128
 #else
-#define Max_domains 16
+#define Max_domains_def 16
 #endif
 
+/* Upper limit for the number of domains. Chosen to be arbitrarily large. Used
+ * for sanity checking [max_domains] value in OCAMLRUNPARAM. */
+#define Max_domains_max 4096
+
 /* is the minor heap full or an external interrupt has been triggered */
 Caml_inline int caml_check_gc_interrupt(caml_domain_state * dom_st)
 {
@@ -86,7 +88,7 @@ CAMLextern void (*caml_domain_initialize_hook)(void);
 CAMLextern void (*caml_domain_stop_hook)(void);
 CAMLextern void (*caml_domain_external_interrupt_hook)(void);
 
-CAMLextern void caml_init_domains(uintnat minor_heap_wsz);
+CAMLextern void caml_init_domains(uintnat max_domains, uintnat minor_heap_wsz);
 CAMLextern void caml_init_domain_self(int);
 
 CAMLextern uintnat caml_minor_heap_max_wsz;

runtime/caml/domain_state.tbl

@@ -161,12 +161,15 @@ DOMAIN_STATE(struct caml_intern_state*, intern_state)
 /* These stats represent only the current domain's respective values. */
 /* Use the Gc module to get aggregated total program stats. */
 /*****************************************************************************/
+
 DOMAIN_STATE(uintnat, stat_minor_words)
 DOMAIN_STATE(uintnat, stat_promoted_words)
 DOMAIN_STATE(uintnat, stat_major_words)
 DOMAIN_STATE(intnat, stat_forced_major_collections)
 DOMAIN_STATE(uintnat, stat_blocks_marked)
 
+/*****************************************************************************/
+
 DOMAIN_STATE(int, inside_stw_handler)
 /* whether or not a domain is inside of a stop-the-world handler
    this is used for several debug assertions inside of methods

runtime/caml/gc_stats.h

@@ -83,6 +83,8 @@ void caml_collect_gc_stats_sample_stw(caml_domain_state *domain);
    current domain but the sampled stats of other domains. */
 void caml_compute_gc_stats(struct gc_stats* buf);
 
+void caml_init_gc_stats (uintnat max_domains);
+
 #endif /* CAML_INTERNALS */
 
 #endif /* CAML_GC_STATS_H */

runtime/caml/startup_aux.h

@@ -55,6 +55,7 @@ struct caml_params {
   uintnat runtime_warnings;
   uintnat cleanup_on_exit;
   uintnat event_trace;
+  uintnat max_domains;
 };
 
 extern const struct caml_params* const caml_params;