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