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