fail.[ch], stacks.c: ajout de l'exception Stack_overflow
printexc.c: meilleur affichage memory.c: parentheser comme le suggere gcc git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@1552 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02master
parent
3f1b15e439
commit
e204d29d8f
|
@ -102,6 +102,11 @@ void raise_out_of_memory()
|
|||
mlraise((value) &(out_of_memory_bucket.exn));
|
||||
}
|
||||
|
||||
void raise_stack_overflow()
|
||||
{
|
||||
raise_constant(Field(global_data, STACK_OVERFLOW_EXN));
|
||||
}
|
||||
|
||||
void raise_sys_error(msg)
|
||||
value msg;
|
||||
{
|
||||
|
|
|
@ -27,6 +27,7 @@
|
|||
#define ZERO_DIVIDE_EXN 5 /* "Division_by_zero" */
|
||||
#define NOT_FOUND_EXN 6 /* "Not_found" */
|
||||
#define MATCH_FAILURE_EXN 7 /* "Match_failure" */
|
||||
#define STACK_OVERFLOW_EXN 8 /* "Stack_overflow" */
|
||||
|
||||
#ifdef POSIX_SIGNALS
|
||||
struct longjmp_buffer {
|
||||
|
@ -50,6 +51,7 @@ void raise_with_string P((value tag, char * msg)) Noreturn;
|
|||
void failwith P((char *)) Noreturn;
|
||||
void invalid_argument P((char *)) Noreturn;
|
||||
void raise_out_of_memory P((void)) Noreturn;
|
||||
void raise_stack_overflow P((void)) Noreturn;
|
||||
void raise_sys_error P((value)) Noreturn;
|
||||
void raise_end_of_file P((void)) Noreturn;
|
||||
void raise_zero_divide P((void)) Noreturn;
|
||||
|
|
|
@ -187,11 +187,11 @@ value alloc_shr (wosize, tag)
|
|||
Assert (Is_in_heap (Val_hp (hp)));
|
||||
|
||||
if (gc_phase == Phase_mark
|
||||
|| gc_phase == Phase_sweep && (addr)hp >= (addr)gc_sweep_hp){
|
||||
|| (gc_phase == Phase_sweep && (addr)hp >= (addr)gc_sweep_hp)){
|
||||
Hd_hp (hp) = Make_header (wosize, tag, Black);
|
||||
}else{
|
||||
Assert (gc_phase == Phase_idle
|
||||
|| gc_phase == Phase_sweep && (addr)hp < (addr)gc_sweep_hp);
|
||||
|| (gc_phase == Phase_sweep && (addr)hp < (addr)gc_sweep_hp));
|
||||
Hd_hp (hp) = Make_header (wosize, tag, White);
|
||||
}
|
||||
allocated_words += Whsize_wosize (wosize);
|
||||
|
|
|
@ -15,6 +15,7 @@
|
|||
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include "fail.h"
|
||||
#include "misc.h"
|
||||
#include "mlvalues.h"
|
||||
|
@ -22,37 +23,79 @@
|
|||
#include "ui.h"
|
||||
#endif
|
||||
|
||||
struct stringbuf {
|
||||
char * ptr;
|
||||
char * end;
|
||||
char data[256];
|
||||
};
|
||||
|
||||
static void add_char(buf, c)
|
||||
struct stringbuf * buf;
|
||||
char c;
|
||||
{
|
||||
if (buf->ptr < buf->end) *(buf->ptr++) = c;
|
||||
}
|
||||
|
||||
static void add_string(buf, s)
|
||||
struct stringbuf * buf;
|
||||
char * s;
|
||||
{
|
||||
int len = strlen(s);
|
||||
if (buf->ptr + len > buf->end) len = buf->end - buf->ptr;
|
||||
if (len > 0) bcopy(s, buf->ptr, len);
|
||||
buf->ptr += len;
|
||||
}
|
||||
|
||||
#ifdef HAS_UI
|
||||
#define errprintf1(fmt) ui_print_stderr(fmt, NULL)
|
||||
#define errprintf2(fmt,arg) ui_print_stderr(fmt, (char *)(arg))
|
||||
#define errprintf(fmt,arg) ui_print_stderr(fmt, arg)
|
||||
#else
|
||||
#define errprintf1(fmt) fprintf(stderr, fmt)
|
||||
#define errprintf2(fmt,arg) fprintf(stderr, fmt, arg)
|
||||
#define errprintf(fmt,arg) fprintf(stderr, fmt, arg)
|
||||
#endif
|
||||
|
||||
void fatal_uncaught_exception(exn)
|
||||
value exn;
|
||||
{
|
||||
mlsize_t i;
|
||||
value v;
|
||||
mlsize_t start, i;
|
||||
value bucket, v;
|
||||
struct stringbuf buf;
|
||||
char intbuf[64];
|
||||
|
||||
errprintf2("Fatal error: uncaught exception %s",
|
||||
String_val(Field(Field(exn, 0), 0)));
|
||||
buf.ptr = buf.data;
|
||||
buf.end = buf.data + sizeof(buf.data) - 1;
|
||||
add_string(&buf, String_val(Field(Field(exn, 0), 0)));
|
||||
if (Wosize_val(exn) >= 2) {
|
||||
errprintf1("(");
|
||||
for (i = 1; i < Wosize_val(exn); i++) {
|
||||
if (i > 1) errprintf1(", ");
|
||||
v = Field(exn, i);
|
||||
if (Is_long(v))
|
||||
errprintf2("%ld", Long_val(v));
|
||||
else if (Tag_val(v) == String_tag)
|
||||
errprintf2("\"%s\"", String_val(v));
|
||||
else
|
||||
errprintf1("_");
|
||||
/* Check for exceptions in the style of Match_failure and Assert_failure */
|
||||
if (Wosize_val(exn) == 2 &&
|
||||
Is_block(Field(exn, 1)) &&
|
||||
Tag_val(Field(exn, 1)) == 0) {
|
||||
bucket = Field(exn, 1);
|
||||
start = 0;
|
||||
} else {
|
||||
bucket = exn;
|
||||
start = 1;
|
||||
}
|
||||
errprintf1(")");
|
||||
add_char(&buf, '(');
|
||||
for (i = start; i < Wosize_val(bucket); i++) {
|
||||
if (i > start) add_string(&buf, ", ");
|
||||
v = Field(bucket, i);
|
||||
if (Is_long(v)) {
|
||||
sprintf(intbuf, "%ld", Long_val(v));
|
||||
add_string(&buf, intbuf);
|
||||
} else if (Tag_val(v) == String_tag) {
|
||||
add_char(&buf, '"');
|
||||
add_string(&buf, String_val(v));
|
||||
add_char(&buf, '"');
|
||||
} else {
|
||||
add_char(&buf, '_');
|
||||
}
|
||||
errprintf1("\n");
|
||||
}
|
||||
add_char(&buf, ')');
|
||||
}
|
||||
*buf.ptr = 0; /* Terminate string */
|
||||
errprintf("Fatal error: uncaught exception %s\n", buf.data);
|
||||
#ifdef HAS_UI
|
||||
ui_exit(2);
|
||||
#else
|
||||
exit(2);
|
||||
#endif
|
||||
}
|
||||
|
||||
|
|
|
@ -50,7 +50,7 @@ void realloc_stack()
|
|||
|
||||
Assert(extern_sp >= stack_low);
|
||||
size = stack_high - stack_low;
|
||||
if (size >= max_stack_size) raise_out_of_memory();
|
||||
if (size >= max_stack_size) raise_stack_overflow();
|
||||
size *= 2;
|
||||
gc_message ("Growing stack to %luk bytes\n",
|
||||
(unsigned long) size * sizeof(value) / 1024);
|
||||
|
|
Loading…
Reference in New Issue