Forward port is_last closinfo flag

Author: TheNumbat

ocaml/runtime/alloc.c

@@ -312,7 +312,7 @@ CAMLprim value caml_alloc_dummy_infix(value vsize, value voffset)
      block contains no pointers into the heap.  However, the block
      cannot be marshaled or hashed, because not all closinfo fields
      and infix header fields are correctly initialized. */
-  Closinfo_val(v) = Make_closinfo(0, wosize);
+  Closinfo_val(v) = Make_closinfo(0, wosize, 1);
   if (offset > 0) {
     v += Bsize_wsize(offset);
     (((header_t *) (v)) [-1]) = Make_header(offset, Infix_tag, 0);

ocaml/runtime/caml/mlvalues.h

@@ -276,20 +276,28 @@ Caml_inline void* Ptr_val(value val)
 #define Code_val(val) (((code_t *) (val)) [0])     /* Also an l-value. */
 #define Closinfo_val(val) Field((val), 1)          /* Arity and start env */
 /* In the closure info field, the top 8 bits are the arity (signed).
+   The next least significant bit is set iff the current closure is the
+   last one to occur in the block.  (This is used in the compactor.)
    The low bit is set to one, to look like an integer.
-   The remaining bits are the field number for the first word of the
-   environment, or, in other words, the offset (in words) from the closure
-   to the environment part. */
+   The remaining bits are the field number for the first word of the scannable
+   part of the environment, or, in other words, the offset (in words) from the
+   closure to the scannable part of the environment.
+   The non-scannable part of the environment lives between the end of the
+   last closure and the start of the scannable environment within the block. */
 #ifdef ARCH_SIXTYFOUR
 #define Arity_closinfo(info) ((intnat)(info) >> 56)
-#define Start_env_closinfo(info) (((uintnat)(info) << 8) >> 9)
-#define Make_closinfo(arity,delta) \
-  (((uintnat)(arity) << 56) + ((uintnat)(delta) << 1) + 1)
+#define Start_env_closinfo(info) (((uintnat)(info) << 9) >> 10)
+#define Is_last_closinfo(info) (((uintnat)(info) << 8) >> 63)
+#define Make_closinfo(arity,delta,is_last) \
+  (((uintnat)(arity) << 56) + ((uintnat)(is_last) << 55) \
+    + ((uintnat)(delta) << 1) + 1)
 #else
 #define Arity_closinfo(info) ((intnat)(info) >> 24)
-#define Start_env_closinfo(info) (((uintnat)(info) << 8) >> 9)
-#define Make_closinfo(arity,delta) \
-  (((uintnat)(arity) << 24) + ((uintnat)(delta) << 1) + 1)
+#define Start_env_closinfo(info) (((uintnat)(info) << 9) >> 10)
+#define Is_last_closinfo(info) (((uintnat)(info) << 8) >> 31)
+#define Make_closinfo(arity,delta,is_last) \
+  (((uintnat)(arity) << 24) + ((uintnat)(is_last) << 23) \
+    + ((uintnat)(delta) << 1) + 1)
 #endif
 
 /* This tag is used (with Forcing_tag & Forward_tag) to implement lazy values.

ocaml/runtime/interp.c

@@ -300,7 +300,7 @@ value caml_interprete(code_t prog, asize_t prog_size)
     raise_unhandled_effect_closure = caml_alloc_small (2, Closure_tag);
     Code_val(raise_unhandled_effect_closure) =
       (code_t)raise_unhandled_effect_code;
-    Closinfo_val(raise_unhandled_effect_closure) = Make_closinfo(0, 2);
+    Closinfo_val(raise_unhandled_effect_closure) = Make_closinfo(0, 2, 1);
     raise_unhandled_effect = raise_unhandled_effect_closure;
     caml_register_generational_global_root(&raise_unhandled_effect);
     caml_global_data = Val_unit;
@@ -624,7 +624,7 @@ value caml_interprete(code_t prog, asize_t prog_size)
         Field(accu, 2) = env;
         for (i = 0; i < num_args; i++) Field(accu, i + 3) = sp[i];
         Code_val(accu) = pc - 3; /* Point to the preceding RESTART instr. */
-        Closinfo_val(accu) = Make_closinfo(0, 2);
+        Closinfo_val(accu) = Make_closinfo(0, 2, 1);
         sp += num_args;
         goto do_return;
       }
@@ -648,7 +648,7 @@ value caml_interprete(code_t prog, asize_t prog_size)
       /* The code pointer is not in the heap, so no need to go through
          caml_initialize. */
       Code_val(accu) = pc + *pc;
-      Closinfo_val(accu) = Make_closinfo(0, 2);
+      Closinfo_val(accu) = Make_closinfo(0, 2, 1);
       pc++;
       sp += nvars;
       Next;
@@ -680,13 +680,13 @@ value caml_interprete(code_t prog, asize_t prog_size)
       *--sp = accu;
       p = &Field(accu, 0);
       *p++ = (value) (pc + pc[0]);
-      *p++ = Make_closinfo(0, envofs);
+      *p++ = Make_closinfo(0, envofs, nfuncs < 2);
       for (i = 1; i < nfuncs; i++) {
         *p++ = Make_header(i * 3, Infix_tag, 0); /* color irrelevant */
         *--sp = (value) p;
         *p++ = (value) (pc + pc[i]);
         envofs -= 3;
-        *p++ = Make_closinfo(0, envofs);
+        *p++ = Make_closinfo(0, envofs, i == nfuncs - 1);
       }
       pc += nfuncs;
       Next;

ocaml/runtime/meta.c

@@ -121,7 +121,7 @@ CAMLprim value caml_reify_bytecode(value ls_prog,
 
   clos = caml_alloc_small (2, Closure_tag);
   Code_val(clos) = (code_t) prog;
-  Closinfo_val(clos) = Make_closinfo(0, 2);
+  Closinfo_val(clos) = Make_closinfo(0, 2, 1);
   bytecode = caml_alloc_small (2, Abstract_tag);
   Bytecode_val(bytecode)->prog = prog;
   Bytecode_val(bytecode)->len = len;

ocaml/runtime/obj.c

@@ -108,7 +108,7 @@ CAMLprim value caml_obj_block(value tag, value size)
     /* Closinfo_val is the second field, so we need size at least 2 */
     if (sz < 2) caml_invalid_argument ("Obj.new_block");
     res = caml_alloc(sz, tg);
-    Closinfo_val(res) = Make_closinfo(0, 2); /* does not allocate */
+    Closinfo_val(res) = Make_closinfo(0, 2, 1); /* does not allocate */
     break;
   }
   case String_tag: {