Preliminary work towards threads on win32
[sbcl.git] / src / runtime / interr.c
blob22cbc2a7004e3d5d6b6801f0b6b5847a57bb3ae7
1 /*
2 * stuff to handle internal errors
3 */
5 /*
6 * This software is part of the SBCL system. See the README file for
7 * more information.
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.
16 #include <stdio.h>
17 #include <stdarg.h>
18 #include <stdlib.h>
20 #include "sbcl.h"
21 #include "arch.h"
22 #include "signal.h"
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"
33 /* the way that we shut down the system on a fatal error */
35 static void
36 default_lossage_handler(void)
38 exit(1);
40 static void (*lossage_handler)(void) = default_lossage_handler;
42 #if QSHOW
43 static void
44 configurable_lossage_handler()
46 void lisp_backtrace(int frames);
48 if (dyndebug_config.dyndebug_backtrace_when_lost) {
49 fprintf(stderr, "lose: backtrace follows as requested\n");
50 lisp_backtrace(100);
53 if (dyndebug_config.dyndebug_sleep_when_lost) {
54 fprintf(stderr,
55 "The system is too badly corrupted or confused to continue at the Lisp.\n"
56 "level. The monitor was enabled, but you requested `sleep_when_lost'\n"
57 "behaviour though dyndebug. To help with your debugging effort, this\n"
58 "thread will not enter the monitor, and instead proceed immediately to an\n"
59 "infinite sleep call, maximizing your chances that the thread's current\n"
60 "state can be preserved until you attach an external debugger. Good luck!\n");
61 for (;;)
62 # ifdef LISP_FEATURE_WIN32
63 Sleep(10000);
64 # else
65 sleep(10);
66 # endif
69 monitor_or_something();
71 #endif
73 void enable_lossage_handler(void)
75 #if QSHOW
76 lossage_handler = configurable_lossage_handler;
77 #else
78 lossage_handler = monitor_or_something;
79 #endif
81 void disable_lossage_handler(void)
83 lossage_handler = default_lossage_handler;
86 static
87 void print_message(char *fmt, va_list ap)
89 fprintf(stderr, " in SBCL pid %d",getpid());
90 #if defined(LISP_FEATURE_SB_THREAD)
91 fprintf(stderr, "(tid %lu)", (unsigned long) thread_self());
92 #endif
93 if (fmt) {
94 fprintf(stderr, ":\n");
95 vfprintf(stderr, fmt, ap);
97 fprintf(stderr, "\n");
100 static inline void
101 call_lossage_handler() never_returns;
103 static inline void
104 call_lossage_handler()
106 lossage_handler();
107 fprintf(stderr, "Argh! lossage_handler() returned, total confusion..\n");
108 exit(1);
111 void
112 lose(char *fmt, ...)
114 va_list ap;
115 /* Block signals to prevent other threads, timers and such from
116 * interfering. If only all threads could be stopped somehow. */
117 block_blockable_signals(0, 0);
118 fprintf(stderr, "fatal error encountered");
119 va_start(ap, fmt);
120 print_message(fmt, ap);
121 va_end(ap);
122 fprintf(stderr, "\n");
123 fflush(stderr);
124 call_lossage_handler();
127 boolean lose_on_corruption_p = 0;
129 void
130 corruption_warning_and_maybe_lose(char *fmt, ...)
132 va_list ap;
133 #ifndef LISP_FEATURE_WIN32
134 sigset_t oldset;
135 block_blockable_signals(0, &oldset);
136 #endif
137 fprintf(stderr, "CORRUPTION WARNING");
138 va_start(ap, fmt);
139 print_message(fmt, ap);
140 va_end(ap);
141 fprintf(stderr, "The integrity of this image is possibly compromised.\n");
142 if (lose_on_corruption_p)
143 fprintf(stderr, "Exiting.\n");
144 else
145 fprintf(stderr, "Continuing with fingers crossed.\n");
146 fflush(stderr);
147 if (lose_on_corruption_p)
148 call_lossage_handler();
149 #ifndef LISP_FEATURE_WIN32
150 else
151 thread_sigmask(SIG_SETMASK,&oldset,0);
152 #endif
155 char *internal_error_descriptions[] = {INTERNAL_ERROR_NAMES};
156 /* internal error handler for when the Lisp error system doesn't exist
158 * FIXME: Shouldn't error output go to stderr instead of stdout? (Alas,
159 * this'd require changes in a number of things like brief_print(..),
160 * or I'd have changed it immediately.) */
161 void
162 describe_internal_error(os_context_t *context)
164 unsigned char *ptr = arch_internal_error_arguments(context);
165 int len, scoffset, sc, offset, ch;
167 len = *ptr++;
168 printf("internal error #%d (%s)\n", *ptr,
169 internal_error_descriptions[*ptr]);
170 ptr++;
171 len--;
172 while (len > 0) {
173 scoffset = *ptr++;
174 len--;
175 if (scoffset == 253) {
176 scoffset = *ptr++;
177 len--;
179 else if (scoffset == 254) {
180 scoffset = ptr[0] + ptr[1]*256;
181 ptr += 2;
182 len -= 2;
184 else if (scoffset == 255) {
185 scoffset = ptr[0] + (ptr[1]<<8) + (ptr[2]<<16) + (ptr[3]<<24);
186 ptr += 4;
187 len -= 4;
189 sc = scoffset & 0x1f;
190 offset = scoffset >> 5;
192 printf(" SC: %d, Offset: %d", sc, offset);
193 switch (sc) {
194 case sc_AnyReg:
195 case sc_DescriptorReg:
196 putchar('\t');
197 brief_print(*os_context_register_addr(context, offset));
198 break;
200 case sc_CharacterReg:
201 ch = *os_context_register_addr(context, offset);
202 #ifdef LISP_FEATURE_X86
203 if (offset&1)
204 ch = ch>>8;
205 ch = ch & 0xff;
206 #endif
207 switch (ch) {
208 case '\n': printf("\t'\\n'\n"); break;
209 case '\b': printf("\t'\\b'\n"); break;
210 case '\t': printf("\t'\\t'\n"); break;
211 case '\r': printf("\t'\\r'\n"); break;
212 default:
213 if (ch < 32 || ch > 127)
214 printf("\\%03o", ch);
215 else
216 printf("\t'%c'\n", ch);
217 break;
219 break;
220 case sc_SapReg:
221 #ifdef sc_WordPointerReg
222 case sc_WordPointerReg:
223 #endif
224 printf("\t0x%08lx\n", (unsigned long) *os_context_register_addr(context, offset));
225 break;
226 case sc_SignedReg:
227 printf("\t%ld\n", (long) *os_context_register_addr(context, offset));
228 break;
229 case sc_UnsignedReg:
230 printf("\t%lu\n", (unsigned long) *os_context_register_addr(context, offset));
231 break;
232 #ifdef sc_SingleFloatReg
233 case sc_SingleFloatReg:
234 printf("\t%g\n", *(float *)&context->sc_fpregs[offset]);
235 break;
236 #endif
237 #ifdef sc_DoubleFloatReg
238 case sc_DoubleFloatReg:
239 printf("\t%g\n", *(double *)&context->sc_fpregs[offset]);
240 break;
241 #endif
242 default:
243 printf("\t???\n");
244 break;
249 /* utility routines used by miscellaneous pieces of code */
251 lispobj debug_print(lispobj string)
253 /* This is a kludge. It's not actually safe - in general - to use
254 %primitive print on the alpha, because it skips half of the
255 number stack setup that should usually be done on a function
256 call, so the called routine (i.e. this one) ends up being able
257 to overwrite local variables in the caller. Rather than fix
258 this everywhere that %primitive print is used (it's only a
259 debugging aid anyway) we just guarantee our safety by putting
260 an unused buffer on the stack before doing anything else
261 here */
262 char untouched[32];
263 fprintf(stderr, "%s\n",
264 (char *)(((struct vector *)native_pointer(string))->data));
265 /* shut GCC up about not using this, because that's the point.. */
266 (void)untouched;
267 return NIL;