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