0.9.1.7: "fix" SB-SPROF on non-gencgc platforms
[sbcl.git] / src / runtime / parse.c
1 /* parsing for LDB monitor */
2
3 /*
4  * This software is part of the SBCL system. See the README file for
5  * more information.
6  *
7  * This software is derived from the CMU CL system, which was
8  * written at Carnegie Mellon University and released into the
9  * public domain. The software is in the public domain and is
10  * provided with absolutely no warranty. See the COPYING and CREDITS
11  * files for more information.
12  */
13
14 #include <stdio.h>
15 #include <ctype.h>
16 #include <signal.h>
17
18 #include "sbcl.h"
19 #include "runtime.h"
20
21 #if defined(LISP_FEATURE_SB_LDB)
22
23 #include "globals.h"
24 #include "vars.h"
25 #include "parse.h"
26 #include "os.h"
27 #include "interrupt.h"
28 #include "lispregs.h"
29 #include "monitor.h"
30 #include "validate.h"
31 #include "arch.h"
32 #include "search.h"
33 #include "thread.h"
34
35 #include "genesis/simple-fun.h"
36 #include "genesis/fdefn.h"
37 #include "genesis/symbol.h"
38 #include "genesis/static-symbols.h"
39
40 static void skip_ws(char **ptr)
41 {
42     while (**ptr <= ' ' && **ptr != '\0')
43         (*ptr)++;
44 }
45
46 static boolean string_to_long(char *token, long *value)
47 {
48     int base, digit;
49     long num;
50     char *ptr;
51
52     if (token == 0)
53         return 0;
54
55     if (token[0] == '0')
56         if (token[1] == 'x') {
57             base = 16;
58             token += 2;
59         }
60         else {
61             base = 8;
62             token++;
63         }
64     else if (token[0] == '#') {
65         switch (token[1]) {
66             case 'x':
67             case 'X':
68                 base = 16;
69                 token += 2;
70                 break;
71             case 'o':
72             case 'O':
73                 base = 8;
74                 token += 2;
75                 break;
76             default:
77                 return 0;
78         }
79     }
80     else
81         base = 10;
82
83     num = 0;
84     ptr = token;
85     while (*ptr != '\0') {
86         if (*ptr >= 'a' && *ptr <= 'f')
87             digit = *ptr + 10 - 'a';
88         else if (*ptr >= 'A' && *ptr <= 'F')
89             digit = *ptr + 10 - 'A';
90         else if (*ptr >= '0' && *ptr <= '9')
91             digit = *ptr - '0';
92         else
93             return 0;
94         if (digit < 0 || digit >= base)
95             return 0;
96
97         ptr++;
98         num = num * base + digit;
99     }
100
101     *value = num;
102     return 1;
103 }
104
105 static boolean lookup_variable(char *name, lispobj *result)
106 {
107     struct var *var = lookup_by_name(name);
108
109     if (var == NULL)
110         return 0;
111     else {
112         *result = var_value(var);
113         return 1;
114     }
115 }
116
117
118 boolean more_p(ptr)
119 char **ptr;
120 {
121     skip_ws(ptr);
122
123     if (**ptr == '\0')
124         return 0;
125     else
126         return 1;
127 }
128
129 char *parse_token(ptr)
130 char **ptr;
131 {
132     char *token;
133
134     skip_ws(ptr);
135
136     if (**ptr == '\0')
137         return NULL;
138
139     token = *ptr;
140
141     while (**ptr > ' ')
142         (*ptr)++;
143
144     if (**ptr != '\0') {
145         **ptr = '\0';
146         (*ptr)++;
147     }
148
149     return token;
150 }
151
152 #if 0
153 static boolean number_p(token)
154 char *token;
155 {
156     char *okay;
157
158     if (token == NULL)
159         return 0;
160
161     okay = "abcdefABCDEF987654321d0";
162
163     if (token[0] == '0')
164         if (token[1] == 'x' || token[1] == 'X')
165             token += 2;
166         else {
167             token++;
168             okay += 14;
169         }
170     else if (token[0] == '#') {
171         switch (token[1]) {
172             case 'x':
173             case 'X':
174                 break;
175             case 'o':
176             case 'O':
177                 okay += 14;
178                 break;
179             default:
180                 return 0;
181         }
182     }
183     else
184         okay += 12;
185
186     while (*token != '\0')
187         if (index(okay, *token++) == NULL)
188             return 0;
189     return 1;
190 }
191 #endif
192
193 long parse_number(ptr)
194 char **ptr;
195 {
196     char *token = parse_token(ptr);
197     long result;
198
199     if (token == NULL) {
200         printf("expected a number\n");
201         throw_to_monitor();
202     }
203     else if (string_to_long(token, &result))
204         return result;
205     else {
206         printf("invalid number: ``%s''\n", token);
207         throw_to_monitor();
208     }
209     return 0;
210 }
211
212 char *parse_addr(ptr)
213 char **ptr;
214 {
215     char *token = parse_token(ptr);
216     long result;
217
218     if (token == NULL) {
219         printf("expected an address\n");
220         throw_to_monitor();
221     }
222     else if (token[0] == '$') {
223         if (!lookup_variable(token+1, (lispobj *)&result)) {
224             printf("unknown variable: ``%s''\n", token);
225             throw_to_monitor();
226         }
227         result &= ~7;
228     }
229     else {
230         if (!string_to_long(token, &result)) {
231             printf("invalid number: ``%s''\n", token);
232             throw_to_monitor();
233         }
234         result &= ~3;
235     }
236
237     if (!is_valid_lisp_addr((os_vm_address_t)result)) {
238         printf("invalid Lisp-level address: 0x%lx\n", result);
239         throw_to_monitor();
240     }
241
242     return (char *)result;
243 }
244
245 static boolean lookup_symbol(char *name, lispobj *result)
246 {
247     int count;
248     lispobj *headerptr;
249
250     /* Search static space. */
251     headerptr = (lispobj *)STATIC_SPACE_START;
252     count =
253         (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER,0) -
254         (lispobj *)STATIC_SPACE_START;
255     if (search_for_symbol(name, &headerptr, &count)) {
256         *result = make_lispobj(headerptr,OTHER_POINTER_LOWTAG);
257         return 1;
258     }
259
260     /* Search dynamic space. */
261     headerptr = (lispobj *)DYNAMIC_SPACE_START;
262 #if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
263     count =
264         dynamic_space_free_pointer -
265         (lispobj *)DYNAMIC_SPACE_START;
266 #else
267     count =
268         (lispobj *)SymbolValue(ALLOCATION_POINTER,0) -
269         (lispobj *)DYNAMIC_SPACE_START;
270 #endif
271     if (search_for_symbol(name, &headerptr, &count)) {
272         *result = make_lispobj(headerptr, OTHER_POINTER_LOWTAG);
273         return 1;
274     }
275
276     return 0;
277 }
278
279 static int
280 parse_regnum(char *s)
281 {
282     if ((s[1] == 'R') || (s[1] == 'r')) {
283         int regnum;
284
285         if (s[2] == '\0')
286             return -1;
287
288         /* skip the $R part and call atoi on the number */
289         regnum = atoi(s + 2);
290         if ((regnum >= 0) && (regnum < NREGS))
291             return regnum;
292         else
293             return -1;
294     } else {
295         int i;
296
297         for (i = 0; i < NREGS ; i++)
298             if (strcasecmp(s + 1, lisp_register_names[i]) == 0)
299 #ifdef LISP_FEATURE_X86
300                 return i*2;
301 #else
302         return i;
303 #endif
304                 
305         return -1;
306     }
307 }
308
309 lispobj parse_lispobj(ptr)
310 char **ptr;
311 {
312     struct thread *thread=arch_os_get_current_thread();
313     char *token = parse_token(ptr);
314     long pointer;
315     lispobj result;
316
317     if (token == NULL) {
318         printf("expected an object\n");
319         throw_to_monitor();
320     } else if (token[0] == '$') {
321         if (isalpha(token[1])) {
322             int free;
323             int regnum;
324             os_context_t *context;
325
326             free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,thread)>>2;
327
328             if (free == 0) {
329                 printf("Variable ``%s'' is not valid -- there is no current interrupt context.\n", token);
330                 throw_to_monitor();
331             }
332
333             context = thread->interrupt_contexts[free - 1];
334
335             regnum = parse_regnum(token);
336             if (regnum < 0) {
337                 printf("bogus register: ``%s''\n", token);
338                 throw_to_monitor();
339             }
340
341             result = *os_context_register_addr(context, regnum);
342         } else if (!lookup_variable(token+1, &result)) {
343             printf("unknown variable: ``%s''\n", token);
344             throw_to_monitor();
345         }
346     } else if (token[0] == '@') {
347         if (string_to_long(token+1, &pointer)) {
348             pointer &= ~3;
349             if (is_valid_lisp_addr((os_vm_address_t)pointer))
350                 result = *(lispobj *)pointer;
351             else {
352                 printf("invalid Lisp-level address: ``%s''\n", token+1);
353                 throw_to_monitor();
354             }
355         }
356         else {
357             printf("invalid address: ``%s''\n", token+1);
358             throw_to_monitor();
359         }
360     }
361     else if (string_to_long(token, (long *)&result))
362         ;
363     else if (lookup_symbol(token, &result))
364         ;
365     else {
366         printf("invalid Lisp object: ``%s''\n", token);
367         throw_to_monitor();
368     }
369
370     return result;
371 }
372
373 #endif /* defined(LISP_FEATURE_SB_LDB) */