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