src/runtime/interr.c

   1 /*
   2  * stuff to handle internal errors
   3  */
   4
   5 /*
   6  * This software is part of the SBCL system. See the README file for
   7  * more information.
   8  *
   9  * This software is derived from the CMU CL system, which was
  10  * written at Carnegie Mellon University and released into the
  11  * public domain. The software is in the public domain and is
  12  * provided with absolutely no warranty. See the COPYING and CREDITS
  13  * files for more information.
  14  */
  15
  16 #include <stdio.h>
  17 #include <stdarg.h>
  18 #include <stdlib.h>
  19
  20 #include "sbcl.h"
  21 #include "arch.h"
  22 #include "signal.h"
  23
  24 #include "runtime.h"
  25 #include "interr.h"
  26 #include "print.h"
  27 #include "lispregs.h"
  28 #include "genesis/static-symbols.h"
  29 #include "genesis/vector.h"
  30 #include "thread.h"
  31 #include "monitor.h"
  32 \f
  33 /* the way that we shut down the system on a fatal error */
  34
  35 static void
  36 default_lossage_handler(void)
  37 {
  38     exit(1);
  39 }
  40 static void (*lossage_handler)(void) = default_lossage_handler;
  41
  42 void enable_lossage_handler(void)
  43 {
  44     lossage_handler = monitor_or_something;
  45 }
  46 void disable_lossage_handler(void)
  47 {
  48     lossage_handler = default_lossage_handler;
  49 }
  50
  51 void
  52 lose(char *fmt, ...)
  53 {
  54     va_list ap;
  55     fprintf(stderr, "fatal error encountered in SBCL pid %d",getpid());
  56 #if defined(LISP_FEATURE_SB_THREAD)
  57     fprintf(stderr, "(tid %lu)", (unsigned long) thread_self());
  58 #endif
  59     if (fmt) {
  60         fprintf(stderr, ":\n");
  61         va_start(ap, fmt);
  62         vfprintf(stderr, fmt, ap);
  63         va_end(ap);
  64     }
  65     fprintf(stderr, "\n");
  66     fflush(stderr);
  67     lossage_handler();
  68     fprintf(stderr, "Argh! lossage_handler() returned, total confusion..\n");
  69     exit(1);
  70 }
  71 \f
  72 /* internal error handler for when the Lisp error system doesn't exist
  73  *
  74  * FIXME: Shouldn't error output go to stderr instead of stdout? (Alas,
  75  * this'd require changes in a number of things like brief_print(..),
  76  * or I'd have changed it immediately.) */
  77 void
  78 describe_internal_error(os_context_t *context)
  79 {
  80     unsigned char *ptr = arch_internal_error_arguments(context);
  81     int len, scoffset, sc, offset, ch;
  82
  83     len = *ptr++;
  84     printf("internal error #%d\n", *ptr++);
  85     len--;
  86     while (len > 0) {
  87         scoffset = *ptr++;
  88         len--;
  89         if (scoffset == 253) {
  90             scoffset = *ptr++;
  91             len--;
  92         }
  93         else if (scoffset == 254) {
  94             scoffset = ptr[0] + ptr[1]*256;
  95             ptr += 2;
  96             len -= 2;
  97         }
  98         else if (scoffset == 255) {
  99             scoffset = ptr[0] + (ptr[1]<<8) + (ptr[2]<<16) + (ptr[3]<<24);
 100             ptr += 4;
 101             len -= 4;
 102         }
 103         sc = scoffset & 0x1f;
 104         offset = scoffset >> 5;
 105
 106         printf("    SC: %d, Offset: %d", sc, offset);
 107         switch (sc) {
 108         case sc_AnyReg:
 109         case sc_DescriptorReg:
 110             putchar('\t');
 111             brief_print(*os_context_register_addr(context, offset));
 112             break;
 113
 114         case sc_CharacterReg:
 115             ch = *os_context_register_addr(context, offset);
 116 #ifdef LISP_FEATURE_X86
 117             if (offset&1)
 118                 ch = ch>>8;
 119             ch = ch & 0xff;
 120 #endif
 121             switch (ch) {
 122             case '\n': printf("\t'\\n'\n"); break;
 123             case '\b': printf("\t'\\b'\n"); break;
 124             case '\t': printf("\t'\\t'\n"); break;
 125             case '\r': printf("\t'\\r'\n"); break;
 126             default:
 127                 if (ch < 32 || ch > 127)
 128                     printf("\\%03o", ch);
 129                 else
 130                     printf("\t'%c'\n", ch);
 131                 break;
 132             }
 133             break;
 134         case sc_SapReg:
 135 #ifdef sc_WordPointerReg
 136         case sc_WordPointerReg:
 137 #endif
 138             printf("\t0x%08lx\n", (unsigned long) *os_context_register_addr(context, offset));
 139             break;
 140         case sc_SignedReg:
 141             printf("\t%ld\n", (long) *os_context_register_addr(context, offset));
 142             break;
 143         case sc_UnsignedReg:
 144             printf("\t%lu\n", (unsigned long) *os_context_register_addr(context, offset));
 145             break;
 146 #ifdef sc_SingleFloatReg
 147         case sc_SingleFloatReg:
 148             printf("\t%g\n", *(float *)&context->sc_fpregs[offset]);
 149             break;
 150 #endif
 151 #ifdef sc_DoubleFloatReg
 152         case sc_DoubleFloatReg:
 153             printf("\t%g\n", *(double *)&context->sc_fpregs[offset]);
 154             break;
 155 #endif
 156         default:
 157             printf("\t???\n");
 158             break;
 159         }
 160     }
 161 }
 162 \f
 163 /* utility routines used by miscellaneous pieces of code */
 164
 165 lispobj debug_print(lispobj string)
 166 {
 167     /* This is a kludge.  It's not actually safe - in general - to use
 168        %primitive print on the alpha, because it skips half of the
 169        number stack setup that should usually be done on a function
 170        call, so the called routine (i.e. this one) ends up being able
 171        to overwrite local variables in the caller.  Rather than fix
 172        this everywhere that %primitive print is used (it's only a
 173        debugging aid anyway) we just guarantee our safety by putting
 174        an unused buffer on the stack before doing anything else
 175        here */
 176     char untouched[32];
 177     fprintf(stderr, "%s\n",
 178             (char *)(((struct vector *)native_pointer(string))->data));
 179     /* shut GCC up about not using this, because that's the point.. */
 180     if (untouched);
 181     return NIL;
 182 }