234 lines
8.3 KiB
C
234 lines
8.3 KiB
C
/**************************************************************************/
|
|
/* */
|
|
/* OCaml */
|
|
/* */
|
|
/* Damien Doligez, projet Para, INRIA Rocquencourt */
|
|
/* */
|
|
/* Copyright 1997 Institut National de Recherche en Informatique et */
|
|
/* en Automatique. */
|
|
/* */
|
|
/* All rights reserved. This file is distributed under the terms of */
|
|
/* the GNU Lesser General Public License version 2.1, with the */
|
|
/* special exception on linking described in the file LICENSE. */
|
|
/* */
|
|
/**************************************************************************/
|
|
|
|
/* Operations on weak arrays */
|
|
|
|
#ifndef CAML_WEAK_H
|
|
#define CAML_WEAK_H
|
|
|
|
#include "mlvalues.h"
|
|
#include "memory.h"
|
|
|
|
#ifdef __cplusplus
|
|
extern "C" {
|
|
#endif
|
|
|
|
/** The requirements of the functions must be satisfied, it is
|
|
unspecified what happens if they are not. The debugging runtime
|
|
could check some of them. */
|
|
|
|
CAMLextern value caml_ephemeron_create(mlsize_t len);
|
|
/** Create an ephemeron with the given number of keys.
|
|
This function allocates.
|
|
*/
|
|
|
|
CAMLextern mlsize_t caml_ephemeron_num_keys(value eph);
|
|
/** Return the number of key in the ephemeron. The valid key offset goes
|
|
from [0] to the predecessor of the returned value. */
|
|
|
|
CAMLextern int caml_ephemeron_key_is_set(value eph, mlsize_t offset);
|
|
/** Return 1 if the key in the ephemeron at the given offset is set.
|
|
Otherwise 0. The value [eph] must be an ephemeron and [offset] a
|
|
valid key offset.
|
|
*/
|
|
|
|
CAMLextern void caml_ephemeron_set_key(value eph, mlsize_t offset, value k);
|
|
/** Set the key of the given ephemeron [eph] at the given offset
|
|
[offset] to the given value [k]. The value [eph] must be an
|
|
ephemeron, [offset] a valid key offset and [k] a block.
|
|
*/
|
|
|
|
CAMLextern void caml_ephemeron_unset_key(value eph, mlsize_t offset);
|
|
/** Unset the key of the given ephemeron at the given offset. The
|
|
value [eph] must be an ephemeron and [offset] a valid key offset.
|
|
*/
|
|
|
|
CAMLextern int caml_ephemeron_get_key(value eph, mlsize_t offset, value *key);
|
|
/** Return 1 if the key in the ephemeron at the given offset is set.
|
|
Otherwise 0. When returning 1, set [*key] to the pointed value.
|
|
|
|
The value [eph] must be an ephemeron and [offset] a valid key
|
|
offset.
|
|
*/
|
|
|
|
CAMLextern int caml_ephemeron_get_key_copy(value eph, mlsize_t offset,
|
|
value *key);
|
|
/** Return 1 if the key in the ephemeron at the given offset is set.
|
|
Otherwise 0. When returning 1, set [*key] to a shallow copy of the
|
|
key. This function allocates.
|
|
|
|
The value [eph] must be an ephemeron and [offset] a valid key
|
|
offset.
|
|
*/
|
|
|
|
CAMLextern void caml_ephemeron_blit_key(value eph1, mlsize_t off1,
|
|
value eph2, mlsize_t off2,
|
|
mlsize_t len);
|
|
/** Fill the given range of keys of [eph2] with the given range of
|
|
keys of [eph1]. Contrary to using caml_ephemeron_get_key followed
|
|
by caml_ephemeron_set_key or caml_ephemeron_unset_key, this
|
|
function does not prevent the incremental GC from erasing the
|
|
value in its current cycle. The value [eph1] (resp. [eph2]) must
|
|
be an ephemeron and the offsets between [off1] and [off1+len]
|
|
(resp. between [off2] and [off2+offset]) must be valid keys of
|
|
[eph1] (resp. [eph2]).
|
|
*/
|
|
|
|
CAMLextern int caml_ephemeron_data_is_set(value eph);
|
|
/** Return 1 if the data in the ephemeron is set.
|
|
Otherwise 0. The value [eph] must be an ephemeron.
|
|
*/
|
|
|
|
CAMLextern void caml_ephemeron_set_data(value eph, value k);
|
|
/** Set the data of the given ephemeron [eph] to the given value
|
|
[k]. The value [eph] must be an ephemeron and [k] a block.
|
|
*/
|
|
|
|
CAMLextern void caml_ephemeron_unset_data(value eph);
|
|
/** Unset the data of the given ephemeron. The value [eph] must be an
|
|
ephemeron.
|
|
*/
|
|
|
|
CAMLextern int caml_ephemeron_get_data(value eph, value *data);
|
|
/** Return 1 if the data in the ephemeron at the given offset is set.
|
|
Otherwise 0. When returning 1, set [*data] to the pointed value.
|
|
|
|
The value [eph] must be an ephemeron and [offset] a valid key
|
|
offset.
|
|
*/
|
|
|
|
CAMLextern int caml_ephemeron_get_data_copy(value eph, value *data);
|
|
/** Return 1 if the data in the ephemeron at the given offset is set.
|
|
Otherwise 0. When returning 1, set [*data] to a shallow copy of
|
|
the data. This function allocates.
|
|
|
|
The value [eph] must be an ephemeron and [offset] a valid key
|
|
offset.
|
|
*/
|
|
|
|
CAMLextern void caml_ephemeron_blit_data(value eph1, value eph2);
|
|
/** Sets the data of [eph2] to be the same as the data of [eph1].
|
|
Contrary to using caml_ephemeron_get_data followed by
|
|
caml_ephemeron_set_data or caml_ephemeron_unset_data, this
|
|
function does not prevent the incremental GC from erasing the
|
|
value in its current cycle. The values [eph1] and [eph2] must be
|
|
ephemerons.
|
|
*/
|
|
|
|
|
|
#define caml_weak_array_length caml_ephemeron_num_keys
|
|
#define caml_weak_array_create caml_ephemeron_create
|
|
#define caml_weak_array_check caml_ephemeron_key_is_set
|
|
#define caml_weak_array_unset caml_ephemeron_unset_key
|
|
#define caml_weak_array_set caml_ephemeron_set_key
|
|
#define caml_weak_array_get caml_ephemeron_get_key
|
|
#define caml_weak_array_get_copy caml_ephemeron_get_key_copy
|
|
#define caml_weak_array_blit caml_ephemeron_blit_key
|
|
|
|
#ifdef CAML_INTERNALS
|
|
|
|
extern value caml_ephe_list_head;
|
|
extern value caml_ephe_none;
|
|
|
|
|
|
/** The first field 0: weak list;
|
|
second field 1: data;
|
|
others 2..: keys;
|
|
|
|
A weak pointer is an ephemeron with the data at caml_ephe_none
|
|
If fields are added, don't forget to update weak.ml, [additional_values],
|
|
and obj.ml, [Ephemeron.additional_values].
|
|
|
|
|
|
*/
|
|
|
|
#define CAML_EPHE_LINK_OFFSET 0
|
|
#define CAML_EPHE_DATA_OFFSET 1
|
|
#define CAML_EPHE_FIRST_KEY 2
|
|
#define CAML_EPHE_MAX_WOSIZE (Max_wosize - CAML_EPHE_FIRST_KEY)
|
|
|
|
/* In the header, in order to let major_gc.c
|
|
and weak.c see the body of the function */
|
|
Caml_inline void caml_ephe_clean_partial (value v,
|
|
mlsize_t offset_start,
|
|
mlsize_t offset_end) {
|
|
value child;
|
|
int release_data = 0;
|
|
mlsize_t i;
|
|
CAMLassert(caml_gc_phase == Phase_clean);
|
|
CAMLassert(2 <= offset_start
|
|
&& offset_start <= offset_end
|
|
&& offset_end <= Wosize_hd (Hd_val(v)));
|
|
|
|
for (i = offset_start; i < offset_end; i++){
|
|
child = Field (v, i);
|
|
ephemeron_again:
|
|
if (child != caml_ephe_none
|
|
&& Is_block (child) && Is_in_value_area (child)){
|
|
if (Tag_val (child) == Forward_tag){
|
|
value f = Forward_val (child);
|
|
if (Is_block (f)) {
|
|
if (!Is_in_value_area(f) || Tag_val (f) == Forward_tag
|
|
|| Tag_val (f) == Lazy_tag || Tag_val (f) == Double_tag){
|
|
/* Do not short-circuit the pointer. */
|
|
}else{
|
|
Field (v, i) = child = f;
|
|
if (Is_block (f) && Is_young (f))
|
|
add_to_ephe_ref_table(Caml_state_field(ephe_ref_table), v, i);
|
|
goto ephemeron_again;
|
|
}
|
|
}
|
|
}
|
|
if (Tag_val (child) == Infix_tag) child -= Infix_offset_val (child);
|
|
if (Is_white_val (child) && !Is_young (child)){
|
|
release_data = 1;
|
|
Field (v, i) = caml_ephe_none;
|
|
}
|
|
}
|
|
}
|
|
|
|
child = Field (v, 1);
|
|
if(child != caml_ephe_none){
|
|
if (release_data) Field (v, 1) = caml_ephe_none;
|
|
#ifdef DEBUG
|
|
else if (offset_start == 2 && offset_end == Wosize_hd (Hd_val(v)) &&
|
|
Is_block (child) && Is_in_heap (child)) {
|
|
if (Tag_val (child) == Infix_tag) child -= Infix_offset_val (child);
|
|
/* If we scanned all the keys and the data field remains filled,
|
|
then the mark phase must have marked it */
|
|
CAMLassert( !Is_white_val (child) );
|
|
}
|
|
#endif
|
|
}
|
|
}
|
|
|
|
Caml_inline void caml_ephe_clean (value v) {
|
|
mlsize_t size;
|
|
header_t hd;
|
|
hd = Hd_val (v);
|
|
size = Wosize_hd (hd);
|
|
|
|
caml_ephe_clean_partial(v, 2, size);
|
|
}
|
|
|
|
|
|
#endif /* CAML_INTERNALS */
|
|
|
|
#ifdef __cplusplus
|
|
}
|
|
#endif
|
|
|
|
#endif /* CAML_WEAK_H */
|