Fix #11287 by cleaning up "reserved header bits" in the runtime (#11872)

22 files changed, 168 insertions, 175 deletions

diff --git a/Changes b/Changes
index bfe3494c7c..a60c88a612 100644
--- a/Changes
+++ b/Changes
@@ -22,6 +22,10 @@ Working version
 
 ### Runtime system:
 
+- #11287, #11872: Clean up reserved header bits (once used for
+  Spacetime profiling).
+  (Nick Barnes, review by Gabriel Scherer and Damien Doligez)
+
 - #11750: Decouple major slice from minor GC.
   (KC Sivaramakrishnan, review by Sadiq Jaffer, Guillaume Munch-Maccagnoni and
   Damien Doligez)
diff --git a/Makefile.config.in b/Makefile.config.in
index acfa023b4d..c8d6966c40 100644
--- a/Makefile.config.in
+++ b/Makefile.config.in
@@ -225,8 +225,7 @@ WITH_OCAMLDOC=@ocamldoc@
 WITH_OCAMLTEST=@ocamltest@
 ASM_CFI_SUPPORTED=@asm_cfi_supported@
 WITH_FRAME_POINTERS=@frame_pointers@
-WITH_PROFINFO=@profinfo@
-PROFINFO_WIDTH=@profinfo_width@
+HEADER_RESERVED_BITS=@reserved_header_bits@
 LIBUNWIND_AVAILABLE=@libunwind_available@
 LIBUNWIND_INCLUDE_FLAGS=@libunwind_include_flags@
 LIBUNWIND_LINK_FLAGS=@libunwind_link_flags@
diff --git a/asmcomp/cmm_helpers.ml b/asmcomp/cmm_helpers.ml
index e7dc40430a..40ff3fccdd 100644
--- a/asmcomp/cmm_helpers.ml
+++ b/asmcomp/cmm_helpers.ml
@@ -643,20 +643,16 @@ let get_field_gen mutability ptr n dbg =
 let set_field ptr n newval init dbg =
   Cop(Cstore (Word_val, init), [field_address ptr n dbg; newval], dbg)
 
-let non_profinfo_mask =
-  if Config.profinfo
-  then (1 lsl (64 - Config.profinfo_width)) - 1
-  else 0 (* [non_profinfo_mask] is unused in this case *)
-
 let get_header ptr dbg =
   (* We cannot deem this as [Immutable] due to the presence of [Obj.truncate]
      and [Obj.set_tag]. *)
   Cop(mk_load_mut Word_int,
     [Cop(Cadda, [ptr; Cconst_int(-size_int, dbg)], dbg)], dbg)
 
-let get_header_without_profinfo ptr dbg =
-  if Config.profinfo then
-    Cop(Cand, [get_header ptr dbg; Cconst_int (non_profinfo_mask, dbg)], dbg)
+let get_header_masked ptr dbg =
+  if Config.reserved_header_bits > 0 then
+    let header_mask = (1 lsl (64 - Config.reserved_header_bits)) - 1
+    in Cop(Cand, [get_header ptr dbg; Cconst_int (header_mask, dbg)], dbg)
   else
     get_header ptr dbg
 
@@ -672,7 +668,7 @@ let get_tag ptr dbg =
         [Cop(Cadda, [ptr; Cconst_int(tag_offset, dbg)], dbg)], dbg)
 
 let get_size ptr dbg =
-  Cop(Clsr, [get_header_without_profinfo ptr dbg; Cconst_int (10, dbg)], dbg)
+  Cop(Clsr, [get_header_masked ptr dbg; Cconst_int (10, dbg)], dbg)
 
 (* Array indexing *)
 
@@ -2063,7 +2059,7 @@ let offsetref n arg dbg =
              dbg)))
 
 let arraylength kind arg dbg =
-  let hdr = get_header_without_profinfo arg dbg in
+  let hdr = get_header_masked arg dbg in
   match (kind : Lambda.array_kind) with
     Pgenarray ->
       let len =
@@ -2263,7 +2259,7 @@ let arrayref_safe kind arg1 arg2 dbg =
   | Pgenarray ->
       bind "index" arg2 (fun idx ->
       bind "arr" arg1 (fun arr ->
-      bind "header" (get_header_without_profinfo arr dbg) (fun hdr ->
+      bind "header" (get_header_masked arr dbg) (fun hdr ->
         if wordsize_shift = numfloat_shift then
           Csequence(
             make_checkbound dbg [addr_array_length_shifted hdr dbg; idx],
@@ -2290,7 +2286,7 @@ let arrayref_safe kind arg1 arg2 dbg =
             Csequence(
               make_checkbound dbg [
                 addr_array_length_shifted
-                  (get_header_without_profinfo arr dbg) dbg; idx],
+                  (get_header_masked arr dbg) dbg; idx],
               addr_array_ref arr idx dbg)))
       | Pintarray ->
           bind "index" arg2 (fun idx ->
@@ -2298,7 +2294,7 @@ let arrayref_safe kind arg1 arg2 dbg =
             Csequence(
               make_checkbound dbg [
                 addr_array_length_shifted
-                  (get_header_without_profinfo arr dbg) dbg; idx],
+                  (get_header_masked arr dbg) dbg; idx],
               int_array_ref arr idx dbg)))
       | Pfloatarray ->
           box_float dbg (
@@ -2307,7 +2303,7 @@ let arrayref_safe kind arg1 arg2 dbg =
               Csequence(
                 make_checkbound dbg [
                   float_array_length_shifted
-                    (get_header_without_profinfo arr dbg) dbg;
+                    (get_header_masked arr dbg) dbg;
                   idx],
                 unboxed_float_array_ref arr idx dbg))))
 
@@ -2366,7 +2362,7 @@ let arrayset_safe kind arg1 arg2 arg3 dbg =
       bind "newval" arg3 (fun newval ->
       bind "index" arg2 (fun idx ->
       bind "arr" arg1 (fun arr ->
-      bind "header" (get_header_without_profinfo arr dbg) (fun hdr ->
+      bind "header" (get_header_masked arr dbg) (fun hdr ->
         if wordsize_shift = numfloat_shift then
           Csequence(
             make_checkbound dbg [addr_array_length_shifted hdr dbg; idx],
@@ -2398,7 +2394,7 @@ let arrayset_safe kind arg1 arg2 arg3 dbg =
         Csequence(
           make_checkbound dbg [
             addr_array_length_shifted
-              (get_header_without_profinfo arr dbg) dbg;
+              (get_header_masked arr dbg) dbg;
             idx],
           addr_array_set arr idx newval dbg))))
   | Pintarray ->
@@ -2408,7 +2404,7 @@ let arrayset_safe kind arg1 arg2 arg3 dbg =
         Csequence(
           make_checkbound dbg [
             addr_array_length_shifted
-              (get_header_without_profinfo arr dbg) dbg;
+              (get_header_masked arr dbg) dbg;
             idx],
           int_array_set arr idx newval dbg))))
   | Pfloatarray ->
@@ -2418,7 +2414,7 @@ let arrayset_safe kind arg1 arg2 arg3 dbg =
         Csequence(
           make_checkbound dbg [
             float_array_length_shifted
-              (get_header_without_profinfo arr dbg) dbg;
+              (get_header_masked arr dbg) dbg;
             idx],
           float_array_set arr idx newval dbg))))
   )
diff --git a/asmcomp/cmm_helpers.mli b/asmcomp/cmm_helpers.mli
index 3c8dfa241f..52f541cd7c 100644
--- a/asmcomp/cmm_helpers.mli
+++ b/asmcomp/cmm_helpers.mli
@@ -213,9 +213,8 @@ val set_field :
 (** Load a block's header *)
 val get_header : expression -> Debuginfo.t -> expression
 
-(** Same as [get_header], but also set all profiling bits of the header
-    are to 0 (if profiling is enabled) *)
-val get_header_without_profinfo : expression -> Debuginfo.t -> expression
+(** Same as [get_header], but also clear all reserved bits of the result *)
+val get_header_masked : expression -> Debuginfo.t -> expression
 
 (** Load a block's tag *)
 val get_tag : expression -> Debuginfo.t -> expression
@@ -237,8 +236,7 @@ val is_addr_array_ptr : expression -> Debuginfo.t -> expression
     Shifts by one bit less than necessary, keeping one of the GC colour bits,
     to save an operation when returning the length as a caml integer or when
     comparing it to a caml integer.
-    Assumes the header does not have any profiling info
-    (as returned by get_header_without_profinfo) *)
+    Assumes that the reserved bits are clear (see get_header_masked) *)
 val addr_array_length_shifted : expression -> Debuginfo.t -> expression
 val float_array_length_shifted : expression -> Debuginfo.t -> expression
 
diff --git a/configure b/configure
index d67d3991a0..10c226ad83 100755
--- a/configure
+++ b/configure
@@ -796,8 +796,7 @@ cmm_invariants
 flambda_invariants
 flambda
 frame_pointers
-profinfo_width
-profinfo
+reserved_header_bits
 install_ocamlnat
 install_source_artifacts
 install_bytecode_programs
@@ -1660,7 +1659,7 @@ Optional Features:
   --enable-cmm-invariants enable invariants checks in Cmm
   --enable-reserved-header-bits=BITS
                           reserve BITS (between 0 and 31) bits in block
-                          headers for profiling info
+                          headers
   --disable-stdlib-manpages
                           do not build or install the library man pages
   --enable-warn-error     treat C compiler warnings as errors
@@ -3233,8 +3232,7 @@ CSCFLAGS=""
 ostype="Unix"
 SO="so"
 toolchain="cc"
-profinfo=false
-profinfo_width=0
+reserved_header_bits=0
 instrumented_runtime=false
 instrumented_runtime_libs=""
 bootstrapping_flexdll=false
@@ -3395,7 +3393,6 @@ OCAML_VERSION_SHORT=5.1
 
 
 
-
 ## Generated files
 
 ac_config_files="$ac_config_files Makefile.build_config"
@@ -3841,12 +3838,8 @@ fi
 if test ${enable_reserved_header_bits+y}
 then :
   enableval=$enable_reserved_header_bits; case $enable_reserved_header_bits in #(
-  0) :
-    with_profinfo=false
-      profinfo_width=0 ;; #(
-  [1-9]|[1-2][0-9]|3[0-1]) :
-    with_profinfo=true
-      profinfo_width="$enable_reserved_header_bits" ;; #(
+  [0-9]|[1-2][0-9]|3[0-1]) :
+     reserved_header_bits=$enable_reserved_header_bits ;; #(
   *) :
     as_fn_error $? "invalid argument to --enable-reserved-header-bits" "$LINENO" 5 ;;
 esac
@@ -19078,13 +19071,8 @@ fi
 
 
 
-printf "%s\n" "#define PROFINFO_WIDTH $profinfo_width" >>confdefs.h
-
-if $profinfo
-then :
-  printf "%s\n" "#define WITH_PROFINFO 1" >>confdefs.h
+printf "%s\n" "#define HEADER_RESERVED_BITS $reserved_header_bits" >>confdefs.h
 
-fi
 
 if test x"$enable_installing_bytecode_programs" = "xno"
 then :
diff --git a/configure.ac b/configure.ac
index 6f143c3f46..a4d3a064c0 100644
--- a/configure.ac
+++ b/configure.ac
@@ -61,8 +61,7 @@ CSCFLAGS=""
 ostype="Unix"
 SO="so"
 toolchain="cc"
-profinfo=false
-profinfo_width=0
+reserved_header_bits=0
 instrumented_runtime=false
 instrumented_runtime_libs=""
 bootstrapping_flexdll=false
@@ -194,8 +193,7 @@ AC_SUBST([mksharedlibrpath])
 AC_SUBST([install_bytecode_programs])
 AC_SUBST([install_source_artifacts])
 AC_SUBST([install_ocamlnat])
-AC_SUBST([profinfo])
-AC_SUBST([profinfo_width])
+AC_SUBST([reserved_header_bits])
 AC_SUBST([frame_pointers])
 AC_SUBST([flambda])
 AC_SUBST([flambda_invariants])
@@ -424,15 +422,11 @@ AC_ARG_WITH([target-bindir],
 
 AC_ARG_ENABLE([reserved-header-bits],
   [AS_HELP_STRING([--enable-reserved-header-bits=BITS],
-  [reserve BITS (between 0 and 31) bits in block headers for profiling info])],
+    [reserve BITS (between 0 and 31) bits in block headers])],
   [AS_CASE([$enable_reserved_header_bits],
-    [0],
-      [with_profinfo=false
-      profinfo_width=0],
-    [[[1-9]]|[[1-2]][[0-9]]|3[[0-1]]],
-      [with_profinfo=true
-      profinfo_width="$enable_reserved_header_bits"],
-    [AC_MSG_ERROR([invalid argument to --enable-reserved-header-bits])])])
+    [[[0-9]]|[[1-2]][[0-9]]|3[[0-1]]],
+      [ reserved_header_bits=$enable_reserved_header_bits],
+  [AC_MSG_ERROR([invalid argument to --enable-reserved-header-bits])])])
 
 AC_ARG_ENABLE([stdlib-manpages],
   [AS_HELP_STRING([--disable-stdlib-manpages],
@@ -2014,8 +2008,7 @@ AS_IF([test x"$enable_frame_pointers" = "xyes"],
 ## Check for mmap support for huge pages and contiguous heap
 OCAML_MMAP_SUPPORTS_HUGE_PAGES
 
-AC_DEFINE_UNQUOTED([PROFINFO_WIDTH], [$profinfo_width])
-AS_IF([$profinfo], [AC_DEFINE([WITH_PROFINFO])])
+AC_DEFINE_UNQUOTED([HEADER_RESERVED_BITS], [$reserved_header_bits])
 
 AS_IF([test x"$enable_installing_bytecode_programs" = "xno"],
   [install_bytecode_programs=false],
diff --git a/runtime/caml/gc.h b/runtime/caml/gc.h
index 8d3505b1e8..663b89e836 100644
--- a/runtime/caml/gc.h
+++ b/runtime/caml/gc.h
@@ -20,16 +20,16 @@
 #include "mlvalues.h"
 
 /* This depends on the layout of the header.  See [mlvalues.h]. */
-#define Make_header(wosize, tag, color)                                       \
-      (/*CAMLassert ((wosize) <= Max_wosize),*/                               \
-       ((header_t) (((header_t) (wosize) << 10)                               \
-                    + (color)                                                 \
-                    + (tag_t) (tag)))                                         \
-      )
 
-#define Make_header_with_profinfo(wosize, tag, color, profinfo) \
-  Make_header(wosize, tag, color)
+#define Make_header_with_reserved(wosize, tag, color, reserved)      \
+      (/*CAMLassert ((wosize) <= Max_wosize),*/                      \
+       ((header_t) (Hd_reserved(reserved))                           \
+                    + ((header_t) (wosize) << HEADER_WOSIZE_SHIFT)   \
+                    + (color) /* colors are pre-shifted */           \
+                    + (tag_t) (tag)))
 
-#define Whitehd_hd(hd) (((hd)  & ~(3 << 8)))
+
+#define Make_header(wosize, tag, color) \
+        Make_header_with_reserved(wosize, tag, color, 0)
 
 #endif /* CAML_GC_H */
diff --git a/runtime/caml/m.h.in b/runtime/caml/m.h.in
index 0a16a4e59b..f38404676e 100644
--- a/runtime/caml/m.h.in
+++ b/runtime/caml/m.h.in
@@ -76,7 +76,7 @@
    supports word-aligned 64-bit integers.  Leave undefined if
    64-bit integers are not supported. */
 
-#undef PROFINFO_WIDTH
+#undef HEADER_RESERVED_BITS
 
 #undef ASM_CFI_SUPPORTED
 
@@ -84,8 +84,6 @@
 
 #define NO_NAKED_POINTERS 1
 
-#undef WITH_PROFINFO
-
 #undef CAML_WITH_FPIC
 
 #define CAML_SAFE_STRING 1
diff --git a/runtime/caml/memory.h b/runtime/caml/memory.h
index ce2353b3f3..92afc72223 100644
--- a/runtime/caml/memory.h
+++ b/runtime/caml/memory.h
@@ -35,16 +35,7 @@ extern "C" {
 
 CAMLextern value caml_alloc_shr (mlsize_t wosize, tag_t);
 CAMLextern value caml_alloc_shr_noexc(mlsize_t wosize, tag_t);
-#ifdef WITH_PROFINFO
-CAMLextern value caml_alloc_shr_with_profinfo (mlsize_t, tag_t, intnat);
-CAMLextern value caml_alloc_shr_preserving_profinfo (mlsize_t, tag_t,
-                                                     header_t);
-#else
-#define caml_alloc_shr_with_profinfo(size, tag, profinfo) \
-  caml_alloc_shr(size, tag)
-#define caml_alloc_shr_preserving_profinfo(size, tag, header) \
-  caml_alloc_shr(size, tag)
-#endif /* WITH_PROFINFO */
+CAMLextern value caml_alloc_shr_reserved (mlsize_t, tag_t, reserved_t);
 
 CAMLextern void caml_adjust_gc_speed (mlsize_t, mlsize_t);
 CAMLextern void caml_alloc_dependent_memory (mlsize_t bsz);
@@ -208,7 +199,7 @@ enum caml_alloc_small_flags {
 #define Alloc_small_enter_GC(dom_st, wosize)    \
   Alloc_small_enter_GC_flags(CAML_DO_TRACK | CAML_FROM_C, dom_st, wosize)
 
-#define Alloc_small_with_profinfo(result, wosize, tag, GC, profinfo) do{    \
+#define Alloc_small_with_reserved(result, wosize, tag, GC, reserved) do{    \
                                                 CAMLassert ((wosize) >= 1); \
                                           CAMLassert ((tag_t) (tag) < 256); \
                                  CAMLassert ((wosize) <= Max_young_wosize); \
@@ -218,13 +209,13 @@ enum caml_alloc_small_flags {
     GC(dom_st, wosize);                                                     \
   }                                                                         \
   Hd_hp (dom_st->young_ptr) =                                               \
-    Make_header_with_profinfo ((wosize), (tag), 0, profinfo);               \
+    Make_header_with_reserved((wosize), (tag), 0, (reserved));              \
   (result) = Val_hp (dom_st->young_ptr);                                    \
   DEBUG_clear ((result), (wosize));                                         \
 }while(0)
 
 #define Alloc_small(result, wosize, tag, GC) \
-  Alloc_small_with_profinfo(result, wosize, tag, GC, (uintnat)0)
+  Alloc_small_with_reserved(result, wosize, tag, GC, (uintnat)0)
 
 #endif /* CAML_INTERNALS */
 
diff --git a/runtime/caml/misc.h b/runtime/caml/misc.h
index eb4e5f56d2..95373cb0bc 100644
--- a/runtime/caml/misc.h
+++ b/runtime/caml/misc.h
@@ -25,6 +25,7 @@
 #include <stddef.h>
 #include <stdlib.h>
 #include <stdarg.h>
+#include <limits.h>
 
 #include "camlatomic.h"
 
diff --git a/runtime/caml/mlvalues.h b/runtime/caml/mlvalues.h
index 8810e1959e..417db443c9 100644
--- a/runtime/caml/mlvalues.h
+++ b/runtime/caml/mlvalues.h
@@ -56,6 +56,7 @@ extern "C" {
 
 typedef intnat value;
 typedef uintnat header_t;
+typedef header_t reserved_t;
 typedef uintnat mlsize_t;
 typedef unsigned int tag_t;             /* Actually, an unsigned char */
 typedef uintnat color_t;
@@ -98,47 +99,64 @@ bits  31    10 9     8 7   0
 
 For 64-bit architectures:
 
-     +--------+-------+-----+
-     | wosize | color | tag |
-     +--------+-------+-----+
-bits  63    10 9     8 7   0
+     +----------+--------+-------+-----+
+     | reserved | wosize | color | tag |
+     +----------+--------+-------+-----+
+bits  63    64-R 63-R  10 9     8 7   0
 
-For x86-64 with Spacetime profiling:
-  P = PROFINFO_WIDTH (as set by "configure", currently 26 bits, giving a
-    maximum block size of just under 4Gb)
-     +----------------+----------------+-------------+
-     | profiling info | wosize         | color | tag |
-     +----------------+----------------+-------------+
-bits  63        (64-P) (63-P)        10 9     8 7   0
+where 0 <= R <= 31 is HEADER_RESERVED_BITS, set with the
+--enable-reserved-header-bits=R argument to configure.
 
 */
 
-#define Tag_hd(hd) ((tag_t) ((hd) & 0xFF))
-
-#define Gen_profinfo_shift(width) (64 - (width))
-#define Gen_profinfo_mask(width) ((1ull << (width)) - 1ull)
-#define Gen_profinfo_hd(width, hd) \
-  (((mlsize_t) ((hd) >> (Gen_profinfo_shift(width)))) \
-   & (Gen_profinfo_mask(width)))
-
-#ifdef WITH_PROFINFO
-#define PROFINFO_SHIFT (Gen_profinfo_shift(PROFINFO_WIDTH))
-#define PROFINFO_MASK (Gen_profinfo_mask(PROFINFO_WIDTH))
-/* Use NO_PROFINFO to debug problems with profinfo macros */
-#define NO_PROFINFO 0xff
-#define Hd_no_profinfo(hd) ((hd) & ~(PROFINFO_MASK << PROFINFO_SHIFT))
-#define Wosize_hd(hd) ((mlsize_t) ((Hd_no_profinfo(hd)) >> 10))
-#define Profinfo_hd(hd) (Gen_profinfo_hd(PROFINFO_WIDTH, hd))
-#else
-#define NO_PROFINFO 0
-#define Wosize_hd(hd) ((mlsize_t) ((hd) >> 10))
-#define Profinfo_hd(hd) NO_PROFINFO
-#endif /* WITH_PROFINFO */
+#define HEADER_BITS (sizeof(header_t) * CHAR_BIT)
+
+#define HEADER_TAG_BITS 8
+#define HEADER_TAG_MASK ((1ull << HEADER_TAG_BITS) - 1ull)
+
+#define HEADER_COLOR_BITS 2
+#define HEADER_COLOR_SHIFT HEADER_TAG_BITS
+#define HEADER_COLOR_MASK (((1ull << HEADER_COLOR_BITS) - 1ull) \
+                            << HEADER_COLOR_SHIFT)
+
+#define HEADER_WOSIZE_BITS (HEADER_BITS - HEADER_TAG_BITS \
+                            - HEADER_COLOR_BITS - HEADER_RESERVED_BITS)
+#define HEADER_WOSIZE_SHIFT (HEADER_COLOR_SHIFT  + HEADER_COLOR_BITS)
+#define HEADER_WOSIZE_MASK (((1ull << HEADER_WOSIZE_BITS) - 1ull) \
+                             << HEADER_WOSIZE_SHIFT)
+
+#define Tag_hd(hd) ((tag_t) ((hd) & HEADER_TAG_MASK))
+#define Wosize_hd(hd) ((mlsize_t) (((hd) & HEADER_WOSIZE_MASK) \
+                                     >> HEADER_WOSIZE_SHIFT))
+
+/* A "clean" header, without reserved or color bits. */
+#define Cleanhd_hd(hd) (((header_t)(hd)) & \
+                        (HEADER_TAG_MASK | HEADER_WOSIZE_MASK))
+
+#if HEADER_RESERVED_BITS > 0
+
+#define HEADER_RESERVED_SHIFT (HEADER_BITS - HEADER_RESERVED_BITS)
+#define Reserved_hd(hd)   (((header_t) (hd)) >> HEADER_RESERVED_SHIFT)
+#define Hd_reserved(res)  ((header_t)(res) << HEADER_RESERVED_SHIFT)
+
+#else /* HEADER_RESERVED_BITS is 0 */
+
+#define Reserved_hd(hd)   ((reserved_t)0)
+#define Hd_reserved(res)  ((header_t)0)
+
+#endif
+
+/* Color values are pre-shifted */
+
+#define Color_hd(hd) ((hd) & HEADER_COLOR_MASK)
+#define Hd_with_color(hd, color) (((hd) &~ HEADER_COLOR_MASK) | (color))
 
 #define Hp_atomic_val(val) ((atomic_uintnat *)(val) - 1)
 #define Hd_val(val) ((header_t) \
   (atomic_load_explicit(Hp_atomic_val(val), memory_order_relaxed)))
 
+#define Color_val(val) (Color_hd (Hd_val (val)))
+
 #define Hd_hp(hp) (* ((header_t *) (hp)))              /* Also an l-value. */
 #define Hp_val(val) (((header_t *) (val)) - 1)
 #define Hp_op(op) (Hp_val (op))
@@ -148,16 +166,8 @@ bits  63        (64-P) (63-P)        10 9     8 7   0
 #define Op_hp(hp) ((value *) Val_hp (hp))
 #define Bp_hp(hp) ((char *) Val_hp (hp))
 
-#define Num_tags (1 << 8)
-#ifdef ARCH_SIXTYFOUR
-#ifdef WITH_PROFINFO
-#define Max_wosize (((intnat)1 << (54-PROFINFO_WIDTH)) - 1)
-#else
-#define Max_wosize (((intnat)1 << 54) - 1)
-#endif
-#else
-#define Max_wosize ((1 << 22) - 1)
-#endif /* ARCH_SIXTYFOUR */
+#define Num_tags (1ull << HEADER_TAG_BITS)
+#define Max_wosize ((1ull << HEADER_WOSIZE_BITS) - 1ull)
 
 #define Wosize_val(val) (Wosize_hd (Hd_val (val)))
 #define Wosize_op(op) (Wosize_val (op))
@@ -181,7 +191,7 @@ bits  63        (64-P) (63-P)        10 9     8 7   0
 #define Bhsize_hp(hp) (Bsize_wsize (Whsize_hp (hp)))
 #define Bhsize_hd(hd) (Bsize_wsize (Whsize_hd (hd)))
 
-#define Profinfo_val(val) (Profinfo_hd (Hd_val (val)))
+#define Reserved_val(val) (Reserved_hd (Hd_val (val)))
 
 #ifdef ARCH_BIG_ENDIAN
 #define Tag_val(val) (((unsigned char *) (val)) [-1])
@@ -432,12 +442,15 @@ CAMLextern value caml_set_oo_id(value obj);
 
 /* Header for out-of-heap blocks. */
 
-#define Caml_out_of_heap_header(wosize, tag)                                  \
-      (/*CAMLassert ((wosize) <= Max_wosize),*/                               \
-       ((header_t) (((header_t) (wosize) << 10)                               \
-           + (3 << 8) /* matches [NOT_MARKABLE]. See [shared_heap.h]. */      \
-           + (tag_t) (tag)))                                                  \
-      )
+#define Caml_out_of_heap_header_with_reserved(wosize, tag, reserved)   \
+      (/*CAMLassert ((wosize) <= Max_wosize),*/                        \
+       ((header_t) (Hd_reserved(reserved))                             \
+                    + ((header_t) (wosize) << HEADER_WOSIZE_SHIFT)     \
+                    + (3 << HEADER_COLOR_SHIFT) /* [NOT_MARKABLE] */   \
+                    + (tag_t) (tag)))
+
+#define Caml_out_of_heap_header(wosize, tag)                           \
+        Caml_out_of_heap_header_with_reserved(wosize, tag, 0)
 
 #ifdef __cplusplus
 }
diff --git a/runtime/caml/shared_heap.h b/runtime/caml/shared_heap.h
index ba7fb76a66..768415c586 100644
--- a/runtime/caml/shared_heap.h
+++ b/runtime/caml/shared_heap.h
@@ -30,7 +30,8 @@ struct pool;
 struct caml_heap_state* caml_init_shared_heap(void);
 void caml_teardown_shared_heap(struct caml_heap_state* heap);
 
-value* caml_shared_try_alloc(struct caml_heap_state*, mlsize_t, tag_t, int);
+value* caml_shared_try_alloc(struct caml_heap_state*,
+                             mlsize_t, tag_t, reserved_t, int);
 
 /* Copy the domain-local heap stats into a heap stats sample. */
 void caml_collect_heap_stats_sample(
@@ -57,26 +58,30 @@ struct global_heap_state {
 extern struct global_heap_state caml_global_heap_state;
 
 /* CR mshinwell: ensure this matches [Emitaux] */
-enum {NOT_MARKABLE = 3 << 8};
+enum {NOT_MARKABLE = 3 << HEADER_COLOR_SHIFT};
 
 Caml_inline int Has_status_hd(header_t hd, status s) {
-  return (hd & (3 << 8)) == s;
+  return Color_hd(hd) == s;
+}
+
+Caml_inline int Has_status_val(value v, status s) {
+  return Has_status_hd(Hd_val(v), s);
 }
 
 Caml_inline header_t With_status_hd(header_t hd, status s) {
-  return (hd & ~(3 << 8)) | s;
+  return Hd_with_color(hd, s);
 }
 
 Caml_inline int is_garbage(value v) {
-  return Has_status_hd(Hd_val(v), caml_global_heap_state.GARBAGE);
+  return Has_status_val(v, caml_global_heap_state.GARBAGE);
 }
 
 Caml_inline int is_unmarked(value v) {
-  return Has_status_hd(Hd_val(v), caml_global_heap_state.UNMARKED);
+  return Has_status_val(v, caml_global_heap_state.UNMARKED);
 }
 
 Caml_inline int is_marked(value v) {
-  return Has_status_hd(Hd_val(v), caml_global_heap_state.MARKED);
+  return Has_status_val(v, caml_global_heap_state.MARKED);
 }
 
 void caml_redarken_pool(struct pool*, scanning_action, void*);
diff --git a/runtime/hash.c b/runtime/hash.c
index f9ee23ccee..8567f27c19 100644
--- a/runtime/hash.c
+++ b/runtime/hash.c
@@ -259,7 +259,7 @@ CAMLprim value caml_hash(value count, value limit, value seed, value obj)
         startenv = Start_env_closinfo(Closinfo_val(v));
         CAMLassert (startenv <= len);
         /* Mix in the tag and size, but do not count this towards [num] */
-        h = caml_hash_mix_uint32(h, Whitehd_hd(Hd_val(v)));
+        h = caml_hash_mix_uint32(h, Cleanhd_hd(Hd_val(v)));
         /* Mix the code pointers, closure info fields, and infix headers */
         for (i = 0; i < startenv; i++) {
           h = caml_hash_mix_intnat(h, Field(v, i));
@@ -280,7 +280,7 @@ CAMLprim value caml_hash(value count, value limit, value seed, value obj)
 
       default:
         /* Mix in the tag and size, but do not count this towards [num] */
-        h = caml_hash_mix_uint32(h, Whitehd_hd(Hd_val(v)));
+        h = caml_hash_mix_uint32(h, Cleanhd_hd(Hd_val(v)));
         /* Copy fields into queue, not exceeding the total size [sz] */
         for (i = 0, len = Wosize_val(v); i < len; i++) {
           if (wr >= sz) break;
diff --git a/runtime/intern.c b/runtime/intern.c
index 6d373ef3c8..cc68302a8d 100644
--- a/runtime/intern.c
+++ b/runtime/intern.c
@@ -379,7 +379,9 @@ static value intern_alloc_obj(struct caml_intern_state* s, caml_domain_state* d,
     *s->intern_dest = Make_header (wosize, tag, 0);
     s->intern_dest += 1 + wosize;
   } else {
-    p = caml_shared_try_alloc(d->shared_heap, wosize, tag, 0 /* not pinned */);
+    p = caml_shared_try_alloc(d->shared_heap, wosize, tag,
+                              0, /* no reserved bits */
+                              0 /* not pinned */);
     d->allocated_words += Whsize_wosize(wosize);
     if (p == NULL) {
       intern_cleanup (s);
diff --git a/runtime/major_gc.c b/runtime/major_gc.c
index 42d2e090cd..1605e07a8f 100644
--- a/runtime/major_gc.c
+++ b/runtime/major_gc.c
@@ -231,7 +231,7 @@ static void orph_ephe_list_verify_status (int status)
   v = orph_structs.ephe_list_live;
   while (v) {
     CAMLassert (Tag_val(v) == Abstract_tag);
-    CAMLassert (Has_status_hd (Hd_val(v), status));
+    CAMLassert (Has_status_val(v, status));
     v = Ephe_link(v);
   }
 
@@ -638,7 +638,7 @@ static intnat mark_stack_push_block(struct mark_stack* stk, value block)
       && offset >= Start_env_closinfo(Closinfo_val(block)));
   }
 
-  CAMLassert(Has_status_hd(Hd_val(block), caml_global_heap_state.MARKED));
+  CAMLassert(Has_status_val(block, caml_global_heap_state.MARKED));
   CAMLassert(Is_block(block) && !Is_young(block));
   CAMLassert(Tag_val(block) != Infix_tag);
   CAMLassert(Tag_val(block) < No_scan_tag);
diff --git a/runtime/memory.c b/runtime/memory.c
index eb0a969441..3af3a6f72b 100644
--- a/runtime/memory.c
+++ b/runtime/memory.c
@@ -328,11 +328,13 @@ CAMLexport void caml_set_fields (value obj, value v)
   }
 }
 
-Caml_inline value alloc_shr(mlsize_t wosize, tag_t tag, int noexc)
+Caml_inline value alloc_shr(mlsize_t wosize, tag_t tag, reserved_t reserved,
+                            int noexc)
 {
   Caml_check_caml_state();
   caml_domain_state *dom_st = Caml_state;
-  value *v = caml_shared_try_alloc(dom_st->shared_heap, wosize, tag, 0);
+  value *v = caml_shared_try_alloc(dom_st->shared_heap,
+                                   wosize, tag, reserved, 0);
   if (v == NULL) {
     if (!noexc)
       caml_raise_out_of_memory();
@@ -358,11 +360,19 @@ Caml_inline value alloc_shr(mlsize_t wosize, tag_t tag, int noexc)
 
 CAMLexport value caml_alloc_shr(mlsize_t wosize, tag_t tag)
 {
-  return alloc_shr(wosize, tag, 0);
+  return alloc_shr(wosize, tag, 0, 0);
 }
 
+CAMLexport value caml_alloc_shr_reserved(mlsize_t wosize,
+                                         tag_t tag,
+                                         reserved_t reserved)
+{
+  return alloc_shr(wosize, tag, reserved, 0);
+}
+
+
 CAMLexport value caml_alloc_shr_noexc(mlsize_t wosize, tag_t tag) {
-  return alloc_shr(wosize, tag, 1);
+  return alloc_shr(wosize, tag, 0, 1);
 }
 
 /* Global memory pool.
diff --git a/runtime/minor_gc.c b/runtime/minor_gc.c
index 4fba95f05a..ca8c8f9221 100644
--- a/runtime/minor_gc.c
+++ b/runtime/minor_gc.c
@@ -147,10 +147,11 @@ struct oldify_state {
   caml_domain_state* domain;
 };
 
-static value alloc_shared(caml_domain_state* d, mlsize_t wosize, tag_t tag)
+static value alloc_shared(caml_domain_state* d,
+                          mlsize_t wosize, tag_t tag, reserved_t reserved)
 {
   void* mem = caml_shared_try_alloc(d->shared_heap, wosize, tag,
-                                    0 /* not pinned */);
+                                    reserved, 0 /* not pinned */);
   d->allocated_words += Whsize_wosize(wosize);
   if (mem == NULL) {
     caml_fatal_error("allocation failure during minor GC");
@@ -270,7 +271,7 @@ static void oldify_one (void* st_v, value v, volatile value *p)
   if (tag == Cont_tag) {
     value stack_value = Field(v, 0);
     CAMLassert(Wosize_hd(hd) == 1 && infix_offset == 0);
-    result = alloc_shared(st->domain, 1, Cont_tag);
+    result = alloc_shared(st->domain, 1, Cont_tag, Reserved_hd(hd));
     if( try_update_object_header(v, p, result, 0) ) {
       struct stack_info* stk = Ptr_val(stack_value);
       Field(result, 0) = Val_ptr(stk);
@@ -292,7 +293,7 @@ static void oldify_one (void* st_v, value v, volatile value *p)
     value field0;
     sz = Wosize_hd (hd);
     st->live_bytes += Bhsize_hd(hd);
-    result = alloc_shared(st->domain, sz, tag);
+    result = alloc_shared(st->domain, sz, tag, Reserved_hd(hd));
     field0 = Field(v, 0);
     if( try_update_object_header(v, p, result, infix_offset) ) {
       if (sz > 1){
@@ -322,7 +323,7 @@ static void oldify_one (void* st_v, value v, volatile value *p)
   } else if (tag >= No_scan_tag) {
     sz = Wosize_hd (hd);
     st->live_bytes += Bhsize_hd(hd);
-    result = alloc_shared(st->domain, sz, tag);
+    result = alloc_shared(st->domain, sz, tag, Reserved_hd(hd));
     for (i = 0; i < sz; i++) {
       Field(result, i) = Field(v, i);
     }
@@ -355,7 +356,7 @@ static void oldify_one (void* st_v, value v, volatile value *p)
       /* Do not short-circuit the pointer.  Copy as a normal block. */
       CAMLassert (Wosize_hd (hd) == 1);
       st->live_bytes += Bhsize_hd(hd);
-      result = alloc_shared(st->domain, 1, Forward_tag);
+      result = alloc_shared(st->domain, 1, Forward_tag, Reserved_hd(hd));
       if( try_update_object_header(v, p, result, 0) ) {
         p = Op_val (result);
         v = f;
diff --git a/runtime/shared_heap.c b/runtime/shared_heap.c
index 886779f7ce..0859801a01 100644
--- a/runtime/shared_heap.c
+++ b/runtime/shared_heap.c
@@ -34,7 +34,13 @@
 #include "caml/startup_aux.h"
 
 typedef unsigned int sizeclass;
-struct global_heap_state caml_global_heap_state = {0 << 8, 1 << 8, 2 << 8};
+
+/* Initial MARKED, UNMARKED, and GARBAGE values; any permutation would work */
+struct global_heap_state caml_global_heap_state = {
+  0 << HEADER_COLOR_SHIFT,
+  1 << HEADER_COLOR_SHIFT,
+  2 << HEADER_COLOR_SHIFT,
+};
 
 typedef struct pool {
   struct pool* next;
@@ -389,7 +395,7 @@ static void* large_allocate(struct caml_heap_state* local, mlsize_t sz) {
 }
 
 value* caml_shared_try_alloc(struct caml_heap_state* local, mlsize_t wosize,
-                             tag_t tag, int pinned)
+                             tag_t tag, reserved_t reserved, int pinned)
 {
   mlsize_t whsize = Whsize_wosize(wosize);
   value* p;
@@ -415,7 +421,7 @@ value* caml_shared_try_alloc(struct caml_heap_state* local, mlsize_t wosize,
     if (!p) return 0;
   }
   colour = pinned ? NOT_MARKABLE : caml_global_heap_state.MARKED;
-  Hd_hp (p) = Make_header(wosize, tag, colour);
+  Hd_hp (p) = Make_header_with_reserved(wosize, tag, colour, reserved);
 #ifdef DEBUG
   {
     int i;
@@ -746,10 +752,10 @@ static void verify_object(struct heap_verify_state* st, value v) {
   if (*entry != ADDRMAP_NOT_PRESENT) return;
   *entry = 1;
 
-  if (Has_status_hd(Hd_val(v), NOT_MARKABLE)) return;
+  if (Has_status_val(v, NOT_MARKABLE)) return;
   st->objs++;
 
-  CAMLassert(Has_status_hd(Hd_val(v), caml_global_heap_state.UNMARKED));
+  CAMLassert(Has_status_val(v, caml_global_heap_state.UNMARKED));
 
   if (Tag_val(v) == Cont_tag) {
     struct stack_info* stk = Ptr_val(Field(v, 0));
diff --git a/runtime/startup_byt.c b/runtime/startup_byt.c
index bd061ab89a..6e35de7657 100644
--- a/runtime/startup_byt.c
+++ b/runtime/startup_byt.c
@@ -412,13 +412,7 @@ static void do_print_config(void)
          "false");
 #endif
   printf("no_naked_pointers: true\n");
-  printf("profinfo: %s\n"
-         "profinfo_width: %d\n",
-#ifdef WITH_PROFINFO
-         "true", PROFINFO_WIDTH);
-#else
-         "false", 0);
-#endif
+  printf("reserved header bits: %d\n", HEADER_RESERVED_BITS);
   printf("exec_magic_number: %s\n", EXEC_MAGIC);
 
   /* Parse ld.conf and print the effective search path */
diff --git a/utils/config.fixed.ml b/utils/config.fixed.ml
index fe82c904f0..1299aa682f 100644
--- a/utils/config.fixed.ml
+++ b/utils/config.fixed.ml
@@ -58,8 +58,7 @@ let system = "unknown"
 let asm = boot_cannot_call "the assembler"
 let asm_cfi_supported = false
 let with_frame_pointers = false
-let profinfo = false
-let profinfo_width = 0
+let reserved_header_bits = 0
 let ext_exe = ".ex_The boot compiler should not be using Config.ext_exe"
 let ext_obj = ".o_The boot compiler cannot process C objects"
 let ext_asm = ".s_The boot compiler should not be using Config.ext_asm"
diff --git a/utils/config.generated.ml.in b/utils/config.generated.ml.in
index ad7ee66e26..c6c9114465 100644
--- a/utils/config.generated.ml.in
+++ b/utils/config.generated.ml.in
@@ -94,8 +94,7 @@ let system = {@QS@|@system@|@QS@}
 let asm = {@QS@|@AS@|@QS@}
 let asm_cfi_supported = @asm_cfi_supported@
 let with_frame_pointers = @frame_pointers@
-let profinfo = @profinfo@
-let profinfo_width = @profinfo_width@
+let reserved_header_bits = @reserved_header_bits@
 
 let ext_exe = {@QS@|@exeext@|@QS@}
 let ext_obj = "." ^ {@QS@|@OBJEXT@|@QS@}
diff --git a/utils/config.mli b/utils/config.mli
index db3dfc8455..07e99457b8 100644
--- a/utils/config.mli
+++ b/utils/config.mli
@@ -216,12 +216,8 @@ val with_flambda_invariants : bool
 val with_cmm_invariants : bool
 (** Whether the invariants checks for Cmm are enabled *)
 
-val profinfo : bool
-(** Whether the compiler was configured for profiling *)
-
-val profinfo_width : int
-(** How many bits are to be used in values' headers for profiling
-    information *)
+val reserved_header_bits : int
+(** How many bits of a block's header are reserved *)
 
 val flat_float_array : bool
 (** Whether the compiler and runtime automagically flatten float