l4/pkg/ocaml/contrib/byterun/fail.c

   1 /***********************************************************************/
   2 /*                                                                     */
   3 /*                           Objective Caml                            */
   4 /*                                                                     */
   5 /*            Xavier Leroy, projet Cristal, 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: fail.c 9030 2008-09-18 11:23:28Z xleroy $ */
  15
  16 /* Raising exceptions from C. */
  17
  18 #include "alloc.h"
  19 #include "fail.h"
  20 #include "io.h"
  21 #include "gc.h"
  22 #include "memory.h"
  23 #include "misc.h"
  24 #include "mlvalues.h"
  25 #include "printexc.h"
  26 #include "signals.h"
  27 #include "stacks.h"
  28
  29 CAMLexport struct longjmp_buffer * caml_external_raise = NULL;
  30 value caml_exn_bucket;
  31
  32 CAMLexport void caml_raise(value v)
  33 {
  34   Unlock_exn();
  35   caml_exn_bucket = v;
  36   if (caml_external_raise == NULL) caml_fatal_uncaught_exception(v);
  37   siglongjmp(caml_external_raise->buf, 1);
  38 }
  39
  40 CAMLexport void caml_raise_constant(value tag)
  41 {
  42   CAMLparam1 (tag);
  43   CAMLlocal1 (bucket);
  44
  45   bucket = caml_alloc_small (1, 0);
  46   Field(bucket, 0) = tag;
  47   caml_raise(bucket);
  48   CAMLnoreturn;
  49 }
  50
  51 CAMLexport void caml_raise_with_arg(value tag, value arg)
  52 {
  53   CAMLparam2 (tag, arg);
  54   CAMLlocal1 (bucket);
  55
  56   bucket = caml_alloc_small (2, 0);
  57   Field(bucket, 0) = tag;
  58   Field(bucket, 1) = arg;
  59   caml_raise(bucket);
  60   CAMLnoreturn;
  61 }
  62
  63 CAMLexport void caml_raise_with_args(value tag, int nargs, value args[])
  64 {
  65   CAMLparam1 (tag);
  66   CAMLxparamN (args, nargs);
  67   value bucket;
  68   int i;
  69
  70   Assert(1 + nargs <= Max_young_wosize);
  71   bucket = caml_alloc_small (1 + nargs, 0);
  72   Field(bucket, 0) = tag;
  73   for (i = 0; i < nargs; i++) Field(bucket, 1 + i) = args[i];
  74   caml_raise(bucket);
  75   CAMLnoreturn;
  76 }
  77
  78 CAMLexport void caml_raise_with_string(value tag, char const *msg)
  79 {
  80   CAMLparam1 (tag);
  81   CAMLlocal1 (vmsg);
  82
  83   vmsg = caml_copy_string(msg);
  84   caml_raise_with_arg(tag, vmsg);
  85   CAMLnoreturn;
  86 }
  87
  88 CAMLexport void caml_failwith (char const *msg)
  89 {
  90   caml_raise_with_string(Field(caml_global_data, FAILURE_EXN), msg);
  91 }
  92
  93 CAMLexport void caml_invalid_argument (char const *msg)
  94 {
  95   caml_raise_with_string(Field(caml_global_data, INVALID_EXN), msg);
  96 }
  97
  98 CAMLexport void caml_array_bound_error(void)
  99 {
 100   caml_invalid_argument("index out of bounds");
 101 }
 102
 103 /* Problem: we can't use [caml_raise_constant], because it allocates and
 104    we're out of memory... Here, we allocate statically the exn bucket
 105    for [Out_of_memory]. */
 106
 107 static struct {
 108   header_t hdr;
 109   value exn;
 110 } out_of_memory_bucket = { 0, 0 };
 111
 112 CAMLexport void caml_raise_out_of_memory(void)
 113 {
 114   if (out_of_memory_bucket.exn == 0)
 115     caml_fatal_error
 116       ("Fatal error: out of memory while raising Out_of_memory\n");
 117   caml_raise((value) &(out_of_memory_bucket.exn));
 118 }
 119
 120 CAMLexport void caml_raise_stack_overflow(void)
 121 {
 122   caml_raise_constant(Field(caml_global_data, STACK_OVERFLOW_EXN));
 123 }
 124
 125 CAMLexport void caml_raise_sys_error(value msg)
 126 {
 127   caml_raise_with_arg(Field(caml_global_data, SYS_ERROR_EXN), msg);
 128 }
 129
 130 CAMLexport void caml_raise_end_of_file(void)
 131 {
 132   caml_raise_constant(Field(caml_global_data, END_OF_FILE_EXN));
 133 }
 134
 135 CAMLexport void caml_raise_zero_divide(void)
 136 {
 137   caml_raise_constant(Field(caml_global_data, ZERO_DIVIDE_EXN));
 138 }
 139
 140 CAMLexport void caml_raise_not_found(void)
 141 {
 142   caml_raise_constant(Field(caml_global_data, NOT_FOUND_EXN));
 143 }
 144
 145 CAMLexport void caml_raise_sys_blocked_io(void)
 146 {
 147   caml_raise_constant(Field(caml_global_data, SYS_BLOCKED_IO));
 148 }
 149
 150 /* Initialization of statically-allocated exception buckets */
 151
 152 void caml_init_exceptions(void)
 153 {
 154   out_of_memory_bucket.hdr = Make_header(1, 0, Caml_white);
 155   out_of_memory_bucket.exn = Field(caml_global_data, OUT_OF_MEMORY_EXN);
 156   caml_register_global_root(&out_of_memory_bucket.exn);
 157 }