diff options
author | David Monniaux <david.monniaux@univ-grenoble-alpes.fr> | 2019-03-20 17:32:00 +0100 |
---|---|---|
committer | David Monniaux <david.monniaux@univ-grenoble-alpes.fr> | 2019-03-20 17:33:45 +0100 |
commit | 4c9c95b6a0ac8aa31abb1f7ab48c3f645c059bd6 (patch) | |
tree | 62eaadc788f4426d18974f6c1cbf23b616d43edb /test/monniaux/ocaml/byterun/custom.c | |
parent | f8f393317fcfee9613f09513f21dd0461c503d8c (diff) | |
download | compcert-kvx-4c9c95b6a0ac8aa31abb1f7ab48c3f645c059bd6.tar.gz compcert-kvx-4c9c95b6a0ac8aa31abb1f7ab48c3f645c059bd6.zip |
ocaml byterunner example
Diffstat (limited to 'test/monniaux/ocaml/byterun/custom.c')
-rw-r--r-- | test/monniaux/ocaml/byterun/custom.c | 124 |
1 files changed, 124 insertions, 0 deletions
diff --git a/test/monniaux/ocaml/byterun/custom.c b/test/monniaux/ocaml/byterun/custom.c new file mode 100644 index 00000000..b6a5c4e3 --- /dev/null +++ b/test/monniaux/ocaml/byterun/custom.c @@ -0,0 +1,124 @@ +/**************************************************************************/ +/* */ +/* 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 Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/**************************************************************************/ + +#define CAML_INTERNALS + +#include <string.h> + +#include "caml/alloc.h" +#include "caml/custom.h" +#include "caml/fail.h" +#include "caml/memory.h" +#include "caml/mlvalues.h" +#include "caml/signals.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; + CAMLparam0(); + CAMLlocal1(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 || mem != 0) { + /* Remember that the block needs processing after minor GC. */ + add_to_custom_table (&caml_custom_table, result, mem, max); + /* Keep track of extra resources held by custom block in + minor heap. */ + if (mem != 0) { + if (max == 0) max = 1; + caml_extra_heap_resources_minor += (double) mem / (double) max; + if (caml_extra_heap_resources_minor > 1.0) { + caml_request_minor_gc (); + caml_gc_dispatch (); + } + } + } + } 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); + } + CAMLreturn(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)); + CAMLassert(ops->identifier != NULL); + CAMLassert(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, + caml_ba_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); + caml_register_custom_operations(&caml_ba_ops); +} |