Simplify minor heaps configuration logic and masking

asmcomp/cmm_helpers.ml

@@ -701,7 +701,7 @@ let float_array_ref arr ofs dbg =
   box_float dbg (unboxed_float_array_ref arr ofs dbg)
 
 let addr_array_set arr ofs newval dbg =
-  Cop(Cextcall("caml_modify_field_asm", typ_void, false, None),
+  Cop(Cextcall("caml_modify_field", typ_void, false, None),
       [arr; untag_int ofs dbg; newval], dbg)
 let addr_array_initialize arr ofs newval dbg =
   Cop(Cextcall("caml_initialize_field", typ_void, false, None),
@@ -2148,7 +2148,7 @@ let assignment_kind
 let setfield n ptr init arg1 arg2 dbg =
   match assignment_kind ptr init with
   | Caml_modify ->
-      return_unit dbg (Cop(Cextcall("caml_modify_field_asm",
+      return_unit dbg (Cop(Cextcall("caml_modify_field",
                                     typ_void, false, None),
                       [arg1; Cconst_int (n, dbg); arg2],
                       dbg))

runtime/amd64.S

@@ -110,8 +110,6 @@
 
 #define CAML_CONFIG_H_NO_TYPEDEFS
 #include "../runtime/caml/config.h"
-        .equ Minor_val_bitmask,\
-          (1 | ~((1 << (Minor_heap_align_bits + Minor_heap_sel_bits)) - 1))
 
         .set    domain_curr_field, 0
 #define DOMAIN_STATE(c_type, name) \
@@ -466,21 +464,6 @@ CFI_STARTPROC
 CFI_ENDPROC
 ENDFUNCTION(G(caml_call_realloc_stack))
 
-/* runs on C stack with C calling convention.
-   optimisation: use ocaml calling convention and SAVE_ALL_REGS?
-   args: C_ARG_1: object, C_ARG_2: field idx, C_ARG_3: new value */
-FUNCTION(G(caml_modify_field_asm))
-CFI_STARTPROC
-        movq    C_ARG_1, %r11
-        xorq    %r14, %r11
-        testq   $Minor_val_bitmask, %r11
-        jz      1f
-        jmp     GCALL(caml_modify_field)
-1:      movq    C_ARG_3, 0(C_ARG_1,C_ARG_2,8)
-        ret
-CFI_ENDPROC
-ENDFUNCTION(G(caml_modify_field_asm))
-
 FUNCTION(G(caml_call_gc))
 CFI_STARTPROC
         movq    $0, %rax

runtime/array.c

@@ -296,10 +296,10 @@ CAMLprim value caml_make_vect(value len, value init)
     else {
       /* make sure init is not young, to avoid creating
        very many ref table entries */
-      if (Is_block(init) && Is_minor(init))
+      if (Is_block(init) && Is_young(init))
         caml_minor_collection();
 
-      CAMLassert(!(Is_block(init) && Is_minor(init)));
+      CAMLassert(!(Is_block(init) && Is_young(init)));
       res = caml_alloc(size, 0);
       /* We now know that [init] is not in the minor heap, so there is
          no need to call [caml_initialize]. */

runtime/caml/config.h

@@ -212,18 +212,10 @@ typedef uint64_t uintnat;
    This must be at least [Max_young_wosize + 1]. */
 #define Minor_heap_min (Max_young_wosize + 1)
 
-/* There may be at most 1<<Minor_heap_sel_bits minor
-   heaps allocated */
-#define Minor_heap_sel_bits 7
-
-/* An entire minor heap must fit inside one region
-   of size 1 << Minor_heap_align_bits, which determines
-   the maximum size of the heap */
-#if SIZEOF_PTR  <= 4
-#define Minor_heap_align_bits 20
-#else
-#define Minor_heap_align_bits 24
-#endif
+/* Maximum size of the minor zone (words).
+   Must be greater than or equal to [Minor_heap_min].
+*/
+#define Minor_heap_max (1 << 28)
 
 /* Default size of the minor zone. (words)  */
 #define Minor_heap_def 262144
@@ -264,7 +256,7 @@ typedef uint64_t uintnat;
 #define Percent_to_promote_with_GC 10
 
 /* Maximum number of domains */
-#define Max_domains (1 << Minor_heap_sel_bits)
+#define Max_domains 128
 
 /* Default setting for the major GC slice smoothing window: 1
    (i.e. no smoothing)

runtime/caml/domain.h

@@ -103,6 +103,8 @@ struct domain* caml_owner_of_young_block(value);
 struct domain* caml_domain_of_id(int);
 
 CAMLextern atomic_uintnat caml_num_domains_running;
+CAMLextern uintnat caml_minor_heaps_base;
+CAMLextern uintnat caml_minor_heaps_end;
 
 INLINE intnat caml_domain_alone()
 {

runtime/caml/mlvalues.h

@@ -204,31 +204,14 @@ bits  63        (64-P) (63-P)        10 9     8 7   0
 /* Fields are numbered from 0. */
 #define Field(x, i) (((value *)(x)) [i])           /* Also an l-value. */
 
-/* All values which are not blocks in the current domain's minor heap
-   differ from caml_domain_state in at least one of the bits set in
-   Young_val_bitmask */
-#define Young_val_bitmask \
-  ((uintnat)1 | ~(((uintnat)1 << Minor_heap_align_bits) - (uintnat)1))
-
-/* All values which are not blocks in any domain's minor heap differ
-   from caml_domain_state in at least one of the bits set in
-   Minor_val_bitmask */
-#define Minor_val_bitmask \
-  ((uintnat)1 | ~(((uintnat)1 << (Minor_heap_align_bits + Minor_heap_sel_bits)) - (uintnat)1))
-
-
-/* Is_young(val) is true iff val is a block in the current domain's minor heap.
-   Since the minor heap is allocated in one aligned block, this can be tested
-   via bitmasking. */
-#define Is_young(val) \
-  ((((uintnat)(val) ^ (uintnat)Caml_state) & Young_val_bitmask) == 0)
+/* Is_young(val) is true iff val is in the reserved area for minor heaps */
 
-/* Is_minor(val) is true iff val is a block in any domain's minor heap. */
-#define Is_minor(val) \
-  ((((uintnat)(val) ^ (uintnat)Caml_state) & Minor_val_bitmask) == 0)
+#define Is_young(val) \
+  (CAMLassert (Is_block (val)),		   \
+   (char *)(val) < (char *)caml_minor_heaps_end && \
+   (char *)(val) > (char *)caml_minor_heaps_base)
 
-#define Is_block_and_young(val) Is_young(val)
-#define Is_block_and_minor(val) Is_minor(val)
+#define Is_block_and_young(val) (Is_block(val) && Is_young(val))
 
 /* NOTE: [Forward_tag] and [Infix_tag] must be just under
    [No_scan_tag], with [Infix_tag] the lower one.

runtime/domain.c

@@ -113,7 +113,8 @@ static struct dom_internal all_domains[Max_domains];
 
 CAMLexport atomic_uintnat caml_num_domains_running;
 
-static uintnat minor_heaps_base;
+CAMLexport uintnat caml_minor_heaps_base;
+CAMLexport uintnat caml_minor_heaps_end;
 static __thread dom_internal* domain_self;
 
 static int64_t startup_timestamp;
@@ -156,8 +157,8 @@ asize_t caml_norm_minor_heap_size (intnat wsize)
   if (wsize < Minor_heap_min) wsize = Minor_heap_min;
   bs = caml_mem_round_up_pages(Bsize_wsize (wsize));
 
-  Assert(page_size * 2 < (1 << Minor_heap_align_bits));
-  max = (1 << Minor_heap_align_bits) - page_size * 2;
+  Assert(page_size * 2 < Minor_heap_max);
+  max = Minor_heap_max - page_size * 2;
 
   if (bs > max) bs = max;
 
@@ -175,7 +176,6 @@ int caml_reallocate_minor_heap(asize_t wsize)
   caml_mem_decommit((void*)domain_self->minor_heap_area,
                     domain_self->minor_heap_area_end - domain_self->minor_heap_area);
 
-  /* we allocate a double buffer to allow early release in minor_gc */
   wsize = caml_norm_minor_heap_size(wsize);
 
   if (!caml_mem_commit((void*)domain_self->minor_heap_area, Bsize_wsize(wsize))) {
@@ -336,16 +336,17 @@ void caml_init_domains(uintnat minor_heap_wsz) {
   void* heaps_base;
 
   /* sanity check configuration */
-  if (caml_mem_round_up_pages(1 << Minor_heap_align_bits) != (1 << Minor_heap_align_bits))
-    caml_fatal_error("Minor_heap_align_bits misconfigured for this platform");
+  if (caml_mem_round_up_pages(Minor_heap_max) != Minor_heap_max)
+    caml_fatal_error("Minor_heap_max misconfigured for this platform");
 
   /* reserve memory space for minor heaps */
-  size = (uintnat)1 << (Minor_heap_sel_bits + Minor_heap_align_bits);
+  size = (uintnat)Minor_heap_max * Max_domains;
 
   heaps_base = caml_mem_map(size*2, size*2, 1 /* reserve_only */);
   if (!heaps_base) caml_raise_out_of_memory();
 
-  minor_heaps_base = (uintnat) heaps_base;
+  caml_minor_heaps_base = (uintnat) heaps_base;
+  caml_minor_heaps_end = (uintnat) heaps_base + size;
 
   for (i = 0; i < Max_domains; i++) {
     struct dom_internal* dom = &all_domains[i];
@@ -365,16 +366,16 @@ void caml_init_domains(uintnat minor_heap_wsz) {
     dom->backup_thread_running = 0;
     dom->backup_thread_msg = BT_INIT;
 
-    domain_minor_heap_base = minor_heaps_base +
-      (uintnat)(1 << Minor_heap_align_bits) * (uintnat)i;
+    domain_minor_heap_base = caml_minor_heaps_base +
+      (uintnat)Minor_heap_max * (uintnat)i;
     dom->tls_area = domain_minor_heap_base;
     dom->tls_area_end =
       caml_mem_round_up_pages(dom->tls_area +
                               sizeof(caml_domain_state));
     dom->minor_heap_area = /* skip guard page */
       caml_mem_round_up_pages(dom->tls_area_end + 1);
     dom->minor_heap_area_end =
-      domain_minor_heap_base + (1 << Minor_heap_align_bits);
+      domain_minor_heap_base + Minor_heap_max;
   }
 
 
@@ -581,9 +582,9 @@ struct domain* caml_domain_self()
 }
 
 struct domain* caml_owner_of_young_block(value v) {
-  Assert(Is_minor(v));
-  int heap_id = ((uintnat)v - minor_heaps_base) /
-    (1 << Minor_heap_align_bits);
+  Assert(Is_young(v));
+  int heap_id = ((uintnat)v - caml_minor_heaps_base) /
+    Minor_heap_max;
   return &all_domains[heap_id].state;
 }
 

runtime/fiber.c

@@ -475,12 +475,12 @@ CAMLprim value caml_continuation_use_noexc (value cont)
   value v;
   value null_stk = Val_ptr(NULL);
 
-  fiber_debug_log("cont: is_block(%d) tag_val(%ul) is_minor(%d)", Is_block(cont), Tag_val(cont), Is_minor(cont));
+  fiber_debug_log("cont: is_block(%d) tag_val(%ul) is_young(%d)", Is_block(cont), Tag_val(cont), Is_young(cont));
   CAMLassert(Is_block(cont) && Tag_val(cont) == Cont_tag);
 
   /* this forms a barrier between execution and any other domains
      that might be marking this continuation */
-  if (!Is_minor(cont) ) caml_darken_cont(cont);
+  if (!Is_young(cont) ) caml_darken_cont(cont);
 
   /* at this stage the stack is assured to be marked */
   v = Op_val(cont)[0];

runtime/finalise.c

@@ -228,7 +228,7 @@ static void generic_final_minor_update (struct domain* d, struct finalisable * f
   CAMLassert (final->old <= final->young);
   for (i = final->old; i < final->young; i++){
     CAMLassert (Is_block (final->table[i].val));
-    if (Is_minor(final->table[i].val) && caml_get_header_val(final->table[i].val) != 0){
+    if (Is_young(final->table[i].val) && caml_get_header_val(final->table[i].val) != 0){
       ++ todo_count;
     }
   }
@@ -248,7 +248,7 @@ static void generic_final_minor_update (struct domain* d, struct finalisable * f
     for (i = final->old; i < final->young; i++) {
       CAMLassert (Is_block (final->table[i].val));
       CAMLassert (Tag_val (final->table[i].val) != Forward_tag);
-      if (Is_minor(final->table[j].val) && caml_get_header_val(final->table[i].val) != 0) {
+      if (Is_young(final->table[j].val) && caml_get_header_val(final->table[i].val) != 0) {
         /** dead */
         fi->todo_tail->item[k] = final->table[i];
         /* The finalisation function is called with unit not with the value */
@@ -269,7 +269,7 @@ static void generic_final_minor_update (struct domain* d, struct finalisable * f
   /** update the minor value to the copied major value */
   for (i = final->old; i < final->young; i++) {
     CAMLassert (Is_block (final->table[i].val));
-    if (Is_minor(final->table[i].val)) {
+    if (Is_young(final->table[i].val)) {
       CAMLassert (caml_get_header_val(final->table[i].val) == 0);
       final->table[i].val = Op_val(final->table[i].val)[0];
     }

runtime/globroots.c

@@ -29,7 +29,7 @@ static caml_plat_mutex roots_mutex = CAML_PLAT_MUTEX_INITIALIZER;
 CAMLexport caml_root caml_create_root(value init)
 {
   CAMLparam1(init);
-  
+
   value* v = (value*)caml_stat_alloc(sizeof(value));
 
   *v = init;
@@ -42,7 +42,7 @@ CAMLexport caml_root caml_create_root(value init)
 CAMLexport caml_root caml_create_root_noexc(value init)
 {
   CAMLparam1(init);
-  
+
   value* v = (value*)caml_stat_alloc_noexc(sizeof(value));
 
   if( v == NULL ) {
@@ -95,7 +95,7 @@ struct skiplist caml_global_roots_old = SKIPLIST_STATIC_INITIALIZER;
    - Otherwise (the root contains a pointer outside of the heap or an integer),
      then neither [caml_global_roots_young] nor [caml_global_roots_old] contain
      it. */
-    
+
 /* Insertion and deletion */
 
 Caml_inline void caml_insert_global_root(struct skiplist * list, value * r)
@@ -307,4 +307,3 @@ void caml_scan_global_young_roots(scanning_action f, void* fdata)
 
   caml_skiplist_empty(&caml_global_roots_young);
 }
-

runtime/major_gc.c

@@ -472,9 +472,9 @@ static struct pool* find_pool_to_rescan();
 
 
 #ifdef DEBUG
-#define Is_markable(v) (Is_block(v) && !Is_minor(v) && v != Debug_free_major)
+#define Is_markable(v) (Is_block(v) && !Is_young(v) && v != Debug_free_major)
 #else
-#define Is_markable(v) (Is_block(v) && !Is_minor(v))
+#define Is_markable(v) (Is_block(v) && !Is_young(v))
 #endif
 
 static void realloc_mark_stack (struct mark_stack* stk)
@@ -510,10 +510,11 @@ static void mark_stack_push(struct mark_stack* stk, value block,
   int i, block_wsz = Wosize_val(block), end;
   mark_entry* me;
 
-  CAMLassert(Is_block(block) && !Is_minor(block));
+  CAMLassert(Is_block(block) && !Is_young(block));
   CAMLassert(Tag_val(block) != Infix_tag);
   CAMLassert(Tag_val(block) < No_scan_tag);
   CAMLassert(Tag_val(block) != Cont_tag);
+
   /* Optimisation to avoid pushing small, unmarkable objects such as [Some 42]
    * into the mark stack. */
   end =  (block_wsz < 8 ? block_wsz : 8);
@@ -667,7 +668,7 @@ static intnat mark(intnat budget) {
 
 void caml_darken_cont(value cont)
 {
-  CAMLassert(Is_block(cont) && !Is_minor(cont) && Tag_val(cont) == Cont_tag);
+  CAMLassert(Is_block(cont) && !Is_young(cont) && Tag_val(cont) == Cont_tag);
   SPIN_WAIT {
     header_t hd = atomic_load_explicit(Hp_atomic_val(cont), memory_order_relaxed);
     CAMLassert(!Has_status_hd(hd, global.GARBAGE));

runtime/memory.c

@@ -133,16 +133,16 @@ static void write_barrier(value obj, intnat field, value old_val, value new_val)
   /* HACK: can't assert when get old C-api style pointers
     Assert (Is_block(obj)); */
 
-  if (!Is_minor(obj)) {
+  if (!Is_young(obj)) {
 
     if (Is_block(old_val)) {
        /* if old is in the minor heap, then this is in a remembered set already */
-       if (Is_minor(old_val)) return;
+       if (Is_young(old_val)) return;
        /* old is a block and in the major heap */
        caml_darken(0, old_val, 0);
      }
      /* this update is creating a new link from major to minor, remember it */
-     if (Is_block_and_minor(new_val)) {
+     if (Is_block_and_young(new_val)) {
        Ref_table_add(&Caml_state->minor_tables->major_ref, Op_val(obj) + field);
      }
    }
@@ -185,7 +185,7 @@ CAMLexport void caml_initialize_field (value obj, intnat field, value val)
   Assert(0 <= field && field < Wosize_val(obj));
 #ifdef DEBUG
   /* caml_initialize_field can only be used on just-allocated objects */
-  if (Is_minor(obj))
+  if (Is_young(obj))
     Assert(Op_val(obj)[field] == Debug_uninit_minor ||
            Op_val(obj)[field] == Val_unit);
   else
@@ -204,7 +204,7 @@ CAMLexport CAMLweakdef void caml_initialize (value *fp, value val)
 {
 #ifdef DEBUG
   /* caml_initialize_field can only be used on just-allocated objects */
-  if (Is_minor((value)fp))
+  if (Is_young((value)fp))
     Assert(*fp == Debug_uninit_minor ||
            *fp == Val_unit);
   else
@@ -392,10 +392,6 @@ header_t hd_val (value v) {
   return (header_t)Hd_val(v);
 }
 
-int is_minor(value v) {
-  return Is_minor(v);
-}
-
 int is_young(value v) {
   return Is_young(v);
 }