diff --git a/byterun/fail.c b/byterun/fail.c index 52fae0f3e..70d07d770 100644 --- a/byterun/fail.c +++ b/byterun/fail.c @@ -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; { diff --git a/byterun/fail.h b/byterun/fail.h index 72233a9da..c6d5eca86 100644 --- a/byterun/fail.h +++ b/byterun/fail.h @@ -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; diff --git a/byterun/memory.c b/byterun/memory.c index a900dc4be..ff9eda9fe 100644 --- a/byterun/memory.c +++ b/byterun/memory.c @@ -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); diff --git a/byterun/printexc.c b/byterun/printexc.c index 3d9a02118..7482c509d 100644 --- a/byterun/printexc.c +++ b/byterun/printexc.c @@ -15,6 +15,7 @@ #include #include +#include #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, '_'); + } + } + add_char(&buf, ')'); } - errprintf1("\n"); + *buf.ptr = 0; /* Terminate string */ + errprintf("Fatal error: uncaught exception %s\n", buf.data); +#ifdef HAS_UI + ui_exit(2); +#else exit(2); +#endif } - diff --git a/byterun/stacks.c b/byterun/stacks.c index 565391926..82f754176 100644 --- a/byterun/stacks.c +++ b/byterun/stacks.c @@ -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);