/***********************************************************************/ /* */ /* OCaml */ /* */ /* Xavier Leroy and Damien Doligez, INRIA Rocquencourt */ /* */ /* Copyright 1996 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 #include #include #include "caml/config.h" #include "caml/misc.h" #include "caml/memory.h" #ifdef DEBUG int caml_failed_assert (char * expr, char * file, int line) { fprintf (stderr, "file %s; line %d ### Assertion failed: %s\n", file, line, expr); fflush (stderr); exit (100); } void caml_set_fields (value v, unsigned long start, unsigned long filler) { mlsize_t i; for (i = start; i < Wosize_val (v); i++){ Field (v, i) = (value) filler; } } #endif /* DEBUG */ uintnat caml_verb_gc = 0; void caml_gc_message (int level, char *msg, uintnat arg) { if (level < 0 || (caml_verb_gc & level) != 0){ fprintf (stderr, msg, arg); fflush (stderr); } } CAMLexport void caml_fatal_error (char *msg) { fprintf (stderr, "%s", msg); exit(2); } CAMLexport void caml_fatal_error_arg (char *fmt, char *arg) { fprintf (stderr, fmt, arg); exit(2); } CAMLexport void caml_fatal_error_arg2 (char *fmt1, char *arg1, char *fmt2, char *arg2) { fprintf (stderr, fmt1, arg1); fprintf (stderr, fmt2, arg2); exit(2); } /* [size] and [modulo] are numbers of bytes */ char *caml_aligned_malloc (asize_t size, int modulo, void **block) { char *raw_mem; uintnat aligned_mem; Assert (modulo < Page_size); raw_mem = (char *) malloc (size + Page_size); if (raw_mem == NULL) return NULL; *block = raw_mem; raw_mem += modulo; /* Address to be aligned */ aligned_mem = (((uintnat) raw_mem / Page_size + 1) * Page_size); #ifdef DEBUG { uintnat *p; uintnat *p0 = (void *) *block, *p1 = (void *) (aligned_mem - modulo), *p2 = (void *) (aligned_mem - modulo + size), *p3 = (void *) ((char *) *block + size + Page_size); for (p = p0; p < p1; p++) *p = Debug_filler_align; for (p = p1; p < p2; p++) *p = Debug_uninit_align; for (p = p2; p < p3; p++) *p = Debug_filler_align; } #endif return (char *) (aligned_mem - modulo); } void caml_ext_table_init(struct ext_table * tbl, int init_capa) { tbl->size = 0; tbl->capacity = init_capa; tbl->contents = caml_stat_alloc(sizeof(void *) * init_capa); } int caml_ext_table_add(struct ext_table * tbl, void * data) { int res; if (tbl->size >= tbl->capacity) { tbl->capacity *= 2; tbl->contents = caml_stat_resize(tbl->contents, sizeof(void *) * tbl->capacity); } res = tbl->size; tbl->contents[res] = data; tbl->size++; return res; } void caml_ext_table_remove(struct ext_table * tbl, void * data) { int i; for (i = 0; i < tbl->size; i++) { if (tbl->contents[i] == data) { caml_stat_free(tbl->contents[i]); memmove(&tbl->contents[i], &tbl->contents[i + 1], (tbl->size - i - 1) * sizeof(void *)); tbl->size--; } } } void caml_ext_table_free(struct ext_table * tbl, int free_entries) { int i; if (free_entries) for (i = 0; i < tbl->size; i++) caml_stat_free(tbl->contents[i]); caml_stat_free(tbl->contents); } CAMLexport char * caml_strdup(const char * s) { size_t slen = strlen(s); char * res = caml_stat_alloc(slen + 1); memcpy(res, s, slen + 1); return res; } CAMLexport char * caml_strconcat(int n, ...) { va_list args; char * res, * p; size_t len; int i; len = 0; va_start(args, n); for (i = 0; i < n; i++) { const char * s = va_arg(args, const char *); len += strlen(s); } va_end(args); res = caml_stat_alloc(len + 1); va_start(args, n); p = res; for (i = 0; i < n; i++) { const char * s = va_arg(args, const char *); size_t l = strlen(s); memcpy(p, s, l); p += l; } va_end(args); *p = 0; return res; }