5f7869c4bbe7552ff1d54e5664a325d715856632
[sbcl.git] / 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     (void)untouched;
181     return NIL;
182 }