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);
+}