error.d 17.1 KB
Newer Older
Daniel Kochmański's avatar
Daniel Kochmański committed
1
2
/* -*- Mode: C; c-basic-offset: 2; indent-tabs-mode: nil -*- */
/* vim: set filetype=c tabstop=2 shiftwidth=2 expandtab: */
3

jjgarcia's avatar
jjgarcia committed
4
/*
Daniel Kochmański's avatar
Daniel Kochmański committed
5
6
7
8
9
10
11
12
13
 * error.d - error handling
 *
 * Copyright (c) 1984 Taiichi Yuasa and Masami Hagiya
 * Copyright (c) 1990 Giuseppe Attardi
 * Copyright (c) 2001 Juan Jose Garcia Ripoll
 *
 * See file 'LICENSE' for the copyright details.
 *
 */
jjgarcia's avatar
jjgarcia committed
14

15
#include <ecl/ecl.h>
16
#include <stdio.h>
jjgarcia's avatar
jjgarcia committed
17
#include <string.h>
18
#include <errno.h>
19
#include <signal.h>
jjgarcia's avatar
jjgarcia committed
20
#include <stdlib.h>
21
#if defined(ECL_MS_WINDOWS_HOST) || defined(cygwin)
22
# include <windows.h>
23
#endif
24
#include <ecl/internal.h>
25
#include <ecl/ecl-inl.h>
jjgarcia's avatar
jjgarcia committed
26

27
28
29
static cl_object
cl_symbol_or_object(cl_object x)
{
Daniel Kochmański's avatar
Daniel Kochmański committed
30
31
32
  if (ECL_FIXNUMP(x))
    return (cl_object)(cl_symbols + ecl_fixnum(x));
  return x;
33
34
}

35
36
37
void
_ecl_unexpected_return()
{
Daniel Kochmański's avatar
Daniel Kochmański committed
38
39
40
41
42
43
44
  ecl_internal_error(
                     "*** \n"
                     "*** A call to ERROR returned without handling the error.\n"
                     "*** This should have never happened and is usually a signal\n"
                     "*** that the debugger or the universal error handler were\n"
                     "*** improperly coded or altered. Please contact the maintainers\n"
                     "***\n");
45
46
}

jjgarcia's avatar
jjgarcia committed
47
void
48
ecl_internal_error(const char *s)
jjgarcia's avatar
jjgarcia committed
49
{
Daniel Kochmański's avatar
Daniel Kochmański committed
50
51
52
53
54
55
56
57
  int saved_errno = errno;
  fprintf(stderr, "\nInternal or unrecoverable error in:\n%s\n", s);
  if (saved_errno) {
    fprintf(stderr, "  [%d: %s]\n", saved_errno,
            strerror(saved_errno));
  }
  fflush(stderr);
  si_dump_c_backtrace(ecl_make_fixnum(32));
jjgarcia's avatar
jjgarcia committed
58
#ifdef SIGIOT
Daniel Kochmański's avatar
Daniel Kochmański committed
59
  signal(SIGIOT, SIG_DFL); /* avoid getting into a loop with abort */
jjgarcia's avatar
jjgarcia committed
60
#endif
Daniel Kochmański's avatar
Daniel Kochmański committed
61
  abort();
jjgarcia's avatar
jjgarcia committed
62
63
}

64
65
66
67
68
69
70
71
72
73
#ifdef ECL_THREADS
void
ecl_thread_internal_error(const char *s)
{
  int saved_errno = errno;
  fprintf(stderr, "\nInternal thread error in:\n%s\n", s);
  if (saved_errno) {
    fprintf(stderr, "  [%d: %s]\n", saved_errno,
            strerror(saved_errno));
  }
74
75
76
  fprintf(stderr,
          "\nDid you forget to call `ecl_import_current_thread'?\n"
          "Exitting thread.\n");
77
  fflush(stderr);
78
79
80
#ifdef ECL_WINDOWS_THREADS
  ExitThread(0);
#else
81
  pthread_exit(NULL);
82
#endif
83
84
}
#endif
85
86
87
88

void
ecl_unrecoverable_error(cl_env_ptr the_env, const char *message)
{
Daniel Kochmański's avatar
Daniel Kochmański committed
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
  /*
   * Right now we have no means of specifying a jump point
   * for really bad events. We just jump to the outermost
   * frame, which is equivalent to quitting, and wait for
   * someone to intercept this jump.
   */
  ecl_frame_ptr destination;
  cl_object tag;

  /*
   * We output the error message with very low level routines
   * because we can not risk another stack overflow.
   */
  writestr_stream(message, cl_core.error_output);

  tag = ECL_SYM_VAL(the_env, @'si::*quit-tag*');
  the_env->nvalues = 0;
  if (tag) {
    destination = frs_sch(tag);
    if (destination) {
      ecl_unwind(the_env, destination);
    }
  }
  if (the_env->frs_org <= the_env->frs_top) {
    destination = ecl_process_env()->frs_org;
    ecl_unwind(the_env, destination);
  } else {
    ecl_internal_error("\n;;;\n;;; No frame to jump to\n;;; Aborting ECL\n;;;");
  }
118
119
}

jjgarcia's avatar
jjgarcia committed
120
/*****************************************************************************/
Daniel Kochmański's avatar
Daniel Kochmański committed
121
/*              Support for Lisp Error Handler                               */
jjgarcia's avatar
jjgarcia committed
122
123
124
/*****************************************************************************/

void
125
FEerror(const char *s, int narg, ...)
jjgarcia's avatar
jjgarcia committed
126
{
Daniel Kochmański's avatar
Daniel Kochmański committed
127
  ecl_va_list args;
128
  cl_object rest;
Daniel Kochmański's avatar
Daniel Kochmański committed
129
130
  ecl_va_start(args, narg, narg, 0);
  ecl_enable_interrupts();
131
132
  rest = cl_grab_rest_args(args);
  ecl_va_end(args);
Daniel Kochmański's avatar
Daniel Kochmański committed
133
134
135
  funcall(4, @'si::universal-error-handler',
          ECL_NIL,                    /*  not correctable  */
          make_constant_base_string(s),    /*  condition text  */
136
          rest);
Daniel Kochmański's avatar
Daniel Kochmański committed
137
  _ecl_unexpected_return();
jjgarcia's avatar
jjgarcia committed
138
139
140
}

cl_object
141
CEerror(cl_object c, const char *err, int narg, ...)
jjgarcia's avatar
jjgarcia committed
142
{
Daniel Kochmański's avatar
Daniel Kochmański committed
143
144
145
146
147
148
149
  ecl_va_list args;
  ecl_va_start(args, narg, narg, 0);
  ecl_enable_interrupts();
  return funcall(4, @'si::universal-error-handler',
                 c,                       /*  correctable  */
                 make_constant_base_string(err),  /*  continue-format-string  */
                 cl_grab_rest_args(args));
jjgarcia's avatar
jjgarcia committed
150
151
152
153
154
155
156
157
}

/***********************
 * Conditions signaler *
 ***********************/

void
FEprogram_error(const char *s, int narg, ...)
158
{
Daniel Kochmański's avatar
Daniel Kochmański committed
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
  cl_object real_args, text;
  ecl_va_list args;
  ecl_va_start(args, narg, narg, 0);
  text = make_constant_base_string(s);
  real_args = cl_grab_rest_args(args);
  if (cl_boundp(@'si::*current-form*') != ECL_NIL) {
    /* When FEprogram_error is invoked from the compiler, we can
     * provide information about the offending form.
     */
    cl_object stmt = ecl_symbol_value(@'si::*current-form*');
    if (stmt != ECL_NIL) {
      real_args = @list(3, stmt, text, real_args);
      text = make_constant_base_string("In form~%~S~%~?");
    }
  }
  si_signal_simple_error(4, 
                         @'program-error', /* condition name */
                         ECL_NIL, /* not correctable */
                         text,
                         real_args);
179
  _ecl_unexpected_return();
180
181
182
183
}

void
FEprogram_error_noreturn(const char *s, int narg, ...)
jjgarcia's avatar
jjgarcia committed
184
{
Daniel Kochmański's avatar
Daniel Kochmański committed
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
  cl_object real_args, text;
  ecl_va_list args;
  ecl_va_start(args, narg, narg, 0);
  text = make_constant_base_string(s);
  real_args = cl_grab_rest_args(args);
  if (cl_boundp(@'si::*current-form*') != ECL_NIL) {
    /* When FEprogram_error is invoked from the compiler, we can
     * provide information about the offending form.
     */
    cl_object stmt = ecl_symbol_value(@'si::*current-form*');
    if (stmt != ECL_NIL) {
      real_args = @list(3, stmt, text, real_args);
      text = make_constant_base_string("In form~%~S~%~?");
    }
  }
  si_signal_simple_error(4, 
                         @'program-error', /* condition name */
                         ECL_NIL, /* not correctable */
                         text,
                         real_args);
205
  _ecl_unexpected_return();
jjgarcia's avatar
jjgarcia committed
206
207
208
209
210
}

void
FEcontrol_error(const char *s, int narg, ...)
{
Daniel Kochmański's avatar
Daniel Kochmański committed
211
212
213
214
215
216
217
  ecl_va_list args;
  ecl_va_start(args, narg, narg, 0);
  si_signal_simple_error(4,
                         @'control-error', /* condition name */
                         ECL_NIL, /* not correctable */
                         make_constant_base_string(s), /* format control */
                         cl_grab_rest_args(args)); /* format args */
218
  _ecl_unexpected_return();
jjgarcia's avatar
jjgarcia committed
219
220
}

221
222
223
void
FEreader_error(const char *s, cl_object stream, int narg, ...)
{
Daniel Kochmański's avatar
Daniel Kochmański committed
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
  cl_object message = make_constant_base_string(s);
  cl_object args_list;
  ecl_va_list args;
  ecl_va_start(args, narg, narg, 0);
  args_list = cl_grab_rest_args(args);
  if (Null(stream)) {
    /* Parser error */
    si_signal_simple_error(4,
                           @'parse-error', /* condition name */
                           ECL_NIL, /* not correctable */
                           message, /* format control */
                           args_list);
  } else {
    /* Actual reader error */
    cl_object prefix = make_constant_base_string("Reader error in file ~S, "
                                                 "position ~D:~%");
    cl_object position = cl_file_position(1, stream);
    message = si_base_string_concatenate(2, prefix, message);
    args_list = cl_listX(3, stream, position, args_list);
    si_signal_simple_error(6,
                           @'reader-error', /* condition name */
                           ECL_NIL, /* not correctable */
                           message, /* format control */
                           args_list, /* format args */
                           @':stream', stream);
  }
250
  _ecl_unexpected_return();
251
252
253
}


jjgarcia's avatar
jjgarcia committed
254
255
256
void
FEcannot_open(cl_object fn)
{
Daniel Kochmański's avatar
Daniel Kochmański committed
257
  cl_error(3, @'file-error', @':pathname', fn);
jjgarcia's avatar
jjgarcia committed
258
259
260
261
262
}

void
FEend_of_file(cl_object strm)
{
Daniel Kochmański's avatar
Daniel Kochmański committed
263
  cl_error(3, @'end-of-file', @':stream', strm);
jjgarcia's avatar
jjgarcia committed
264
265
}

266
267
268
void
FEclosed_stream(cl_object strm)
{
Daniel Kochmański's avatar
Daniel Kochmański committed
269
  cl_error(3, @'stream-error', @':stream', strm);
270
271
}

272
273
274
cl_object
si_signal_type_error(cl_object value, cl_object type)
{
Daniel Kochmański's avatar
Daniel Kochmański committed
275
276
  cl_error(5, @'type-error', @':expected-type', type,
           @':datum', value);
277
278
}

jjgarcia's avatar
jjgarcia committed
279
280
281
void
FEwrong_type_argument(cl_object type, cl_object value)
{
Daniel Kochmański's avatar
Daniel Kochmański committed
282
  si_signal_type_error(value, cl_symbol_or_object(type));
jjgarcia's avatar
jjgarcia committed
283
284
}

285
286
287
void
FEwrong_type_only_arg(cl_object function, cl_object value, cl_object type)
{
Daniel Kochmański's avatar
Daniel Kochmański committed
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
  const char *message =
    "In ~:[an anonymous function~;~:*function ~A~], "
    "the value of the only argument is~&  ~S~&which is "
    "not of the expected type ~A";
  cl_env_ptr env = ecl_process_env();
  struct ecl_ihs_frame tmp_ihs;
  function = cl_symbol_or_object(function);
  type = cl_symbol_or_object(type);
  if (!Null(function) && env->ihs_top && env->ihs_top->function != function) {
    ecl_ihs_push(env,&tmp_ihs,function,ECL_NIL);
  }        
  si_signal_simple_error(8,
                         @'type-error', /* condition name */
                         ECL_NIL, /* not correctable */
                         make_constant_base_string(message), /* format control */
                         cl_list(3, function, value, type),
                         @':expected-type', type,
                         @':datum', value);
306
  _ecl_unexpected_return();
307
308
}

309
310
311
void
FEwrong_type_nth_arg(cl_object function, cl_narg narg, cl_object value, cl_object type)
{
Daniel Kochmański's avatar
Daniel Kochmański committed
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
  const char *message =
    "In ~:[an anonymous function~;~:*function ~A~], "
    "the value of the ~:R argument is~&  ~S~&which is "
    "not of the expected type ~A";
  cl_env_ptr env = ecl_process_env();
  struct ecl_ihs_frame tmp_ihs;
  function = cl_symbol_or_object(function);
  type = cl_symbol_or_object(type);
  if (!Null(function) && env->ihs_top && env->ihs_top->function != function) {
    ecl_ihs_push(env,&tmp_ihs,function,ECL_NIL);
  }        
  si_signal_simple_error(8,
                         @'type-error', /* condition name */
                         ECL_NIL, /* not correctable */
                         make_constant_base_string(message), /* format control */
                         cl_list(4, function, ecl_make_fixnum(narg),
                                 value, type),
                         @':expected-type', type,
                         @':datum', value);
331
  _ecl_unexpected_return();
332
333
}

334
335
336
void
FEwrong_type_key_arg(cl_object function, cl_object key, cl_object value, cl_object type)
{
Daniel Kochmański's avatar
Daniel Kochmański committed
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
  const char *message =
    "In ~:[an anonymous function~;~:*function ~A~], "
    "the value of the argument ~S is~&  ~S~&which is "
    "not of the expected type ~A";
  cl_env_ptr env = ecl_process_env();
  struct ecl_ihs_frame tmp_ihs;
  function = cl_symbol_or_object(function);
  type = cl_symbol_or_object(type);
  key = cl_symbol_or_object(key);
  if (!Null(function) && env->ihs_top && env->ihs_top->function != function) {
    ecl_ihs_push(env,&tmp_ihs,function,ECL_NIL);
  }        
  si_signal_simple_error(8,
                         @'type-error', /* condition name */
                         ECL_NIL, /* not correctable */
                         make_constant_base_string(message), /* format control */
                         cl_list(4, function, key, value, type),
                         @':expected-type', type,
                         @':datum', value);
356
  _ecl_unexpected_return();
357
358
359
360
361
362
}

void
FEwrong_index(cl_object function, cl_object a, int which, cl_object ndx,
              cl_index nonincl_limit)
{
Daniel Kochmański's avatar
Daniel Kochmański committed
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
  const char *message1 =
    "In ~:[an anonymous function~;~:*function ~A~], "
    "the ~*index into the object~% ~A.~%"
    "takes a value ~D out of the range ~A.";
  const char *message2 =
    "In ~:[an anonymous function~;~:*function ~A~], "
    "the ~:R index into the object~% ~A~%"
    "takes a value ~D out of the range ~A.";
  cl_object limit = ecl_make_integer(nonincl_limit-1);
  cl_object type = ecl_make_integer_type(ecl_make_fixnum(0), limit);
  cl_object message = make_constant_base_string((which<0) ? message1 : message2);
  cl_env_ptr env = ecl_process_env();
  struct ecl_ihs_frame tmp_ihs;
  function = cl_symbol_or_object(function);
  if (!Null(function) && env->ihs_top && env->ihs_top->function != function) {
    ecl_ihs_push(env,&tmp_ihs,function,ECL_NIL);
  }        
  cl_error(9,
           @'simple-type-error', /* condition name */
           @':format-control', message,
           @':format-arguments',
           cl_list(5, function, ecl_make_fixnum(which+1), a, ndx, type),
           @':expected-type', type,
           @':datum', ndx);
387
388
}

jjgarcia's avatar
jjgarcia committed
389
390
391
void
FEunbound_variable(cl_object sym)
{
Daniel Kochmański's avatar
Daniel Kochmański committed
392
  cl_error(3, @'unbound-variable', @':name', sym);
jjgarcia's avatar
jjgarcia committed
393
394
395
396
397
}

void
FEundefined_function(cl_object fname)
{
Daniel Kochmański's avatar
Daniel Kochmański committed
398
  cl_error(3, @'undefined-function', @':name', fname);
jjgarcia's avatar
jjgarcia committed
399
400
}

401
402
403
void
FEprint_not_readable(cl_object x)
{
Daniel Kochmański's avatar
Daniel Kochmański committed
404
  cl_error(3, @'print-not-readable', @':object', x);
405
406
}

jjgarcia's avatar
jjgarcia committed
407
408
409
410
411
/*************
 * Shortcuts *
 *************/

void
412
FEwrong_num_arguments(cl_object fun)
jjgarcia's avatar
jjgarcia committed
413
{
Daniel Kochmański's avatar
Daniel Kochmański committed
414
415
416
  fun = cl_symbol_or_object(fun);
  FEprogram_error("Wrong number of arguments passed to function ~S.",
                  1, fun);
jjgarcia's avatar
jjgarcia committed
417
418
419
}

void
420
FEwrong_num_arguments_anonym(void)
jjgarcia's avatar
jjgarcia committed
421
{
Daniel Kochmański's avatar
Daniel Kochmański committed
422
  FEprogram_error("Wrong number of arguments passed to an anonymous function", 0);
jjgarcia's avatar
jjgarcia committed
423
424
425
426
427
}

void
FEinvalid_macro_call(cl_object name)
{
Daniel Kochmański's avatar
Daniel Kochmański committed
428
  FEerror("Invalid macro call to ~S.", 1, name);
jjgarcia's avatar
jjgarcia committed
429
430
431
}

void
432
FEinvalid_variable(const char *s, cl_object obj)
jjgarcia's avatar
jjgarcia committed
433
{
Daniel Kochmański's avatar
Daniel Kochmański committed
434
  FEerror(s, 1, obj);
jjgarcia's avatar
jjgarcia committed
435
436
}

437
438
439
440
441
442
void
FEillegal_variable_name(cl_object v)
{
  FEprogram_error("Not a valid variable name ~S.", 1, v);
}

jjgarcia's avatar
jjgarcia committed
443
444
445
void
FEassignment_to_constant(cl_object v)
{
Daniel Kochmański's avatar
Daniel Kochmański committed
446
  FEprogram_error("SETQ: Tried to assign a value to the constant ~S.", 1, v);
jjgarcia's avatar
jjgarcia committed
447
448
}

449
450
451
452
453
454
void
FEbinding_a_constant(cl_object v)
{
  FEprogram_error("The constant ~S is being bound.", 1, v);
}

jjgarcia's avatar
jjgarcia committed
455
456
457
void
FEinvalid_function(cl_object obj)
{
Daniel Kochmański's avatar
Daniel Kochmański committed
458
  FEwrong_type_argument(@'function', obj);
jjgarcia's avatar
jjgarcia committed
459
460
}

461
462
463
void
FEinvalid_function_name(cl_object fname)
{
Daniel Kochmański's avatar
Daniel Kochmański committed
464
465
466
467
468
  cl_error(9, @'simple-type-error', @':format-control',
           make_constant_base_string("Not a valid function name ~D"),
           @':format-arguments', cl_list(1, fname),
           @':expected-type', cl_list(2, @'satisfies', @'si::valid-function-name-p'),
           @':datum', fname);
469
470
}

jjgarcia's avatar
jjgarcia committed
471
/*      bootstrap version                */
472
473
static int recursive_error = 0;

474
static cl_object
475
476
477
universal_error_handler(cl_object continue_string, cl_object datum,
                        cl_object args)
{
Daniel Kochmański's avatar
Daniel Kochmański committed
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
  const cl_env_ptr the_env = ecl_process_env();
  cl_object stream;
  if (recursive_error)
    goto ABORT;
  recursive_error = 1;
  stream = cl_core.error_output;
  if (!Null(stream)) {
    ecl_bds_bind(the_env, @'*print-readably*', ECL_NIL);
    ecl_bds_bind(the_env, @'*print-level*', ecl_make_fixnum(3));
    ecl_bds_bind(the_env, @'*print-length*', ecl_make_fixnum(3));
    ecl_bds_bind(the_env, @'*print-circle*', ECL_NIL);
    ecl_bds_bind(the_env, @'*print-base*', ecl_make_fixnum(10));
    writestr_stream("\n;;; Unhandled lisp initialization error",
                    stream);
    writestr_stream("\n;;; Message:\n", stream);
    si_write_ugly_object(datum, stream);
    writestr_stream("\n;;; Arguments:\n", stream);
    si_write_ugly_object(args, stream);
    ecl_bds_unwind_n(the_env, 5);
  }
498
 ABORT:
Daniel Kochmański's avatar
Daniel Kochmański committed
499
  ecl_internal_error("\nLisp initialization error.\n");
500
}
jjgarcia's avatar
jjgarcia committed
501

502
void
503
FEdivision_by_zero(cl_object x, cl_object y)
504
{
Daniel Kochmański's avatar
Daniel Kochmański committed
505
506
  cl_error(5, @'division-by-zero', @':operation', @'/',
           @':operands', cl_list(2, x, y));
507
508
}

509
510
511
cl_object
_ecl_strerror(int code)
{
Daniel Kochmański's avatar
Daniel Kochmański committed
512
513
  const char *error = strerror(code);
  return make_base_string_copy(error);
514
515
}

516
517
518
519
520
521
522
523
524
525
526
/*************************************
 * Errors generated by the C library *
 *************************************/
/*
 * Interprets an error code from the C library according to the POSIX
 * standard, and produces a suitable error message by combining the user
 * supplied format with an explanation of the cause of the error.
 */
void
FElibc_error(const char *msg, int narg, ...)
{
Daniel Kochmański's avatar
Daniel Kochmański committed
527
528
  ecl_va_list args;
  cl_object rest, error = _ecl_strerror(errno);
529

Daniel Kochmański's avatar
Daniel Kochmański committed
530
531
  ecl_va_start(args, narg, narg, 0);
  rest = cl_grab_rest_args(args);
532

Daniel Kochmański's avatar
Daniel Kochmański committed
533
534
535
  FEerror("~?~%C library explanation: ~A.", 3,
          make_constant_base_string(msg), rest,
          error);
536
537
}

538
#if defined(ECL_MS_WINDOWS_HOST) || defined(cygwin)
Juan Jose Garcia Ripoll's avatar
Juan Jose Garcia Ripoll committed
539
ecl_def_ct_base_string(unknown_error,"[Unable to get error message]",28,static,const);
540

541
542
543
void
FEwin32_error(const char *msg, int narg, ...)
{
Daniel Kochmański's avatar
Daniel Kochmański committed
544
545
546
  ecl_va_list args;
  cl_object rest, win_msg_obj;
  char *win_msg;
547

Daniel Kochmański's avatar
Daniel Kochmański committed
548
549
550
551
552
553
554
  if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_ALLOCATE_BUFFER,
                    0, GetLastError(), 0, (void*)&win_msg, 0, NULL) == 0)
    win_msg_obj = unknown_error;
  else {
    win_msg_obj = make_base_string_copy(win_msg);
    LocalFree(win_msg);
  }
555

Daniel Kochmański's avatar
Daniel Kochmański committed
556
557
558
559
560
  ecl_va_start(args, narg, narg, 0);
  rest = cl_grab_rest_args(args);
  FEerror("~?~%Windows library explanation: ~A.", 3,
          make_constant_base_string(msg), rest,
          win_msg_obj);
561
562
563
}
#endif

jjgarcia's avatar
jjgarcia committed
564
565
566
567
568
/************************************
 * Higher level interface to errors *
 ************************************/

@(defun error (eformat &rest args)
Daniel Kochmański's avatar
Daniel Kochmański committed
569
570
571
572
573
574
@ {
  ecl_enable_interrupts();
  funcall(4, @'si::universal-error-handler', ECL_NIL, eformat,
          cl_grab_rest_args(args));
  _ecl_unexpected_return();
} @)
jjgarcia's avatar
jjgarcia committed
575
576

@(defun cerror (cformat eformat &rest args)
Daniel Kochmański's avatar
Daniel Kochmański committed
577
578
579
580
581
@ {
  ecl_enable_interrupts();
  return funcall(4, @'si::universal-error-handler', cformat, eformat,
                 cl_grab_rest_args(args));
} @)
jjgarcia's avatar
jjgarcia committed
582

583
@(defun si::serror (cformat eformat &rest args)
Daniel Kochmański's avatar
Daniel Kochmański committed
584
585
586
587
588
@ {
  ecl_enable_interrupts();
  return funcall(4, @'si::stack-error-handler', cformat, eformat,
                 cl_grab_rest_args(args));
} @)
589

jjgarcia's avatar
jjgarcia committed
590
591
592
void
init_error(void)
{
Daniel Kochmański's avatar
Daniel Kochmański committed
593
594
595
  ecl_def_c_function(@'si::universal-error-handler',
                     (cl_objectfn_fixed)universal_error_handler,
                     3);
jjgarcia's avatar
jjgarcia committed
596
}