byterun/misc.c

   1 /***********************************************************************/
   2 /*                                                                     */
   3 /*                           Objective Caml                            */
   4 /*                                                                     */
   5 /*         Xavier Leroy and Damien Doligez, INRIA Rocquencourt         */
   6 /*                                                                     */
   7 /*  Copyright 1996 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 <stdio.h>
  17 #include "config.h"
  18 #include "misc.h"
  19 #include "memory.h"
  20
  21 #ifdef DEBUG
  22
  23 int caml_failed_assert (char * expr, char * file, int line)
  24 {
  25   fprintf (stderr, "file %s; line %d ### Assertion failed: %s\n",
  26            file, line, expr);
  27   fflush (stderr);
  28   exit (100);
  29   return 1; /* not reached */
  30 }
  31
  32 void caml_set_fields (char *bp, unsigned long start, unsigned long filler)
  33 {
  34   mlsize_t i;
  35   for (i = start; i < Wosize_bp (bp); i++){
  36     Field (Val_bp (bp), i) = (value) filler;
  37   }
  38 }
  39
  40 #endif /* DEBUG */
  41
  42 uintnat caml_verb_gc = 0;
  43
  44 void caml_gc_message (int level, char *msg, uintnat arg)
  45 {
  46   if (level < 0 || (caml_verb_gc & level) != 0){
  47     fprintf (stderr, msg, arg);
  48     fflush (stderr);
  49   }
  50 }
  51
  52 CAMLexport void caml_fatal_error (char *msg)
  53 {
  54   fprintf (stderr, "%s", msg);
  55   exit(2);
  56 }
  57
  58 CAMLexport void caml_fatal_error_arg (char *fmt, char *arg)
  59 {
  60   fprintf (stderr, fmt, arg);
  61   exit(2);
  62 }
  63
  64 CAMLexport void caml_fatal_error_arg2 (char *fmt1, char *arg1,
  65                                        char *fmt2, char *arg2)
  66 {
  67   fprintf (stderr, fmt1, arg1);
  68   fprintf (stderr, fmt2, arg2);
  69   exit(2);
  70 }
  71
  72 char *caml_aligned_malloc (asize_t size, int modulo, void **block)
  73 {
  74   char *raw_mem;
  75   uintnat aligned_mem;
  76                                                   Assert (modulo < Page_size);
  77   raw_mem = (char *) malloc (size + Page_size);
  78   if (raw_mem == NULL) return NULL;
  79   *block = raw_mem;
  80   raw_mem += modulo;                /* Address to be aligned */
  81   aligned_mem = (((uintnat) raw_mem / Page_size + 1) * Page_size);
  82 #ifdef DEBUG
  83   {
  84     uintnat *p;
  85     uintnat *p0 = (void *) *block,
  86             *p1 = (void *) (aligned_mem - modulo),
  87             *p2 = (void *) (aligned_mem - modulo + size),
  88             *p3 = (void *) ((char *) *block + size + Page_size);
  89
  90     for (p = p0; p < p1; p++) *p = Debug_filler_align;
  91     for (p = p1; p < p2; p++) *p = Debug_uninit_align;
  92     for (p = p2; p < p3; p++) *p = Debug_filler_align;
  93   }
  94 #endif
  95   return (char *) (aligned_mem - modulo);
  96 }
  97
  98 void caml_ext_table_init(struct ext_table * tbl, int init_capa)
  99 {
 100   tbl->size = 0;
 101   tbl->capacity = init_capa;
 102   tbl->contents = caml_stat_alloc(sizeof(void *) * init_capa);
 103 }
 104
 105 int caml_ext_table_add(struct ext_table * tbl, void * data)
 106 {
 107   int res;
 108   if (tbl->size >= tbl->capacity) {
 109     tbl->capacity *= 2;
 110     tbl->contents =
 111       caml_stat_resize(tbl->contents, sizeof(void *) * tbl->capacity);
 112   }
 113   res = tbl->size;
 114   tbl->contents[res] = data;
 115   tbl->size++;
 116   return res;
 117 }
 118
 119 void caml_ext_table_free(struct ext_table * tbl, int free_entries)
 120 {
 121   int i;
 122   if (free_entries)
 123     for (i = 0; i < tbl->size; i++) caml_stat_free(tbl->contents[i]);
 124   caml_stat_free(tbl->contents);
 125 }