1995-08-09 08:06:35 -07:00
|
|
|
/***********************************************************************/
|
|
|
|
/* */
|
1996-04-30 07:53:58 -07:00
|
|
|
/* Objective Caml */
|
1995-08-09 08:06:35 -07:00
|
|
|
/* */
|
|
|
|
/* Xavier Leroy and Damien Doligez, INRIA Rocquencourt */
|
|
|
|
/* */
|
1996-04-30 07:53:58 -07:00
|
|
|
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
1999-11-17 10:59:06 -08:00
|
|
|
/* en Automatique. All rights reserved. This file is distributed */
|
2001-12-07 05:41:02 -08:00
|
|
|
/* under the terms of the GNU Library General Public License, with */
|
|
|
|
/* the special exception on linking described in file ../LICENSE. */
|
1995-08-09 08:06:35 -07:00
|
|
|
/* */
|
|
|
|
/***********************************************************************/
|
|
|
|
|
|
|
|
/* $Id$ */
|
|
|
|
|
1995-05-04 03:15:53 -07:00
|
|
|
#include <stdio.h>
|
|
|
|
#include "config.h"
|
|
|
|
#include "misc.h"
|
2001-08-28 07:47:48 -07:00
|
|
|
#include "memory.h"
|
1995-05-04 03:15:53 -07:00
|
|
|
|
|
|
|
#ifdef DEBUG
|
|
|
|
|
2002-01-20 09:39:10 -08:00
|
|
|
int caml_failed_assert (char * expr, char * file, int line)
|
1995-05-04 03:15:53 -07:00
|
|
|
{
|
1999-11-08 09:07:05 -08:00
|
|
|
fprintf (stderr, "file %s; line %d ### Assertion failed: %s\n",
|
|
|
|
file, line, expr);
|
|
|
|
fflush (stderr);
|
1995-05-04 03:15:53 -07:00
|
|
|
exit (100);
|
2002-01-20 09:39:10 -08:00
|
|
|
return 1; /* not reached */
|
1995-05-04 03:15:53 -07:00
|
|
|
}
|
|
|
|
|
2004-01-08 14:28:48 -08:00
|
|
|
#endif /* DEBUG */
|
1995-05-04 03:15:53 -07:00
|
|
|
|
2003-12-29 14:15:02 -08:00
|
|
|
unsigned long caml_verb_gc = 0;
|
1995-05-04 03:15:53 -07:00
|
|
|
|
2003-12-29 14:15:02 -08:00
|
|
|
void caml_gc_message (int level, char *msg, unsigned long arg)
|
1995-05-04 03:15:53 -07:00
|
|
|
{
|
2003-12-29 14:15:02 -08:00
|
|
|
if (level < 0 || (caml_verb_gc & level) != 0){
|
1995-05-04 03:15:53 -07:00
|
|
|
fprintf (stderr, msg, arg);
|
|
|
|
fflush (stderr);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2003-12-29 14:15:02 -08:00
|
|
|
void caml_fatal_error (char *msg)
|
1995-05-04 03:15:53 -07:00
|
|
|
{
|
|
|
|
fprintf (stderr, "%s", msg);
|
|
|
|
exit(2);
|
|
|
|
}
|
|
|
|
|
2003-12-29 14:15:02 -08:00
|
|
|
void caml_fatal_error_arg (char *fmt, char *arg)
|
1995-05-04 03:15:53 -07:00
|
|
|
{
|
|
|
|
fprintf (stderr, fmt, arg);
|
|
|
|
exit(2);
|
|
|
|
}
|
|
|
|
|
2003-12-29 14:15:02 -08:00
|
|
|
void caml_fatal_error_arg2 (char *fmt1, char *arg1, char *fmt2, char *arg2)
|
2001-08-28 07:47:48 -07:00
|
|
|
{
|
|
|
|
fprintf (stderr, fmt1, arg1);
|
|
|
|
fprintf (stderr, fmt2, arg2);
|
|
|
|
exit(2);
|
|
|
|
}
|
|
|
|
|
2003-12-29 14:15:02 -08:00
|
|
|
char *caml_aligned_malloc (asize_t size, int modulo, void **block)
|
1995-05-04 03:15:53 -07:00
|
|
|
{
|
|
|
|
char *raw_mem;
|
|
|
|
unsigned long aligned_mem;
|
2000-08-23 10:10:03 -07:00
|
|
|
Assert (modulo < Page_size);
|
1995-05-04 03:15:53 -07:00
|
|
|
raw_mem = (char *) malloc (size + Page_size);
|
|
|
|
if (raw_mem == NULL) return NULL;
|
1997-05-13 07:45:38 -07:00
|
|
|
*block = raw_mem;
|
1997-05-19 08:42:21 -07:00
|
|
|
raw_mem += modulo; /* Address to be aligned */
|
1995-05-04 03:15:53 -07:00
|
|
|
aligned_mem = (((unsigned long) raw_mem / Page_size + 1) * Page_size);
|
2000-04-03 01:34:22 -07:00
|
|
|
#ifdef DEBUG
|
|
|
|
{
|
|
|
|
unsigned long *p;
|
|
|
|
unsigned long *p0 = (void *) *block,
|
|
|
|
*p1 = (void *) (aligned_mem - modulo),
|
|
|
|
*p2 = (void *) (aligned_mem - modulo + size),
|
2000-04-05 11:30:22 -07:00
|
|
|
*p3 = (void *) ((char *) *block + size + Page_size);
|
2000-04-03 01:34:22 -07:00
|
|
|
|
|
|
|
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
|
1995-05-04 03:15:53 -07:00
|
|
|
return (char *) (aligned_mem - modulo);
|
|
|
|
}
|
2001-08-28 07:47:48 -07:00
|
|
|
|
2003-12-29 14:15:02 -08:00
|
|
|
void caml_ext_table_init(struct ext_table * tbl, int init_capa)
|
2001-08-28 07:47:48 -07:00
|
|
|
{
|
|
|
|
tbl->size = 0;
|
|
|
|
tbl->capacity = init_capa;
|
2003-12-31 06:20:40 -08:00
|
|
|
tbl->contents = caml_stat_alloc(sizeof(void *) * init_capa);
|
2001-08-28 07:47:48 -07:00
|
|
|
}
|
|
|
|
|
2003-12-29 14:15:02 -08:00
|
|
|
int caml_ext_table_add(struct ext_table * tbl, void * data)
|
2001-08-28 07:47:48 -07:00
|
|
|
{
|
|
|
|
int res;
|
|
|
|
if (tbl->size >= tbl->capacity) {
|
|
|
|
tbl->capacity *= 2;
|
|
|
|
tbl->contents =
|
2003-12-31 06:20:40 -08:00
|
|
|
caml_stat_resize(tbl->contents, sizeof(void *) * tbl->capacity);
|
2001-08-28 07:47:48 -07:00
|
|
|
}
|
|
|
|
res = tbl->size;
|
|
|
|
tbl->contents[res] = data;
|
|
|
|
tbl->size++;
|
|
|
|
return res;
|
|
|
|
}
|
|
|
|
|
2003-12-29 14:15:02 -08:00
|
|
|
void caml_ext_table_free(struct ext_table * tbl, int free_entries)
|
2001-08-28 07:47:48 -07:00
|
|
|
{
|
|
|
|
int i;
|
|
|
|
if (free_entries)
|
2003-12-31 06:20:40 -08:00
|
|
|
for (i = 0; i < tbl->size; i++) caml_stat_free(tbl->contents[i]);
|
|
|
|
caml_stat_free(tbl->contents);
|
2001-08-28 07:47:48 -07:00
|
|
|
}
|