static void extern_record_location(value obj)
{
header_t hdr;
if (extern_trail_cur == extern_trail_limit) {
struct trail_block * new_block = malloc(sizeof(struct trail_block));
if (new_block == NULL) extern_out_of_memory();
new_block->previous = extern_trail_block;
extern_trail_block = new_block;
extern_trail_cur = extern_trail_block->entries;
extern_trail_limit = extern_trail_block->entries + ENTRIES_PER_TRAIL_BLOCK;
}
// Set the blue color on current object header
hdr = Hd_val(obj);
extern_trail_cur->obj = obj | Colornum_hd(hdr);
// Save the object first field
extern_trail_cur->field0 = Field(obj, 0);
extern_trail_cur++;
Hd_val(obj) = Bluehd_hd(hdr);
// Set the current counter in first field
Field(obj, 0) = (value) obj_counter;
obj_counter++;
}
/* [caml_fl_merge_block] returns the head pointer of the next block after [bp],
because merging blocks may change the size of [bp]. */
char *caml_fl_merge_block (char *bp)
{
char *prev, *cur, *adj;
header_t hd = Hd_bp (bp);
mlsize_t prev_wosz;
caml_fl_cur_size += Whsize_hd (hd);
#ifdef DEBUG
caml_set_fields (bp, 0, Debug_free_major);
#endif
prev = caml_fl_merge;
cur = Next (prev);
/* The sweep code makes sure that this is the right place to insert
this block: */
Assert (prev < bp || prev == Fl_head);
Assert (cur > bp || cur == NULL);
if (policy == Policy_first_fit) truncate_flp (prev);
/* If [last_fragment] and [bp] are adjacent, merge them. */
if (last_fragment == Hp_bp (bp)){
mlsize_t bp_whsz = Whsize_bp (bp);
if (bp_whsz <= Max_wosize){
hd = Make_header (bp_whsz, 0, Caml_white);
bp = last_fragment;
Hd_bp (bp) = hd;
caml_fl_cur_size += Whsize_wosize (0);
}
}
/* If [bp] and [cur] are adjacent, remove [cur] from the free-list
and merge them. */
adj = bp + Bosize_hd (hd);
if (adj == Hp_bp (cur)){
char *next_cur = Next (cur);
mlsize_t cur_whsz = Whsize_bp (cur);
if (Wosize_hd (hd) + cur_whsz <= Max_wosize){
Next (prev) = next_cur;
if (policy == Policy_next_fit && fl_prev == cur) fl_prev = prev;
hd = Make_header (Wosize_hd (hd) + cur_whsz, 0, Caml_blue);
Hd_bp (bp) = hd;
adj = bp + Bosize_hd (hd);
#ifdef DEBUG
fl_last = NULL;
Next (cur) = (char *) Debug_free_major;
Hd_bp (cur) = Debug_free_major;
#endif
cur = next_cur;
}
}
/* If [prev] and [bp] are adjacent merge them, else insert [bp] into
the free-list if it is big enough. */
prev_wosz = Wosize_bp (prev);
if (prev + Bsize_wsize (prev_wosz) == Hp_bp (bp)
&& prev_wosz + Whsize_hd (hd) < Max_wosize){
Hd_bp (prev) = Make_header (prev_wosz + Whsize_hd (hd), 0,Caml_blue);
#ifdef DEBUG
Hd_bp (bp) = Debug_free_major;
#endif
Assert (caml_fl_merge == prev);
}else if (Wosize_hd (hd) != 0){
Hd_bp (bp) = Bluehd_hd (hd);
Next (bp) = cur;
Next (prev) = bp;
caml_fl_merge = bp;
}else{
/* This is a fragment. Leave it in white but remember it for eventual
merging with the next block. */
last_fragment = bp;
caml_fl_cur_size -= Whsize_wosize (0);
}
return adj;
}
