111 lines
3.9 KiB
C
111 lines
3.9 KiB
C
/***********************************************************************/
|
|
/* */
|
|
/* OCaml */
|
|
/* */
|
|
/* Manuel Serrano and Xavier Leroy, INRIA Rocquencourt */
|
|
/* */
|
|
/* Copyright 2000 Institut National de Recherche en Informatique et */
|
|
/* en Automatique. All rights reserved. This file is distributed */
|
|
/* under the terms of the GNU Library General Public License, with */
|
|
/* the special exception on linking described in file ../LICENSE. */
|
|
/* */
|
|
/***********************************************************************/
|
|
|
|
#include <string.h>
|
|
|
|
#include "caml/alloc.h"
|
|
#include "caml/custom.h"
|
|
#include "caml/fail.h"
|
|
#include "caml/memory.h"
|
|
#include "caml/mlvalues.h"
|
|
|
|
/* [size] is a number of bytes */
|
|
CAMLexport value caml_alloc_custom(struct custom_operations * ops,
|
|
uintnat size,
|
|
mlsize_t mem,
|
|
mlsize_t max)
|
|
{
|
|
mlsize_t wosize;
|
|
value result;
|
|
|
|
wosize = 1 + (size + sizeof(value) - 1) / sizeof(value);
|
|
if (wosize <= Max_young_wosize) {
|
|
result = caml_alloc_small(wosize, Custom_tag);
|
|
Custom_ops_val(result) = ops;
|
|
if (ops->finalize != NULL) {
|
|
/* Remembered that the block has a finalizer */
|
|
if (caml_finalize_table.ptr >= caml_finalize_table.limit){
|
|
CAMLassert (caml_finalize_table.ptr == caml_finalize_table.limit);
|
|
caml_realloc_ref_table (&caml_finalize_table);
|
|
}
|
|
*caml_finalize_table.ptr++ = (value *)result;
|
|
}
|
|
} else {
|
|
result = caml_alloc_shr(wosize, Custom_tag);
|
|
Custom_ops_val(result) = ops;
|
|
caml_adjust_gc_speed(mem, max);
|
|
result = caml_check_urgent_gc(result);
|
|
}
|
|
return result;
|
|
}
|
|
|
|
struct custom_operations_list {
|
|
struct custom_operations * ops;
|
|
struct custom_operations_list * next;
|
|
};
|
|
|
|
static struct custom_operations_list * custom_ops_table = NULL;
|
|
|
|
CAMLexport void caml_register_custom_operations(struct custom_operations * ops)
|
|
{
|
|
struct custom_operations_list * l =
|
|
caml_stat_alloc(sizeof(struct custom_operations_list));
|
|
Assert(ops->identifier != NULL);
|
|
Assert(ops->deserialize != NULL);
|
|
l->ops = ops;
|
|
l->next = custom_ops_table;
|
|
custom_ops_table = l;
|
|
}
|
|
|
|
struct custom_operations * caml_find_custom_operations(char * ident)
|
|
{
|
|
struct custom_operations_list * l;
|
|
for (l = custom_ops_table; l != NULL; l = l->next)
|
|
if (strcmp(l->ops->identifier, ident) == 0) return l->ops;
|
|
return NULL;
|
|
}
|
|
|
|
static struct custom_operations_list * custom_ops_final_table = NULL;
|
|
|
|
struct custom_operations * caml_final_custom_operations(final_fun fn)
|
|
{
|
|
struct custom_operations_list * l;
|
|
struct custom_operations * ops;
|
|
for (l = custom_ops_final_table; l != NULL; l = l->next)
|
|
if (l->ops->finalize == fn) return l->ops;
|
|
ops = caml_stat_alloc(sizeof(struct custom_operations));
|
|
ops->identifier = "_final";
|
|
ops->finalize = fn;
|
|
ops->compare = custom_compare_default;
|
|
ops->hash = custom_hash_default;
|
|
ops->serialize = custom_serialize_default;
|
|
ops->deserialize = custom_deserialize_default;
|
|
ops->compare_ext = custom_compare_ext_default;
|
|
l = caml_stat_alloc(sizeof(struct custom_operations_list));
|
|
l->ops = ops;
|
|
l->next = custom_ops_final_table;
|
|
custom_ops_final_table = l;
|
|
return ops;
|
|
}
|
|
|
|
extern struct custom_operations caml_int32_ops,
|
|
caml_nativeint_ops,
|
|
caml_int64_ops;
|
|
|
|
void caml_init_custom_operations(void)
|
|
{
|
|
caml_register_custom_operations(&caml_int32_ops);
|
|
caml_register_custom_operations(&caml_nativeint_ops);
|
|
caml_register_custom_operations(&caml_int64_ops);
|
|
}
|