diff options
Diffstat (limited to 'byterun/weak.c')
| -rw-r--r-- | byterun/weak.c | 74 |
1 files changed, 58 insertions, 16 deletions
diff --git a/byterun/weak.c b/byterun/weak.c index 1f121af3a..e85468601 100644 --- a/byterun/weak.c +++ b/byterun/weak.c @@ -45,6 +45,24 @@ CAMLprim value caml_weak_create (value len) #define None_val (Val_int(0)) #define Some_tag 0 +static void do_set (value ar, mlsize_t offset, value v) +{ + if (Is_block (v) && Is_young (v)){ + /* modified version of Modify */ + value old = Field (ar, offset); + Field (ar, offset) = v; + if (!(Is_block (old) && Is_young (old))){ + if (caml_weak_ref_table.ptr >= caml_weak_ref_table.limit){ + CAMLassert (caml_weak_ref_table.ptr == caml_weak_ref_table.limit); + caml_realloc_ref_table (&caml_weak_ref_table); + } + *caml_weak_ref_table.ptr++ = &Field (ar, offset); + } + }else{ + Field (ar, offset) = v; + } +} + CAMLprim value caml_weak_set (value ar, value n, value el) { mlsize_t offset = Long_val (n) + 1; @@ -53,22 +71,10 @@ CAMLprim value caml_weak_set (value ar, value n, value el) caml_invalid_argument ("Weak.set"); } if (el != None_val){ - value v; Assert (Wosize_val (el) == 1); - v = Field (el, 0); - if (Is_block (v) && Is_young (v)){ - /* modified version of Modify */ - value old = Field (ar, offset); - Field (ar, offset) = v; - if (!(Is_block (old) && Is_young (old))){ - if (caml_weak_ref_table.ptr >= caml_weak_ref_table.limit){ - CAMLassert (caml_weak_ref_table.ptr == caml_weak_ref_table.limit); - caml_realloc_ref_table (&caml_weak_ref_table); - } - *caml_weak_ref_table.ptr++ = &Field (ar, offset); - } - }else{ - Field (ar, offset) = v; - } + Assert (Wosize_val (el) == 1); + do_set (ar, offset, Field (el, 0)); + }else{ + Field (ar, offset) = caml_weak_none; } return Val_unit; } @@ -149,3 +155,39 @@ CAMLprim value caml_weak_check (value ar, value n) } return Val_bool (Field (ar, offset) != caml_weak_none); } + +CAMLprim value caml_weak_blit (value ars, value ofs, + value ard, value ofd, value len) +{ + mlsize_t offset_s = Long_val (ofs) + 1; + mlsize_t offset_d = Long_val (ofd) + 1; + mlsize_t length = Long_val (len); + long i; + Assert (Is_in_heap (ars)); + Assert (Is_in_heap (ard)); + if (offset_s < 1 || offset_s + length > Wosize_val (ars)){ + caml_invalid_argument ("Weak.blit"); + } + if (offset_d < 1 || offset_d + length > Wosize_val (ard)){ + caml_invalid_argument ("Weak.blit"); + } + if (caml_gc_phase == Phase_mark && caml_gc_subphase == Subphase_weak1){ + for (i = 0; i < length; i++){ + value v = Field (ars, offset_s + i); + if (v != caml_weak_none && Is_block (v) && Is_in_heap (v) + && Is_white_val (v)){ + Field (ars, offset_s + i) = caml_weak_none; + } + } + } + if (offset_d < offset_s){ + for (i = 0; i < length; i++){ + do_set (ard, offset_d + i, Field (ars, offset_s + i)); + } + }else{ + for (i = length - 1; i >= 0; i--){ + do_set (ard, offset_d + i, Field (ars, offset_s + i)); + } + } + return Val_unit; +} |