0.8.5.47:
[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 "arch.h"
21 #include "signal.h"
22
23 #include "runtime.h"
24 #include "sbcl.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 \f
32 /* the way that we shut down the system on a fatal error */
33
34 static void
35 default_lossage_handler(void)
36 {
37     exit(1);
38 }
39 static void (*lossage_handler)(void) = default_lossage_handler;
40 void
41 set_lossage_handler(void handler(void))
42 {
43     lossage_handler = handler;
44 }
45
46 never_returns
47 lose(char *fmt, ...)
48 {
49     va_list ap;
50     fprintf(stderr, "fatal error encountered in SBCL pid %d",getpid());
51     /* freeze all the other threads, so we have a chance of debugging them 
52      */
53     if(all_threads) {
54         struct thread *th1,*th=arch_os_get_current_thread();
55         for_each_thread(th1) {
56             if(th1!=th) kill(th1->pid,SIGSTOP);
57         }
58     }
59
60     if (fmt) {
61         fprintf(stderr, ":\n");
62         va_start(ap, fmt);
63         vfprintf(stderr, fmt, ap);
64         va_end(ap);
65     }
66     fprintf(stderr, "\n");
67     fflush(stderr);
68     lossage_handler();
69     fprintf(stderr, "Argh! lossage_handler() returned, total confusion..\n");
70     exit(1);
71 }
72 \f
73 /* internal error handler for when the Lisp error system doesn't exist
74  *
75  * FIXME: Shouldn't error output go to stderr instead of stdout? (Alas,
76  * this'd require changes in a number of things like brief_print(..),
77  * or I'd have changed it immediately.) */
78 void
79 describe_internal_error(os_context_t *context)
80 {
81     unsigned char *ptr = arch_internal_error_arguments(context);
82     int len, scoffset, sc, offset, ch;
83
84     len = *ptr++;
85     printf("internal error #%d\n", *ptr++);
86     len--;
87     while (len > 0) {
88         scoffset = *ptr++;
89         len--;
90         if (scoffset == 253) {
91             scoffset = *ptr++;
92             len--;
93         }
94         else if (scoffset == 254) {
95             scoffset = ptr[0] + ptr[1]*256;
96             ptr += 2;
97             len -= 2;
98         }
99         else if (scoffset == 255) {
100             scoffset = ptr[0] + (ptr[1]<<8) + (ptr[2]<<16) + (ptr[3]<<24);
101             ptr += 4;
102             len -= 4;
103         }
104         sc = scoffset & 0x1f;
105         offset = scoffset >> 5;
106                 
107         printf("    SC: %d, Offset: %d", sc, offset);
108         switch (sc) {
109         case sc_AnyReg:
110         case sc_DescriptorReg:
111             putchar('\t');
112             brief_print(*os_context_register_addr(context, offset));
113             break;
114
115         case sc_BaseCharReg:
116             ch = *os_context_register_addr(context, offset);
117 #ifdef LISP_FEATURE_X86
118             if (offset&1)
119                 ch = ch>>8;
120             ch = ch & 0xff;
121 #endif
122             switch (ch) {
123             case '\n': printf("\t'\\n'\n"); break;
124             case '\b': printf("\t'\\b'\n"); break;
125             case '\t': printf("\t'\\t'\n"); break;
126             case '\r': printf("\t'\\r'\n"); break;
127             default:
128                 if (ch < 32 || ch > 127)
129                     printf("\\%03o", ch);
130                 else
131                     printf("\t'%c'\n", ch);
132                 break;
133             }
134             break;
135         case sc_SapReg:
136 #ifdef sc_WordPointerReg
137         case sc_WordPointerReg:
138 #endif
139             printf("\t0x%08x\n", *os_context_register_addr(context, offset));
140             break;
141         case sc_SignedReg:
142             printf("\t%d\n", *os_context_register_addr(context, offset));
143             break;
144         case sc_UnsignedReg:
145             printf("\t%u\n", *os_context_register_addr(context, offset));
146             break;
147 #ifdef sc_SingleFloatReg
148         case sc_SingleFloatReg:
149             printf("\t%g\n", *(float *)&context->sc_fpregs[offset]);
150             break;
151 #endif
152 #ifdef sc_DoubleFloatReg
153         case sc_DoubleFloatReg:
154             printf("\t%g\n", *(double *)&context->sc_fpregs[offset]);
155             break;
156 #endif
157         default:
158             printf("\t???\n");
159             break;
160         }
161     }
162 }
163 \f
164 /* utility routines used by miscellaneous pieces of code */
165
166 lispobj debug_print(lispobj string)
167 {
168     /* This is a kludge.  It's not actually safe - in general - to use 
169        %primitive print on the alpha, because it skips half of the
170        number stack setup that should usually be done on a function call,
171        so the called routine (i.e. this one) ends up being able to overwrite
172        local variables in the caller.  Rather than fix this everywhere
173        that %primitive print is used (it's only a debugging aid anyway)
174        we just put guarantee our safety by putting an unused buffer on
175        the stack before doing anything else here */
176     char untouched[32]; /* GCC warns about not using this, but that's the point.. */
177     fprintf(stderr, "%s\n", 
178             (char *)(((struct vector *)native_pointer(string))->data),untouched);
179     return NIL;
180 }