Naked pointers crash on trunk #9950
Description
Hello everyone,
While working on the naked pointer checker (see #9947 and #9534), I attempted to run the test program provided by #9534 and encountered crashes on trunk (in the default runtime, with naked pointers enabled.)
This program used to work on 4.10 and 4.11, and now leads to a segfault:
(rr) c
Continuing.
**** Begin full major GC ****
**** End full major GC ****
**** Begin full major GC ****
**** End full major GC ****
**** Begin full major GC ****
**** End full major GC ****
**** Begin full major GC ****
Program received signal SIGSEGV, Segmentation fault.
0x00005562cf2e74e9 in mark_stack_push (work=0x0, offset=0, block=140569830424568, stk=<optimized out>) at major_gc.c:244
warning: Source file is more recent than executable.
244 if (Is_block(v) && !Is_black_val(v))
(rr) bt
#0 0x00005562cf2e74e9 in mark_stack_push (work=0x0, offset=0, block=140569830424568, stk=<optimized out>) at major_gc.c:244
#1 caml_darken (v=140569830424568, p=<optimized out>) at major_gc.c:301
#2 0x00005562cf2e5291 in caml_darken_all_roots_slice (work=work@entry=9223372036854775804) at roots_nat.c:375
#3 0x00005562cf2e6df0 in mark_slice (work=9223372036854775804, work@entry=9223372036854775807) at major_gc.c:609
#4 0x00005562cf2e7e40 in caml_finish_major_cycle () at major_gc.c:967
#5 0x00005562cf2f7240 in caml_gc_full_major (v=<optimized out>) at gc_ctrl.c:590
#6 0x00005562cf2c6d51 in camlTest__do_gc_216 () at roots_nat.c:159
#7 0x00005562cf2c6fc4 in camlTest__entry () at roots_nat.c:159
#8 0x00005562cf2c4869 in caml_program () at roots_nat.c:159
#9 0x00005562cf30160c in caml_start_program ()
#10 0x00005562cf301e44 in caml_startup_common (argv=0x7ffc345c8258, pooling=<optimized out>, pooling@entry=0) at startup_nat.c:164
#11 0x00005562cf301e8f in caml_startup_exn (argv=<optimized out>) at startup_nat.c:174
#12 caml_startup (argv=<optimized out>) at startup_nat.c:174
#13 0x00005562cf2c4662 in main (argc=<optimized out>, argv=<optimized out>) at main.c:41
Maybe this could be related to the recent changes with the Gc colours or connected to issues with the compactor I remember reading about in another issue?
Here is the sample program as provided previously:
/* cstub.c */
#include "caml/mlvalues.h"
value make_block (value header, value size) {
int64_t* p = (int64_t*)malloc(sizeof(int64_t) * (Int64_val(size) + 1));
p[0] = Int64_val(header);
return (value)&p[1];
}
value get_raw_pointer (value v) {
return (value)Int64_val(v);
}
(* test.ml *)
external make_block : int64 -> int64 -> Obj.t = "make_block"
external get_raw_pointer : int64 -> Obj.t = "get_raw_pointer"
(* See runtime/caml/gc.h *)
let white = 0L
let gray = 1L
let blue = 2L
let black = 3L
(* See runtime/caml/mlvalues.h *)
let mk_header tag colour size =
let open Int64 in
assert (colour >= 0L && colour <= 3L);
assert (tag >= 0L && tag <= 255L);
assert (size >=0L);
logor (shift_left size 10) (logor (shift_left colour 8) tag)
let do_gc () =
print_endline "**** Begin full major GC ****";
Gc.full_major ();
print_endline "**** End full major GC ****"
(* External object with black header is accepted. GC doesn't scan black
* objects. *)
let ex1 =
let h = mk_header 0L black 1000L in
let e = make_block h 1000L in
let o = Obj.new_block 0 1 in
Obj.set_field o 0 e;
o
let _ = do_gc ()
(* External object with size 0 is accepted. GC doesn't scan 0 sized objects. *)
let ex2 =
(* The header may be non-black for 0 sized object *)
let h = mk_header 0L white 0L in
(* The actual size of the object in memory may be different *)
let e = make_block h 1000L in
let o = Obj.new_block 0 1 in
Obj.set_field o 0 e;
o
let _ = do_gc ()
(* A non-zero-sized external object cannot be non-black. *)
let ex3 =
let h = mk_header 0L white 1000L in
let e = make_block h 1000L in
let o = Obj.new_block 0 1 in
Obj.set_field o 0 e;
o
let _ = do_gc ()
(* If external pointers point to unallocated memory, a warning is generated *)
let ex3 =
let o = Obj.new_block 0 1 in
Obj.set_field o 0 (get_raw_pointer 42L);
o
let _ = do_gc ()
let _ = [ex1; ex2; ex3]
ocamlopt.opt -g test.ml cstub.c
Have a very nice day!