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