SumiTomohikoのWiki

引数がブロックならば、ブロックを旧世代に移動する。

• v: OCamlの値
• p: vへのポインタ

なし

• ocaml-3.11.0/byterun/minor_gc.c

/* Note that the tests on the tag depend on the fact that Infix_tag,
   Forward_tag, and No_scan_tag are contiguous. */

タグに関する検査は、Infix_tagとForward_tag, No_scan_tagが連続しているという事実に依存する。

void caml_oldify_one (value v, value *p)
{
  value result;
  header_t hd;
  mlsize_t sz, i;
  tag_t tag;

 tail_call:
  if (Is_block (v) && Is_young (v)){

• ocaml-3.11.0/Is_block
• ocaml-3.11.0/Is_young

新世代のブロックの場合

    Assert (Hp_val (v) >= caml_young_ptr);
    hd = Hd_val (v);

• ocaml-3.11.0/Hd_val

    if (hd == 0){         /* If already forwarded */
      *p = Field (v, 0);  /*  then forward pointer is first field. */

• ocaml-3.11.0/Field

ヘッダが0の場合、最初のフィールドに移動先のアドレスが書き込まれている。

    }else{
      tag = Tag_hd (hd);
      if (tag < Infix_tag){

• ocaml-3.11.0/Infix_tag

        value field0;
        sz = Wosize_hd (hd);

• ocaml-3.11.0/Wosize_hd

        result = caml_alloc_shr (sz, tag);

• ocaml-3.11.0/caml_alloc_shr

新たにメモリを確保し、

        *p = result;
        field0 = Field (v, 0);
        Hd_val (v) = 0;            /* Set forward flag */
        Field (v, 0) = result;     /*  and forward pointer. */

移動先のアドレスを書き込む。

        if (sz > 1){
          Field (result, 0) = field0;
          Field (result, 1) = oldify_todo_list;    /* Add this block */
          oldify_todo_list = v;                    /*  to the "to do" list. */

オブジェクトが複数のフィールドから構成される場合、オブジェクト（の移動前のポインタ）を、oldify_todo_listに追加する。リストの次の要素は、リストにある移動前のポインタ->移動後のポインタ->2番目のフィールドの順で参照できる。子のリストは、caml_oldify_mopupで参照される。

        }else{
          Assert (sz == 1);
          p = &Field (result, 0);
          v = field0;
          goto tail_call;
        }
      }else if (tag >= No_scan_tag){
        sz = Wosize_hd (hd);
        result = caml_alloc_shr (sz, tag);
        for (i = 0; i < sz; i++) Field (result, i) = Field (v, i);
        Hd_val (v) = 0;            /* Set forward flag */
        Field (v, 0) = result;     /*  and forward pointer. */
        *p = result;
      }else if (tag == Infix_tag){
        mlsize_t offset = Infix_offset_hd (hd);

• ocaml-3.11.0/Infix_offset_hd

        caml_oldify_one (v - offset, p);   /* Cannot recurse deeper than 1. */
        *p += offset;
      }else{
        value f = Forward_val (v);

• ocaml-3.11.0/Forward_val

        tag_t ft = 0;
        int vv = 1;

        Assert (tag == Forward_tag);
        if (Is_block (f)){
          vv = Is_in_value_area(f);

• ocaml-3.11.0/Is_in_value_area

          if (vv) {
            ft = Tag_val (Hd_val (f) == 0 ? Field (f, 0) : f);

• ocaml-3.11.0/Tag_val

          }
        }
        if (!vv || ft == Forward_tag || ft == Lazy_tag || ft == Double_tag){

• ocaml-3.11.0/Lazy_tag
• ocaml-3.11.0/Double_tag

          /* Do not short-circuit the pointer.  Copy as a normal block. */
          Assert (Wosize_hd (hd) == 1);
          result = caml_alloc_shr (1, Forward_tag);
          *p = result;
          Hd_val (v) = 0;             /* Set (GC) forward flag */
          Field (v, 0) = result;      /*  and forward pointer. */
          p = &Field (result, 0);
          v = f;
          goto tail_call;
        }else{
          v = f;                        /* Follow the forwarding */
          goto tail_call;               /*  then oldify. */
        }
      }
    }
  }else{
    *p = v;
  }
}