byterun/custom.c

   1 /***********************************************************************/
   2 /*                                                                     */
   3 /*                           Objective Caml                            */
   4 /*                                                                     */
   5 /*         Manuel Serrano and Xavier Leroy, INRIA Rocquencourt         */
   6 /*                                                                     */
   7 /*  Copyright 2000 Institut National de Recherche en Informatique et   */
   8 /*  en Automatique.  All rights reserved.  This file is distributed    */
   9 /*  under the terms of the GNU Library General Public License, with    */
  10 /*  the special exception on linking described in file ../LICENSE.     */
  11 /*                                                                     */
  12 /***********************************************************************/
  13
  14 /* $Id$ */
  15
  16 #include <string.h>
  17
  18 #include "alloc.h"
  19 #include "custom.h"
  20 #include "fail.h"
  21 #include "memory.h"
  22 #include "mlvalues.h"
  23
  24 CAMLexport value caml_alloc_custom(struct custom_operations * ops,
  25                                    uintnat size,
  26                                    mlsize_t mem,
  27                                    mlsize_t max)
  28 {
  29   mlsize_t wosize;
  30   value result;
  31
  32   wosize = 1 + (size + sizeof(value) - 1) / sizeof(value);
  33   if (ops->finalize == NULL && wosize <= Max_young_wosize) {
  34     result = caml_alloc_small(wosize, Custom_tag);
  35     Custom_ops_val(result) = ops;
  36   } else {
  37     result = caml_alloc_shr(wosize, Custom_tag);
  38     Custom_ops_val(result) = ops;
  39     caml_adjust_gc_speed(mem, max);
  40     result = caml_check_urgent_gc(result);
  41   }
  42   return result;
  43 }
  44
  45 struct custom_operations_list {
  46   struct custom_operations * ops;
  47   struct custom_operations_list * next;
  48 };
  49
  50 static struct custom_operations_list * custom_ops_table = NULL;
  51
  52 CAMLexport void caml_register_custom_operations(struct custom_operations * ops)
  53 {
  54   struct custom_operations_list * l =
  55     caml_stat_alloc(sizeof(struct custom_operations_list));
  56   Assert(ops->identifier != NULL);
  57   Assert(ops->deserialize != NULL);
  58   l->ops = ops;
  59   l->next = custom_ops_table;
  60   custom_ops_table = l;
  61 }
  62
  63 struct custom_operations * caml_find_custom_operations(char * ident)
  64 {
  65   struct custom_operations_list * l;
  66   for (l = custom_ops_table; l != NULL; l = l->next)
  67     if (strcmp(l->ops->identifier, ident) == 0) return l->ops;
  68   return NULL;
  69 }
  70
  71 static struct custom_operations_list * custom_ops_final_table = NULL;
  72
  73 struct custom_operations * caml_final_custom_operations(final_fun fn)
  74 {
  75   struct custom_operations_list * l;
  76   struct custom_operations * ops;
  77   for (l = custom_ops_final_table; l != NULL; l = l->next)
  78     if (l->ops->finalize == fn) return l->ops;
  79   ops = caml_stat_alloc(sizeof(struct custom_operations));
  80   ops->identifier = "_final";
  81   ops->finalize = fn;
  82   ops->compare = custom_compare_default;
  83   ops->hash = custom_hash_default;
  84   ops->serialize = custom_serialize_default;
  85   ops->deserialize = custom_deserialize_default;
  86   l = caml_stat_alloc(sizeof(struct custom_operations_list));
  87   l->ops = ops;
  88   l->next = custom_ops_final_table;
  89   custom_ops_final_table = l;
  90   return ops;
  91 }
  92
  93 extern struct custom_operations caml_int32_ops,
  94                                 caml_nativeint_ops,
  95                                 caml_int64_ops;
  96
  97 void caml_init_custom_operations(void)
  98 {
  99   caml_register_custom_operations(&caml_int32_ops);
 100   caml_register_custom_operations(&caml_nativeint_ops);
 101   caml_register_custom_operations(&caml_int64_ops);
 102 }