static intnat mark(value initial, intnat budget) { value next = initial; int found_next = 1; while (budget > 0 && found_next) { value v = next; header_t hd_v; found_next = 0; Assert(Is_markable(v)); Assert(v == mark_normalise(v)); stat_blocks_marked++; /* mark the current object */ hd_v = Hd_val(v); // caml_gc_log ("mark: v=0x%lx hd=0x%lx tag=%d sz=%lu", // v, hd_v, Tag_val(v), Wosize_val(v)); if (Tag_hd (hd_v) == Stack_tag) { // caml_gc_log ("mark: stack=%p", (value*)v); caml_scan_stack(&caml_darken, v); } else if (Tag_hd (hd_v) < No_scan_tag) { int i; for (i = 0; i < Wosize_hd(hd_v); i++) { value child = Op_val(v)[i]; // caml_gc_log ("mark: v=%p i=%u child=%p",(value*)v,i,(value*)child); /* FIXME: this is wrong, as Debug_tag(N) is a valid value. However, it's a useful debugging aid for now */ Assert(!Is_debug_tag(child)); if (Is_markable(child)) { child = mark_normalise(child); if (caml_mark_object(child)) { if (!found_next) { next = child; found_next = 1; } else { mark_stack_push(child); } } } } } budget -= Whsize_hd(hd_v); /* if we haven't found any markable children, pop an object to mark */ if (!found_next) { found_next = mark_stack_pop(&next); } } if (found_next) { mark_stack_push(next); } return budget; }
void caml_darken(value v, value* ignored) { /* Assert (Is_markable(v)); */ if (!Is_markable (v)) return; /* foreign stack, at least */ v = mark_normalise(v); if (caml_mark_object(v)) mark_stack_push(v); }
static intnat mark(value initial, intnat budget) { value next = initial; int found_next = 1; while (budget > 0 && found_next) { value v = next; header_t hd_v; found_next = 0; Assert(Is_markable(v)); Assert(v == mark_normalise(v)); stat_blocks_marked++; /* mark the current object */ hd_v = Hd_val(v); if (Tag_hd (hd_v) == Stack_tag) { caml_scan_stack(&caml_darken, v); } else if (Tag_hd (hd_v) < No_scan_tag) { int i; for (i = 0; i < Wosize_hd(hd_v); i++) { value child = Field(v, i); if (Is_markable(child)) { child = mark_normalise(child); if (caml_mark_object(child)) { if (!found_next) { next = child; found_next = 1; } else { mark_stack_push(child); } } } } } budget -= Whsize_hd(hd_v); /* if we haven't found any markable children, pop an object to mark */ if (!found_next) { found_next = mark_stack_pop(&next); } } if (found_next) { mark_stack_push(next); } return budget; }
static value mark_normalise(value v) { Assert(Is_markable(v)); if (Tag_val(v) == Forward_tag) { /* FIXME: short-circuiting lazy values is a useful optimisation */ } else if (Tag_val(v) == Infix_tag) { v -= Infix_offset_val(v); } return v; }