147 lines
2.8 KiB
C
147 lines
2.8 KiB
C
|
/* Raising exceptions from C. */
|
||
|
|
|
||
|
|
#include "alloc.h"
|
||
|
|
#include "fail.h"
|
||
|
|
#include "gc.h"
|
||
|
|
#include "memory.h"
|
||
|
|
#include "mlvalues.h"
|
||
|
|
#include "roots.h"
|
||
|
|
#include "signals.h"
|
||
|
|
#include "stacks.h"
|
||
|
|
|
||
|
|
/* For minor_gc.c */
|
||
|
|
struct longjmp_buffer * external_raise;
|
||
|
|
|
||
|
|
/* The globals holding predefined exceptions */
|
||
|
|
|
||
|
|
value Out_of_memory, Sys_error, Failure, Invalid_argument;
|
||
|
|
value End_of_file, Division_by_zero, Not_found, Match_failure;
|
||
|
|
|
||
|
|
/* Initialize the predefined exceptions */
|
||
|
|
|
||
|
|
static struct { value * loc; char * name; } predefined_exceptions[] = {
|
||
|
|
&Out_of_memory, "Out_of_memory",
|
||
|
|
&Sys_error, "Sys_error",
|
||
|
|
&Failure, "Failure",
|
||
|
|
&Invalid_argument, "Invalid_argument",
|
||
|
|
&End_of_file, "End_of_file",
|
||
|
|
&Division_by_zero, "Division_by_zero",
|
||
|
|
&Not_found, "Not_found",
|
||
|
|
&Match_failure, "Match_failure",
|
||
|
|
NULL, NULL
|
||
|
|
};
|
||
|
|
|
||
|
|
void init_exceptions()
|
||
|
|
{
|
||
|
|
int i;
|
||
|
|
value * loc;
|
||
|
|
value exn_bucket;
|
||
|
|
Push_roots(r, 1);
|
||
|
|
for (i = 0; predefined_exceptions[i].loc != NULL; i++) {
|
||
|
|
r[0] = copy_string(predefined_exceptions[i].name);
|
||
|
|
exn_bucket = alloc(1, 0);
|
||
|
|
Field(exn_bucket, 0) = r[0];
|
||
|
|
loc = predefined_exceptions[i].loc;
|
||
|
|
*loc = exn_bucket;
|
||
|
|
register_global_root(loc);
|
||
|
|
}
|
||
|
|
Pop_roots();
|
||
|
|
}
|
||
|
|
|
||
|
|
/* Exception raising */
|
||
|
|
|
||
|
|
extern void raise_caml_exception P((value bucket)) Noreturn;
|
||
|
|
|
||
|
|
void mlraise(v)
|
||
|
|
value v;
|
||
|
|
{
|
||
|
|
leave_blocking_section();
|
||
|
|
raise_caml_exception(v);
|
||
|
|
}
|
||
|
|
|
||
|
|
void raise_constant(tag)
|
||
|
|
value tag;
|
||
|
|
{
|
||
|
|
value bucket;
|
||
|
|
Push_roots (a, 1);
|
||
|
|
a[0] = tag;
|
||
|
|
bucket = alloc (1, 0);
|
||
|
|
Field(bucket, 0) = a[0];
|
||
|
|
Pop_roots ();
|
||
|
|
mlraise(bucket);
|
||
|
|
}
|
||
|
|
|
||
|
|
void raise_with_arg(tag, arg)
|
||
|
|
value tag;
|
||
|
|
value arg;
|
||
|
|
{
|
||
|
|
value bucket;
|
||
|
|
Push_roots (a, 2);
|
||
|
|
a[0] = tag;
|
||
|
|
a[1] = arg;
|
||
|
|
bucket = alloc (2, 0);
|
||
|
|
Field(bucket, 0) = a[0];
|
||
|
|
Field(bucket, 1) = a[1];
|
||
|
|
Pop_roots ();
|
||
|
|
mlraise(bucket);
|
||
|
|
}
|
||
|
|
|
||
|
|
void raise_with_string(tag, msg)
|
||
|
|
value tag;
|
||
|
|
char * msg;
|
||
|
|
{
|
||
|
|
raise_with_arg(tag, copy_string(msg));
|
||
|
|
}
|
||
|
|
|
||
|
|
void failwith (msg)
|
||
|
|
char * msg;
|
||
|
|
{
|
||
|
|
raise_with_string(Failure, msg);
|
||
|
|
}
|
||
|
|
|
||
|
|
void invalid_argument (msg)
|
||
|
|
char * msg;
|
||
|
|
{
|
||
|
|
raise_with_string(Invalid_argument, msg);
|
||
|
|
}
|
||
|
|
|
||
|
|
/* To raise Out_of_memory, we can't use raise_constant,
|
||
|
|
because it allocates and we're out of memory...
|
||
|
|
We therefore build the bucket by hand.
|
||
|
|
This works OK because the exception value for Out_of_memory is also
|
||
|
|
statically allocated out of the heap. */
|
||
|
|
|
||
|
|
static struct {
|
||
|
|
header_t hdr;
|
||
|
|
value exn;
|
||
|
|
} out_of_memory_bucket;
|
||
|
|
|
||
|
|
void raise_out_of_memory()
|
||
|
|
{
|
||
|
|
out_of_memory_bucket.hdr = Make_header(1, 0, White);
|
||
|
|
out_of_memory_bucket.exn = Out_of_memory;
|
||
|
|
mlraise((value) &(out_of_memory_bucket.exn));
|
||
|
|
}
|
||
|
|
|
||
|
|
void raise_sys_error(msg)
|
||
|
|
value msg;
|
||
|
|
{
|
||
|
|
raise_with_arg(Sys_error, msg);
|
||
|
|
}
|
||
|
|
|
||
|
|
void raise_end_of_file()
|
||
|
|
{
|
||
|
|
raise_constant(End_of_file);
|
||
|
|
}
|
||
|
|
|
||
|
|
void raise_zero_divide()
|
||
|
|
{
|
||
|
|
raise_constant(Division_by_zero);
|
||
|
|
}
|
||
|
|
|
||
|
|
void raise_not_found()
|
||
|
|
{
|
||
|
|
raise_constant(Not_found);
|
||
|
|
}
|
||
|
|
|