97 lines
2.8 KiB
C
97 lines
2.8 KiB
C
|
/*
|
|||
|
|
*
|
|||
|
|
* e r r o r . c -- The error procedure
|
|||
|
|
*
|
|||
|
|
* Copyright <EFBFBD> 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
|
|||
|
|
*
|
|||
|
|
*
|
|||
|
|
* Permission to use, copy, and/or distribute this software and its
|
|||
|
|
* documentation for any purpose and without fee is hereby granted, provided
|
|||
|
|
* that both the above copyright notice and this permission notice appear in
|
|||
|
|
* all copies and derived works. Fees for distribution or use of this
|
|||
|
|
* software or derived works may only be charged with express written
|
|||
|
|
* permission of the copyright holder.
|
|||
|
|
* This software is provided ``as is'' without express or implied warranty.
|
|||
|
|
*
|
|||
|
|
* This software is a derivative work of other copyrighted softwares; the
|
|||
|
|
* copyright notices of these softwares are placed in the file COPYRIGHTS
|
|||
|
|
*
|
|||
|
|
* Author: Erick Gallesio [eg@unice.fr]
|
|||
|
|
* Creation date: 14-Nov-1993 14:58
|
|||
|
|
* Last file update: 2-Jun-1996 21:49
|
|||
|
|
*/
|
|||
|
|
|
|||
|
|
#include "stk.h"
|
|||
|
|
|
|||
|
|
static jmp_buf global_jmp_buf; /* Jump buffer denoting toplevel context */
|
|||
|
|
jmp_buf *Top_jmp_buf = &global_jmp_buf;
|
|||
|
|
|
|||
|
|
long Error_context = ERR_FATAL;
|
|||
|
|
|
|||
|
|
|
|||
|
|
void STk_err(char *message, SCM x)
|
|||
|
|
{
|
|||
|
|
SCM tmp;
|
|||
|
|
static int err_counter=0; /* to avoid loops when REPORT_ERROR proc is buggy */
|
|||
|
|
char head[MAX_PATH_LENGTH+50];
|
|||
|
|
|
|||
|
|
err_counter += 1;
|
|||
|
|
|
|||
|
|
STk_reset_eval_hook();
|
|||
|
|
|
|||
|
|
if (!(Error_context & ERR_IGNORED)) {
|
|||
|
|
/* Error is not ignored: A message must be printed */
|
|||
|
|
if (*message) {
|
|||
|
|
switch (Error_context) {
|
|||
|
|
case ERR_READ_FROM_STRING:
|
|||
|
|
strcpy(head,"*** Read from string error:\n"); break;
|
|||
|
|
case ERR_FATAL:
|
|||
|
|
case ERR_OK:
|
|||
|
|
if (STk_current_filename==UNBOUND)
|
|||
|
|
sprintf(head, "*** Error:\n");
|
|||
|
|
else {
|
|||
|
|
sprintf(head, "*** Error at line %d of file %s:\n",
|
|||
|
|
STk_line_counter, CHARS(STk_current_filename));
|
|||
|
|
STk_current_filename = UNBOUND;
|
|||
|
|
}
|
|||
|
|
break;
|
|||
|
|
#ifdef USE_TK
|
|||
|
|
case ERR_TCL_BACKGROUND:
|
|||
|
|
strcpy(head, "*** Background error:\n"); break;
|
|||
|
|
#endif
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
tmp = VCELL(Intern(REPORT_ERROR));
|
|||
|
|
if (tmp!=UNBOUND && STk_procedurep(tmp)==Truth && err_counter==1 && *message)
|
|||
|
|
Apply(tmp, LIST3(STk_makestring(head),
|
|||
|
|
STk_makestring(message),
|
|||
|
|
STk_uncode(x)));
|
|||
|
|
else {
|
|||
|
|
if (err_counter>1)
|
|||
|
|
fprintf(STk_stderr, "WARNING: %s is buggy!!\n", REPORT_ERROR);
|
|||
|
|
fprintf(STk_stderr, "\n%s %s", head, message);
|
|||
|
|
if (NNULLP(x)) {
|
|||
|
|
fprintf(STk_stderr, ": ");
|
|||
|
|
STk_print(STk_uncode(x), STk_curr_eport, WRT_MODE);
|
|||
|
|
}
|
|||
|
|
STk_show_eval_stack(5);
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
fflush(STk_stdout); fflush(STk_stderr);
|
|||
|
|
STk_reset_eval_stack();
|
|||
|
|
/*
|
|||
|
|
* Do all the terminal thunk of dynamic winds and make a long jump to
|
|||
|
|
* location retained in Top_jmp_buf
|
|||
|
|
*/
|
|||
|
|
STk_unwind_all();
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
err_counter = 0;
|
|||
|
|
switch (Error_context) {
|
|||
|
|
case ERR_FATAL:
|
|||
|
|
STk_panic("FATAL ERROR IN CRITICAL CODE SECTION. ABANDON\n");
|
|||
|
|
default:
|
|||
|
|
longjmp(*Top_jmp_buf, JMP_ERROR);
|
|||
|
|
}
|
|||
|
|
}
|