src/exceptions.c

   1 /*
   2 Copyright (C) 2001-2010, Parrot Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/exceptions.c - Exceptions
   8
   9 =head1 DESCRIPTION
  10
  11 Define the the core subsystem for exceptions.
  12
  13 =head2 Exception Functions
  14
  15 =over 4
  16
  17 =cut
  18
  19 */
  20
  21 #include "parrot/parrot.h"
  22 #include "exceptions.str"
  23 #include "pmc/pmc_continuation.h"
  24
  25 /* HEADERIZER HFILE: include/parrot/exceptions.h */
  26
  27 /* HEADERIZER BEGIN: static */
  28 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  29
  30 PARROT_CANNOT_RETURN_NULL
  31 static PMC * build_exception_from_args(PARROT_INTERP,
  32     int ex_type,
  33     ARGIN(const char *format),
  34     va_list arglist)
  35         __attribute__nonnull__(1)
  36         __attribute__nonnull__(3);
  37
  38 PARROT_CAN_RETURN_NULL
  39 static void setup_exception_args(PARROT_INTERP, ARGIN(const char *sig), ...)
  40         __attribute__nonnull__(1)
  41         __attribute__nonnull__(2);
  42
  43 #define ASSERT_ARGS_build_exception_from_args __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
  44        PARROT_ASSERT_ARG(interp) \
  45     , PARROT_ASSERT_ARG(format))
  46 #define ASSERT_ARGS_setup_exception_args __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
  47        PARROT_ASSERT_ARG(interp) \
  48     , PARROT_ASSERT_ARG(sig))
  49 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  50 /* HEADERIZER END: static */
  51
  52 #include <stdarg.h>
  53
  54 /*
  55
  56 =item C<PMC * Parrot_ex_build_exception(PARROT_INTERP, INTVAL severity, long
  57 error, STRING *msg)>
  58
  59 Constructs a new exception object from the passed in arguments.
  60
  61 =cut
  62
  63 */
  64 PARROT_EXPORT
  65 PARROT_CAN_RETURN_NULL
  66 PMC *
  67 Parrot_ex_build_exception(PARROT_INTERP, INTVAL severity,
  68         long error, ARGIN_NULLOK(STRING *msg))
  69 {
  70     ASSERT_ARGS(Parrot_ex_build_exception)
  71     PMC * const exception = Parrot_pmc_new(interp, enum_class_Exception);
  72
  73     VTABLE_set_integer_keyed_str(interp, exception, CONST_STRING(interp, "severity"), severity);
  74     VTABLE_set_integer_keyed_str(interp, exception, CONST_STRING(interp, "type"), error);
  75     if (msg)
  76         VTABLE_set_string_native(interp, exception, msg);
  77
  78     return exception;
  79 }
  80
  81 /*
  82
  83 =item C<void die_from_exception(PARROT_INTERP, PMC *exception)>
  84
  85 Print a stack trace for C<exception>, a message if there is one, and then exit.
  86
  87 =cut
  88
  89 */
  90
  91 PARROT_DOES_NOT_RETURN
  92 PARROT_COLD
  93 void
  94 die_from_exception(PARROT_INTERP, ARGIN(PMC *exception))
  95 {
  96     ASSERT_ARGS(die_from_exception)
  97     STRING * const message     = VTABLE_get_string(interp, exception);
  98     INTVAL         exit_status = 1;
  99     const INTVAL   severity    = VTABLE_get_integer_keyed_str(interp, exception, CONST_STRING(interp, "severity"));
 100
 101     /* In some cases we have a fatal exception before the IO system
 102      * is completely initialized. Do some attempt to output the
 103      * message to stderr, to help diagnosing. */
 104     int use_perr = !PMC_IS_NULL(Parrot_io_STDERR(interp));
 105
 106     /* flush interpreter output to get things printed in order */
 107     if (!PMC_IS_NULL(Parrot_io_STDOUT(interp)))
 108         Parrot_io_flush(interp, Parrot_io_STDOUT(interp));
 109     if (use_perr)
 110         Parrot_io_flush(interp, Parrot_io_STDERR(interp));
 111
 112     if (interp->pdb) {
 113         Interp * interpdeb = interp->pdb->debugger;
 114         if (interpdeb) {
 115             Parrot_io_flush(interpdeb, Parrot_io_STDOUT(interpdeb));
 116             Parrot_io_flush(interpdeb, Parrot_io_STDERR(interpdeb));
 117         }
 118     }
 119
 120     if (Parrot_str_not_equal(interp, message, CONST_STRING(interp, ""))) {
 121         if (use_perr)
 122             Parrot_io_eprintf(interp, "%S\n", message);
 123         else {
 124             char * const msg = Parrot_str_to_cstring(interp, message);
 125             fflush(stderr);
 126             fprintf(stderr, "\n%s\n", msg);
 127             Parrot_str_free_cstring(msg);
 128         }
 129
 130         /* caution against output swap (with PDB_backtrace) */
 131         fflush(stderr);
 132         PDB_backtrace(interp);
 133     }
 134     else if (severity == EXCEPT_exit) {
 135         /* TODO: get exit status based on type */
 136         exit_status = VTABLE_get_integer_keyed_str(interp, exception, CONST_STRING(interp, "exit_code"));
 137     }
 138     else {
 139         Parrot_io_eprintf(interp, "No exception handler and no message\n");
 140         /* caution against output swap (with PDB_backtrace) */
 141         fflush(stderr);
 142         PDB_backtrace(interp);
 143     }
 144
 145     /*
 146      * returning NULL from here returns resume address NULL to the
 147      * runloop, which will terminate the thread function finally
 148      *
 149      * TT #1287 this check should better be in Parrot_exit
 150      */
 151
 152     /* no exception handler, but this is not the main thread */
 153     if (interp->thread_data && interp->thread_data->tid)
 154         pt_thread_detach(interp->thread_data->tid);
 155
 156     /*
 157      * only main should run the destroy functions - exit handler chain
 158      * is freed during Parrot_exit
 159      */
 160     Parrot_exit(interp, exit_status);
 161 }
 162
 163 /*
 164
 165 =item C<void Parrot_ex_add_c_handler(PARROT_INTERP, Parrot_runloop *jp)>
 166
 167 Adds a new exception handler (defined in C) to the concurrency scheduler. Since
 168 the exception handler is C code, it stores a runloop jump point to the start of
 169 the handler code.
 170
 171 =cut
 172
 173 */
 174
 175 PARROT_EXPORT
 176 void
 177 Parrot_ex_add_c_handler(PARROT_INTERP, ARGIN(Parrot_runloop *jp))
 178 {
 179     ASSERT_ARGS(Parrot_ex_add_c_handler)
 180     PMC * const handler = Parrot_pmc_new(interp, enum_class_ExceptionHandler);
 181     /* Flag to mark a C exception handler */
 182     PObj_get_FLAGS(handler) |= SUB_FLAG_C_HANDLER;
 183     VTABLE_set_pointer(interp, handler, jp);
 184     Parrot_cx_add_handler_local(interp, handler);
 185 }
 186
 187 /*
 188
 189 =item C<opcode_t * Parrot_ex_throw_from_op(PARROT_INTERP, PMC *exception, void
 190 *dest)>
 191
 192 Throw an exception from inside an op. Looks for an exception handler in the
 193 current concurrency scheduler. If a suitable handler is found, invoke it and
 194 return the address where execution should continue. If no handler is found,
 195 the exception message is printed along with the current line number
 196 annotation and a backtrace before exiting Parrot.
 197
 198 =cut
 199
 200 */
 201
 202 PARROT_EXPORT
 203 PARROT_CAN_RETURN_NULL
 204 opcode_t *
 205 Parrot_ex_throw_from_op(PARROT_INTERP, ARGIN(PMC *exception), ARGIN_NULLOK(void *dest))
 206 {
 207     ASSERT_ARGS(Parrot_ex_throw_from_op)
 208     opcode_t   *address;
 209     PMC        *handler;
 210
 211     /* Note the thrower. */
 212     VTABLE_set_attr_str(interp, exception, CONST_STRING(interp, "thrower"), CURRENT_CONTEXT(interp));
 213
 214     /* Locate the handler, if there is one. */
 215     handler = Parrot_cx_find_handler_local(interp, exception);
 216     if (PMC_IS_NULL(handler)) {
 217         STRING * const message     = VTABLE_get_string(interp, exception);
 218         const INTVAL   severity    = VTABLE_get_integer_keyed_str(interp, exception, CONST_STRING(interp, "severity"));
 219         if (severity < EXCEPT_error) {
 220             PMC * const resume = VTABLE_get_attr_str(interp, exception, CONST_STRING(interp, "resume"));
 221             if (Parrot_str_not_equal(interp, message, CONST_STRING(interp, ""))) {
 222                 Parrot_io_eprintf(interp, "%S\n", message);
 223             }
 224             else {
 225                 Parrot_io_eprintf(interp, "%S\n", CONST_STRING(interp, "Warning"));
 226             }
 227
 228             /* caution against output swap (with PDB_backtrace) */
 229             fflush(stderr);
 230             /* PDB_backtrace(interp); */
 231
 232             if (!PMC_IS_NULL(resume)) {
 233                 return VTABLE_invoke(interp, resume, NULL);
 234             }
 235         }
 236         die_from_exception(interp, exception);
 237     }
 238
 239     address    = VTABLE_invoke(interp, handler, dest);
 240     setup_exception_args(interp, "P", exception);
 241
 242     if (PObj_get_FLAGS(handler) & SUB_FLAG_C_HANDLER) {
 243         /* it's a C exception handler */
 244         Parrot_runloop * const jump_point = (Parrot_runloop *)address;
 245         longjmp(jump_point->resume, 1);
 246     }
 247
 248     /* return the address of the handler */
 249     return address;
 250 }
 251
 252 /*
 253
 254 =item C<static void setup_exception_args(PARROT_INTERP, const char *sig, ...)>
 255
 256 Sets up arguments to the exception handler invocation.
 257
 258 =cut
 259
 260 */
 261
 262 PARROT_CAN_RETURN_NULL
 263 static void
 264 setup_exception_args(PARROT_INTERP, ARGIN(const char *sig), ...)
 265 {
 266     ASSERT_ARGS(setup_exception_args)
 267     va_list  args;
 268     PMC     *sig_obj;
 269
 270     va_start(args, sig);
 271     sig_obj = Parrot_pcc_build_call_from_varargs(interp, PMCNULL, sig, &args);
 272     va_end(args);
 273
 274     CALLSIGNATURE_is_exception_SET(sig_obj);
 275
 276     Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), sig_obj);
 277 }
 278
 279 /*
 280
 281 =item C<static PMC * build_exception_from_args(PARROT_INTERP, int ex_type, const
 282 char *format, va_list arglist)>
 283
 284 Builds an exception PMC with the given integer type C<ex_type>, and the string
 285 message given as a format/arglist combo, like is used by the Parrot_vsprintf*
 286 family of functions.
 287
 288 =cut
 289
 290 */
 291
 292 PARROT_CANNOT_RETURN_NULL
 293 static PMC *
 294 build_exception_from_args(PARROT_INTERP, int ex_type,
 295         ARGIN(const char *format), va_list arglist)
 296 {
 297     ASSERT_ARGS(build_exception_from_args)
 298     /* Make and set exception message. */
 299     STRING * const msg =
 300         strchr(format, '%')
 301             ? Parrot_vsprintf_c(interp, format, arglist)
 302             : string_make(interp, format, strlen(format), NULL, 0);
 303
 304     return Parrot_ex_build_exception(interp, EXCEPT_error, ex_type, msg);
 305 }
 306
 307 /*
 308
 309 =item C<void Parrot_ex_throw_from_c(PARROT_INTERP, PMC *exception)>
 310
 311 Throws an exception object from any location in C code. A suitable handler
 312 is retrieved from the concurrency scheduler. If the handler is found, control
 313 flow is passed to it. Handlers can be either C-level or PIR-level routines. If
 314 no suitable handler is found, Parrot exits with the stored exception error
 315 message.
 316
 317 See also C<exit_fatal()>, which signals fatal errors, and
 318 C<Parrot_ex_throw_from_op> which throws an exception from within an op.
 319
 320 The 'invoke' vtable function doesn't actually execute a
 321 sub/continuation/handler, it only sets up the environment for invocation and
 322 returns the address of the start of the sub's code. That address then becomes
 323 the next op in the runloop.
 324
 325 Exceptions thrown from C and caught by a continuation-based handler are
 326 resumable at the level of a C instruction. When handled, they return the
 327 exception object. Any values returned from the handler to the C code that threw
 328 the exception can be stored in the exception's payload.
 329
 330 =cut
 331
 332 */
 333
 334 PARROT_EXPORT
 335 PARROT_DOES_NOT_RETURN
 336 PARROT_COLD
 337 void
 338 Parrot_ex_throw_from_c(PARROT_INTERP, ARGIN(PMC *exception))
 339 {
 340     ASSERT_ARGS(Parrot_ex_throw_from_c)
 341
 342     Parrot_runloop    *return_point = interp->current_runloop;
 343     opcode_t *address;
 344     PMC        * const handler      =
 345                              Parrot_cx_find_handler_local(interp, exception);
 346
 347     if (PMC_IS_NULL(handler))
 348         die_from_exception(interp, exception);
 349
 350     if (Interp_debug_TEST(interp, PARROT_BACKTRACE_DEBUG_FLAG)) {
 351         STRING * const exit_code = CONST_STRING(interp, "exit_code");
 352         STRING * const msg       = VTABLE_get_string(interp, exception);
 353         int            exitcode  = VTABLE_get_integer_keyed_str(interp,
 354                                         exception, exit_code);
 355
 356         Parrot_io_eprintf(interp,
 357             "Parrot_ex_throw_from_c (severity:%d error:%d): %Ss\n",
 358             EXCEPT_error, exitcode, msg);
 359         PDB_backtrace(interp);
 360     }
 361
 362     /* Note the thrower.
 363      * Don't split line. It will break CONST_STRING handling. */
 364     VTABLE_set_attr_str(interp, exception, CONST_STRING(interp, "thrower"), CURRENT_CONTEXT(interp));
 365
 366     /* it's a C exception handler */
 367     if (PObj_get_FLAGS(handler) & SUB_FLAG_C_HANDLER) {
 368         Parrot_runloop * const jump_point =
 369             (Parrot_runloop * const)VTABLE_get_pointer(interp, handler);
 370         longjmp(jump_point->resume, 1);
 371     }
 372
 373     /* Run the handler. */
 374     address = VTABLE_invoke(interp, handler, NULL);
 375     setup_exception_args(interp, "P", exception);
 376     PARROT_ASSERT(return_point->handler_start == NULL);
 377     return_point->handler_start = address;
 378     longjmp(return_point->resume, 2);
 379 }
 380
 381 /*
 382
 383 =item C<opcode_t * Parrot_ex_throw_from_op_args(PARROT_INTERP, void *dest, int
 384 ex_type, const char *format, ...)>
 385
 386 Throws an exception from an opcode, with an error message constructed
 387 from a format string and arguments. Constructs an Exception PMC, and passes it
 388 to C<Parrot_ex_throw_from_op>.
 389
 390 See also C<Parrot_ex_throw_from_c> and C<exit_fatal()>.
 391
 392 =cut
 393
 394 */
 395
 396 PARROT_EXPORT
 397 PARROT_CAN_RETURN_NULL
 398 opcode_t *
 399 Parrot_ex_throw_from_op_args(PARROT_INTERP, ARGIN_NULLOK(void *dest),
 400         int ex_type, ARGIN(const char *format), ...)
 401 {
 402     ASSERT_ARGS(Parrot_ex_throw_from_op_args)
 403     PMC *exception;
 404
 405     va_list arglist;
 406     va_start(arglist, format);
 407     exception = build_exception_from_args(interp, ex_type, format, arglist);
 408     va_end(arglist);
 409
 410     return Parrot_ex_throw_from_op(interp, exception, dest);
 411 }
 412
 413 /*
 414
 415 =item C<void Parrot_ex_throw_from_c_args(PARROT_INTERP, void *ret_addr, int
 416 exitcode, const char *format, ...)>
 417
 418 Throws an exception, with an error message constructed from a format string and
 419 arguments. C<ret_addr> is the address from which to resume, if some handler
 420 decides that is appropriate, or zero to make the error non-resumable.
 421 C<exitcode> is a C<exception_type_enum> value. Constructs an Exception PMC
 422 and passes it to C<Parrot_ex_throw_from_c>.
 423
 424 See also C<Parrot_ex_throw_from_op> and C<exit_fatal()>.
 425
 426 =cut
 427
 428 */
 429
 430 PARROT_EXPORT
 431 PARROT_DOES_NOT_RETURN
 432 PARROT_COLD
 433 void
 434 Parrot_ex_throw_from_c_args(PARROT_INTERP, SHIM(void *ret_addr),
 435         int exitcode, ARGIN(const char *format), ...)
 436 {
 437     ASSERT_ARGS(Parrot_ex_throw_from_c_args)
 438     PMC *exception;
 439
 440     va_list arglist;
 441     va_start(arglist, format);
 442     exception = build_exception_from_args(interp, exitcode, format, arglist);
 443     va_end(arglist);
 444
 445     Parrot_ex_throw_from_c(interp, exception);
 446 }
 447
 448 /*
 449
 450 =item C<opcode_t * Parrot_ex_rethrow_from_op(PARROT_INTERP, PMC *exception)>
 451
 452 Rethrow the given exception from an op, if it has previously been thrown and
 453 not handled by the provided handler. Marks the exception object as being
 454 unhandled and throws it again.
 455
 456 =cut
 457
 458 */
 459
 460 PARROT_EXPORT
 461 PARROT_WARN_UNUSED_RESULT
 462 PARROT_CAN_RETURN_NULL
 463 opcode_t *
 464 Parrot_ex_rethrow_from_op(PARROT_INTERP, ARGIN(PMC *exception))
 465 {
 466     ASSERT_ARGS(Parrot_ex_rethrow_from_op)
 467
 468     Parrot_ex_mark_unhandled(interp, exception);
 469
 470     return Parrot_ex_throw_from_op(interp, exception, NULL);
 471 }
 472
 473 /*
 474
 475 =item C<void Parrot_ex_rethrow_from_c(PARROT_INTERP, PMC *exception)>
 476
 477 Rethrow the exception from C code. Marks the Exception PMC as being unhandled
 478 and throws it again.
 479
 480 =cut
 481
 482 */
 483
 484 PARROT_EXPORT
 485 PARROT_DOES_NOT_RETURN
 486 PARROT_COLD
 487 void
 488 Parrot_ex_rethrow_from_c(PARROT_INTERP, ARGIN(PMC *exception))
 489 {
 490     ASSERT_ARGS(Parrot_ex_rethrow_from_c)
 491     Parrot_ex_mark_unhandled(interp, exception);
 492
 493     Parrot_ex_throw_from_c(interp, exception);
 494 }
 495
 496 /*
 497
 498 =item C<void Parrot_ex_mark_unhandled(PARROT_INTERP, PMC *exception)>
 499
 500 Mark an exception as unhandled, as part of rethrowing it.
 501
 502 =back
 503
 504 =cut
 505
 506 */
 507
 508 PARROT_EXPORT
 509 void
 510 Parrot_ex_mark_unhandled(PARROT_INTERP, ARGIN(PMC *exception))
 511 {
 512     ASSERT_ARGS(Parrot_ex_mark_unhandled)
 513     VTABLE_set_integer_keyed_str(interp, exception, CONST_STRING(interp, "handled"), -1);
 514 }
 515
 516 /*
 517
 518 =head2 Error Functions
 519
 520 =over 4
 521
 522 =item C<void Parrot_assert(INTVAL condition, const char *condition_string, const
 523 char *file, unsigned int line)>
 524
 525 A better version of assert() that gives a backtrace.
 526
 527 =cut
 528
 529 */
 530
 531 PARROT_EXPORT
 532 PARROT_DOES_NOT_RETURN_WHEN_FALSE
 533 void
 534 Parrot_assert(INTVAL condition, ARGIN(const char *condition_string),
 535         ARGIN(const char *file), unsigned int line)
 536 {
 537     ASSERT_ARGS(Parrot_assert)
 538     if (!condition)
 539         Parrot_confess(condition_string, file, line);
 540 }
 541
 542 /*
 543
 544 =item C<void Parrot_confess(const char *cond, const char *file, unsigned int
 545 line)>
 546
 547 Prints a backtrace and message for a failed assertion.
 548
 549 =cut
 550
 551 */
 552
 553 PARROT_EXPORT
 554 PARROT_DOES_NOT_RETURN
 555 PARROT_COLD
 556 void
 557 Parrot_confess(ARGIN(const char *cond), ARGIN(const char *file), unsigned int line)
 558 {
 559     ASSERT_ARGS(Parrot_confess)
 560     fprintf(stderr, "%s:%u: failed assertion '%s'\n", file, line, cond);
 561     Parrot_print_backtrace();
 562     abort();
 563 }
 564
 565 /*
 566
 567 =item C<void Parrot_print_backtrace(void)>
 568
 569 Displays the primrose path to disaster, (the stack frames leading up to the
 570 abort).  Used by C<Parrot_confess>.
 571
 572 =cut
 573
 574 */
 575
 576 void
 577 Parrot_print_backtrace(void)
 578 {
 579     ASSERT_ARGS(Parrot_print_backtrace)
 580 #ifdef PARROT_HAS_BACKTRACE
 581 #  define BACKTRACE_DEPTH 32
 582 /*#  define BACKTRACE_VERBOSE */
 583 #  ifndef PARROT_HAS_DLINFO
 584 #    define BACKTRACE_VERBOSE
 585 #  endif
 586     /* stolen from http://www.delorie.com/gnu/docs/glibc/libc_665.html */
 587     void *array[BACKTRACE_DEPTH];
 588     int i;
 589
 590     const int size = backtrace(array, BACKTRACE_DEPTH);
 591
 592     fprintf(stderr,
 593             "Backtrace - Obtained %d stack frames (max trace depth is %d).\n",
 594             size, BACKTRACE_DEPTH);
 595 #  ifndef BACKTRACE_VERBOSE
 596     for (i = 0; i < size; ++i) {
 597         Dl_info   frameInfo;
 598         const int found  = dladdr(array[i], &frameInfo);
 599
 600         /* always indent */
 601         const int indent = 2 + (2 * i);
 602
 603         fprintf(stderr, "%*s", indent, "");
 604
 605         if (found && frameInfo.dli_sname)
 606             fprintf(stderr, "%s\n", frameInfo.dli_sname);
 607         else
 608             fprintf(stderr, "(unknown)\n");
 609     }
 610
 611 #  else
 612     { /* Scope for strings */
 613         char ** strings = backtrace_symbols(array, size);
 614         if (strings) {
 615             for (i = 0; i < size; ++i)
 616                 fprintf(stderr, "%s\n", strings[i]);
 617             /* backtrace_symbols gets memory using malloc */
 618             free(strings);
 619         }
 620         else
 621             fputs("Not enough memory for backtrace_symbols\n", stderr);
 622     }
 623 #  endif
 624
 625 #  undef BACKTRACE_DEPTH
 626 #endif /* ifdef PARROT_HAS_BACKTRACE */
 627 }
 628
 629 /*
 630
 631 =item C<void exit_fatal(int exitcode, const char *format, ...)>
 632
 633 Signal a fatal error condition.  This should only be used with dire errors that
 634 cannot throw an exception (because no interpreter is available, or the nature
 635 of the error would interfere with the exception system).
 636
 637 This involves printing an error message to stderr, and calling C<exit> to exit
 638 the process with the given exitcode. It is not possible for Parrot bytecode to
 639 intercept a fatal error (for that, use C<Parrot_ex_throw_from_c_args>).
 640 C<exit_fatal> does not call C<Parrot_exit> to invoke exit handlers (that would
 641 require an interpreter).
 642
 643 =cut
 644
 645 */
 646
 647 PARROT_EXPORT
 648 PARROT_DOES_NOT_RETURN
 649 PARROT_COLD
 650 void
 651 exit_fatal(int exitcode, ARGIN(const char *format), ...)
 652 {
 653     ASSERT_ARGS(exit_fatal)
 654     va_list arglist;
 655     va_start(arglist, format);
 656     vfprintf(stderr, format, arglist);
 657     fprintf(stderr, "\n");
 658     /* caution against output swap (with PDB_backtrace) */
 659     fflush(stderr);
 660     va_end(arglist);
 661     exit(exitcode);
 662 }
 663
 664 /* The DUMPCORE macro is defined for most platforms, but defined here if not
 665  * found elsewhere, so we're sure it's safe to call. */
 666
 667 #ifndef DUMPCORE
 668 #  define DUMPCORE() \
 669      fprintf(stderr, "Sorry, coredump is not yet implemented " \
 670              "for this platform.\n\n"); \
 671              exit(EXIT_FAILURE);
 672 #endif
 673
 674 /*
 675
 676 =item C<void do_panic(NULLOK_INTERP, const char *message, const char *file,
 677 unsigned int line)>
 678
 679 Panic handler. Things have gone very wrong in an unexpected way. Print out an
 680 error message and instructions for the user to report the error to the
 681 developers
 682
 683 =cut
 684
 685 */
 686
 687 PARROT_EXPORT
 688 PARROT_DOES_NOT_RETURN
 689 PARROT_COLD
 690 void
 691 do_panic(NULLOK_INTERP, ARGIN_NULLOK(const char *message),
 692          ARGIN_NULLOK(const char *file), unsigned int line)
 693 {
 694     ASSERT_ARGS(do_panic)
 695     /* Note: we can't format any floats in here--Parrot_sprintf
 696     ** may panic because of floats.
 697     ** and we don't use Parrot_sprintf or such, because we are
 698     ** already in panic --leo
 699     */
 700     fprintf(stderr, "Parrot VM: PANIC: %s!\n",
 701                message ? message : "(no message available)");
 702
 703     fprintf(stderr, "C file %s, line %u\n",
 704                file ? file : "(not available)", line);
 705
 706     fprintf(stderr, "Parrot file (not available), ");
 707     fprintf(stderr, "line (not available)\n");
 708
 709     fprintf(stderr, "\n\
 710 We highly suggest you notify the Parrot team if you have not been working on\n\
 711 Parrot.  Use parrotbug (located in parrot's root directory) or send an\n\
 712 e-mail to parrot-dev@lists.parrot.org.\n\
 713 Include the entire text of this error message and the text of the script that\n\
 714 generated the error.  If you've made any modifications to Parrot, please\n\
 715 describe them as well.\n\n");
 716
 717     fprintf(stderr, "Version     : %s\n", PARROT_VERSION);
 718     fprintf(stderr, "Configured  : %s\n", PARROT_CONFIG_DATE);
 719     fprintf(stderr, "Architecture: %s\n", PARROT_ARCHNAME);
 720     fprintf(stderr, "JIT Capable : %s\n", JIT_CAPABLE ? "Yes" : "No");
 721     if (interp)
 722         fprintf(stderr, "Interp Flags: %#x\n", (unsigned int)interp->flags);
 723     else
 724         fprintf(stderr, "Interp Flags: (no interpreter)\n");
 725     fprintf(stderr, "Exceptions  : %s\n", "(missing from core)");
 726     fprintf(stderr, "\nDumping Core...\n");
 727
 728     DUMPCORE();
 729 }
 730
 731
 732 /*
 733
 734 =back
 735
 736 =head1 SEE ALSO
 737
 738 F<include/parrot/exceptions.h>.
 739
 740 =cut
 741
 742 */
 743
 744
 745 /*
 746  * Local variables:
 747  *   c-file-style: "parrot"
 748  * End:
 749  * vim: expandtab shiftwidth=4:
 750  */