runtime changes

runtime/caml/intext.h

@@ -99,6 +99,7 @@
 #define CODE_CUSTOM_LEN 0x18
 #define CODE_CUSTOM_FIXED 0x19
 #define CODE_UNBOXED_INT64 0x1a
+#define CODE_NULL 0x1b
 
 #if ARCH_FLOAT_ENDIANNESS == 0x76543210
 #define CODE_DOUBLE_NATIVE CODE_DOUBLE_BIG

runtime/caml/mlvalues.h

@@ -91,6 +91,9 @@ typedef opcode_t * code_t;
 #define Is_exception_result(v) (((v) & 3) == 2)
 #define Extract_exception(v) ((v) & ~3)
 
+/* or_null */
+#define Val_null ((value) 0)
+
 /* Structure of the header:
 
 For 16-bit and 32-bit architectures:

runtime/compare.c

@@ -140,9 +140,9 @@ static intnat do_compare_val(struct compare_stack* stk,
     poll_timer = COMPARE_POLL_PERIOD;
     while (--poll_timer > 0) {
       if (v1 == v2 && total) goto next_item;
-      if (Is_long(v1)) {
+      if (Is_long(v1) || v1 == Val_null) {
         if (v1 == v2) goto next_item;
-        if (Is_long(v2))
+        if (Is_long(v2) || v2 == Val_null)
           return Long_val(v1) - Long_val(v2);
         /* Subtraction above cannot overflow and cannot result in UNORDERED */
         switch (Tag_val(v2)) {
@@ -165,7 +165,7 @@ static intnat do_compare_val(struct compare_stack* stk,
 
         return LESS;                /* v1 long < v2 block */
       }
-      if (Is_long(v2)) {
+      if (Is_long(v2) || v2 == Val_null) {
         switch (Tag_val(v1)) {
           case Forward_tag:
             v1 = Forward_val(v1);

runtime/extern.c

@@ -601,6 +601,11 @@ Caml_inline void extern_unboxed_int(struct caml_extern_state* s, intnat n)
   writecode64(s, CODE_UNBOXED_INT64, n);
 }
 
+Caml_inline void extern_null(struct caml_extern_state* s)
+{
+  writecode8(s, CODE_NULL, 0);
+}
+
 /* Marshaling references to previously-marshaled blocks */
 
 Caml_inline void extern_shared_reference(struct caml_extern_state* s,
@@ -807,7 +812,9 @@ static void extern_rec(struct caml_extern_state* s, value v)
   sp = s->extern_stack;
 
   while(1) {
-  if (Is_long(v)) {
+  if (v == Val_null) {
+    extern_null(s);
+  } else if (Is_long(v)) {
     extern_int(s, Long_val(v));
   }
   else {

runtime/fiber.c

@@ -352,7 +352,7 @@ static int visit(scanning_action f, void* fdata,
   value v = *p, vblock = v;
   header_t hd;
   int ix;
-  if (!Is_block(v))
+  if (v == Val_null || !Is_block(v))
     return -1;
 
   if (Is_young(v)) {
@@ -635,7 +635,7 @@ CAMLprim value caml_ensure_stack_capacity(value required_space)
  Caml_inline int is_scannable(scanning_action_flags flags, value v) {
   return
       (flags & SCANNING_ONLY_YOUNG_VALUES)
-      || (Is_block(v) && caml_find_code_fragment_by_pc((char *) v) == NULL);
+      || (v != Val_null && Is_block(v) && caml_find_code_fragment_by_pc((char *) v) == NULL);
 }
 
 void caml_scan_stack(

runtime/hash.c

@@ -209,7 +209,7 @@ CAMLprim value caml_hash_exn(value count, value limit, value seed, value obj)
   while (rd < wr && num > 0) {
     v = queue[rd++];
   again:
-    if (Is_long(v)) {
+    if (Is_long(v) || v == Val_null) {
       h = caml_hash_mix_intnat(h, v);
       num--;
     } else {

runtime/intern.c

@@ -569,6 +569,10 @@ static void intern_rec(struct caml_intern_state* s,
         caml_failwith("input_value: CODE_UNBOXED_INT64 not supported on 32 bit");
         break;
 #endif
+      case CODE_NULL:
+        read8s(s);
+        v = Val_null;
+        break;
       case CODE_SHARED8:
         ofs = read8u(s);
       read_shared:

runtime/major_gc.c

@@ -254,7 +254,7 @@ Caml_inline void pb_fill_mode(prefetch_buffer_t *pb)
 
 Caml_inline void pb_push(prefetch_buffer_t* pb, value v)
 {
-  CAMLassert(Is_block(v) && !Is_young(v));
+  CAMLassert(v != Val_null && Is_block(v) && !Is_young(v));
   CAMLassert(v != Debug_free_major);
   CAMLassert(pb->enqueued < pb->dequeued + PREFETCH_BUFFER_SIZE);
 
@@ -832,9 +832,9 @@ static void mark_stack_prune(struct mark_stack* stk);
 #ifdef DEBUG
 #define Is_markable(v) \
     (CAMLassert (v != Debug_free_major), \
-     Is_block(v) && !Is_young(v))
+     (v != Val_null) && Is_block(v) && !Is_young(v))
 #else
-#define Is_markable(v) (Is_block(v) && !Is_young(v))
+#define Is_markable(v) (v != Val_null && Is_block(v) && !Is_young(v))
 #endif
 
 static void realloc_mark_stack (struct mark_stack* stk)
@@ -911,6 +911,7 @@ static intnat mark_stack_push_block(struct mark_stack* stk, value block)
   }
 
   CAMLassert(Has_status_val(block, caml_global_heap_state.MARKED));
+  CAMLassert(block != Val_null);
   CAMLassert(Is_block(block) && !Is_young(block));
   CAMLassert(Tag_val(block) != Infix_tag);
   CAMLassert(Tag_val(block) < No_scan_tag);
@@ -1220,7 +1221,7 @@ static scanning_action_flags darken_scanning_flags = 0;
 
 void caml_darken_cont(value cont)
 {
-  CAMLassert(Is_block(cont) && !Is_young(cont) && Tag_val(cont) == Cont_tag);
+  CAMLassert(cont != Val_null && Is_block(cont) && !Is_young(cont) && Tag_val(cont) == Cont_tag);
   {
     SPIN_WAIT {
       header_t hd = atomic_load_relaxed(Hp_atomic_val(cont));
@@ -1314,10 +1315,10 @@ static intnat ephe_mark (intnat budget, uintnat for_cycle,
     for (i = CAML_EPHE_FIRST_KEY; alive_data && i < size; i++) {
       key = Field(v, i);
     ephemeron_again:
-      if (key != caml_ephe_none && Is_block(key)) {
+      if (key != caml_ephe_none && key != Val_null && Is_block(key)) {
         if (Tag_val(key) == Forward_tag) {
           f = Forward_val(key);
-          if (Is_block(f)) {
+          if (f != Val_null && Is_block(f)) {
             if (Tag_val(f) == Forward_tag || Tag_val(f) == Lazy_tag ||
                 Tag_val(f) == Forcing_tag || Tag_val(f) == Double_tag) {
               /* Do not short-circuit the pointer */
@@ -1337,7 +1338,7 @@ static intnat ephe_mark (intnat budget, uintnat for_cycle,
     budget -= Whsize_wosize(i);
 
     if (force_alive || alive_data) {
-      if (data != caml_ephe_none && Is_block(data)) {
+      if (data != caml_ephe_none && data != Val_null && Is_block(data)) {
         caml_darken (domain_state, data, 0);
       }
       Ephe_link(v) = domain_state->ephe_info->live;

runtime/minor_gc.c

@@ -130,7 +130,7 @@ extern int caml_debug_is_minor(value val) {
 }
 
 extern int caml_debug_is_major(value val) {
-  return Is_block(val) && !Is_young(val);
+  return val != Val_null && Is_block(val) && !Is_young(val);
 }
 #endif
 
@@ -260,7 +260,7 @@ static void oldify_one (void* st_v, value v, volatile value *p)
   tag_t tag;
 
   tail_call:
-  if (!(Is_block(v) && Is_young(v))) {
+  if (v == Val_null || !(Is_block(v) && Is_young(v))) {
     /* not a minor block */
     *p = v;
     return;
@@ -385,7 +385,7 @@ static void oldify_one (void* st_v, value v, volatile value *p)
     f = Forward_val (v);
     ft = 0;
 
-    if (Is_block (f)) {
+    if (f != Val_null && Is_block (f)) {
       ft = Tag_val (get_header_val(f) == 0 ? Field(f, 0) : f);
     }
 
@@ -676,7 +676,7 @@ void caml_empty_minor_heap_promote(caml_domain_state* domain,
   for (r = self_minor_tables->major_ref.base;
        r < self_minor_tables->major_ref.ptr; r++) {
     value vnew = **r;
-    CAMLassert (!Is_block(vnew)
+    CAMLassert ((vnew == Val_null || !Is_block(vnew))
             || (get_header_val(vnew) != 0 && !Is_young(vnew)));
   }
 #endif

runtime/shared_heap.c

@@ -533,7 +533,7 @@ static intnat pool_sweep(struct caml_heap_state* local, pool** plist,
         /* add to freelist */
         atomic_store_relaxed((atomic_uintnat*)p, 0);
         p[1] = (value)a->next_obj;
-        CAMLassert(Is_block((value)p));
+        CAMLassert((value) p != Val_null && Is_block((value)p));
 #ifdef DEBUG
         {
           int i;
@@ -780,7 +780,7 @@ struct heap_verify_state* caml_verify_begin (void)
 static void verify_push (void* st_v, value v, volatile value* ignored)
 {
   struct heap_verify_state* st = st_v;
-  if (!Is_block(v)) return;
+  if (v == Val_null || !Is_block(v)) return;
 
   if (st->sp == st->stack_len) {
     st->stack_len = st->stack_len * 2 + 100;
@@ -799,7 +799,7 @@ static scanning_action_flags verify_scanning_flags = 0;
 
 static void verify_object(struct heap_verify_state* st, value v) {
   intnat* entry;
-  if (!Is_block(v)) return;
+  if (v == Val_null || !Is_block(v)) return;
 
   CAMLassert (!Is_young(v));
   CAMLassert (Hd_val(v));
@@ -830,7 +830,8 @@ static void verify_object(struct heap_verify_state* st, value v) {
     mlsize_t scannable_wosize = Scannable_wosize_val(v);
     for (; i < scannable_wosize; i++) {
       value f = Field(v, i);
-      if (Is_block(f)) verify_push(st, f, Op_val(v)+i);
+      if (v != Val_null && Is_block(f))
+        verify_push(st, f, Op_val(v)+i);
     }
   }
 }
@@ -859,7 +860,7 @@ static inline void compact_update_value(void* ignored,
                                         value v,
                                         volatile value* p)
 {
-  if (Is_block(v)) {
+  if (v != Val_null && Is_block(v)) {
     CAMLassert(!Is_young(v));
 
     tag_t tag = Tag_val(v);
@@ -884,7 +885,7 @@ static inline void compact_update_value(void* ignored,
          to update to the new location. */
       if (Has_status_val(v, caml_global_heap_state.MARKED)) {
         value fwd = Field(v, 0) + infix_offset;
-        CAMLassert(Is_block(fwd));
+        CAMLassert(fwd != Val_null && Is_block(fwd));
         CAMLassert(Tag_val(fwd) == tag);
         *p = fwd;
       }