/***********************************************************************/ /* */ /* Objective Caml */ /* */ /* 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. */ /* */ /***********************************************************************/ /***--------------------------------------------------------------------- Modified and adapted for the Lazy Virtual Machine by Daan Leijen. Modifications copyright 2001, Daan Leijen. This (modified) file is distributed under the terms of the GNU Library General Public License. ---------------------------------------------------------------------***/ /* $Id$ */ #include #include "mlvalues.h" #include "alloc.h" #include "custom.h" #include "fail.h" #include "memory.h" value alloc_custom(struct custom_operations * ops, unsigned long size, mlsize_t mem, mlsize_t max) { mlsize_t wosize; value result; wosize = 1 + (size + sizeof(value) - 1) / sizeof(value); if (ops->finalize == NULL && wosize <= Max_young_wosize) { result = alloc_small(wosize, Custom_tag); Custom_ops_val(result) = ops; } else { result = alloc_shr(wosize, Custom_tag); Custom_ops_val(result) = ops; adjust_gc_speed(mem, max); result = check_urgent_gc(result); } return result; } int custom_compare_default(value v1, value v2) { raise_internal("equal: abstract value"); return 0; } void custom_serialize_default(value v, unsigned long * wsize_32, unsigned long * wsize_64) { raise_internal("output_value: abstract value"); } struct custom_operations_list { struct custom_operations * ops; struct custom_operations_list * next; }; static struct custom_operations_list * custom_ops_table = NULL; void register_custom_operations(struct custom_operations * ops) { struct custom_operations_list * l = 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 * 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 * 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 = 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; l = stat_alloc(sizeof(struct custom_operations_list)); l->ops = ops; l->next = custom_ops_final_table; custom_ops_final_table = l; return ops; } /* DAAN: removed default int32/64/native ops */ /* extern struct custom_operations int32_ops, nativeint_ops; #ifdef ARCH_INT64_TYPE extern struct custom_operations int64_ops; #endif void init_custom_operations(void) { register_custom_operations(&int32_ops); register_custom_operations(&nativeint_ops); #ifdef ARCH_INT64_TYPE register_custom_operations(&int64_ops); #endif } */ extern struct custom_operations bytes_ops; extern struct custom_operations fixed_block_ops; void init_custom_operations(void) { register_custom_operations(&bytes_ops); register_custom_operations(&fixed_block_ops); }