0.pre8.28
[sbcl/lichteblau.git] / src / runtime / parse.c
blob61d8a24386ff76ced149d5a38b68d5ae18255ba9
1 /* parsing for LDB monitor */
3 /*
4 * This software is part of the SBCL system. See the README file for
5 * more information.
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.
14 #include <stdio.h>
15 #include <ctype.h>
16 #include <signal.h>
18 #include "runtime.h"
19 #include "sbcl.h"
21 #if defined(LISP_FEATURE_SB_LDB)
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"
34 #include "genesis/simple-fun.h"
35 #include "genesis/fdefn.h"
36 #include "genesis/symbol.h"
37 #include "genesis/static-symbols.h"
39 static void skip_ws(char **ptr)
41 while (**ptr <= ' ' && **ptr != '\0')
42 (*ptr)++;
45 static boolean string_to_long(char *token, long *value)
47 int base, digit;
48 long num;
49 char *ptr;
51 if (token == 0)
52 return 0;
54 if (token[0] == '0')
55 if (token[1] == 'x') {
56 base = 16;
57 token += 2;
59 else {
60 base = 8;
61 token++;
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;
79 else
80 base = 10;
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;
96 ptr++;
97 num = num * base + digit;
100 *value = num;
101 return 1;
104 static boolean lookup_variable(char *name, lispobj *result)
106 struct var *var = lookup_by_name(name);
108 if (var == NULL)
109 return 0;
110 else {
111 *result = var_value(var);
112 return 1;
117 boolean more_p(ptr)
118 char **ptr;
120 skip_ws(ptr);
122 if (**ptr == '\0')
123 return 0;
124 else
125 return 1;
128 char *parse_token(ptr)
129 char **ptr;
131 char *token;
133 skip_ws(ptr);
135 if (**ptr == '\0')
136 return NULL;
138 token = *ptr;
140 while (**ptr > ' ')
141 (*ptr)++;
143 if (**ptr != '\0') {
144 **ptr = '\0';
145 (*ptr)++;
148 return token;
151 #if 0
152 static boolean number_p(token)
153 char *token;
155 char *okay;
157 if (token == NULL)
158 return 0;
160 okay = "abcdefABCDEF987654321d0";
162 if (token[0] == '0')
163 if (token[1] == 'x' || token[1] == 'X')
164 token += 2;
165 else {
166 token++;
167 okay += 14;
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;
182 else
183 okay += 12;
185 while (*token != '\0')
186 if (index(okay, *token++) == NULL)
187 return 0;
188 return 1;
190 #endif
192 long parse_number(ptr)
193 char **ptr;
195 char *token = parse_token(ptr);
196 long result;
198 if (token == NULL) {
199 printf("expected a number\n");
200 throw_to_monitor();
202 else if (string_to_long(token, &result))
203 return result;
204 else {
205 printf("invalid number: ``%s''\n", token);
206 throw_to_monitor();
208 return 0;
211 char *parse_addr(ptr)
212 char **ptr;
214 char *token = parse_token(ptr);
215 long result;
217 if (token == NULL) {
218 printf("expected an address\n");
219 throw_to_monitor();
221 else if (token[0] == '$') {
222 if (!lookup_variable(token+1, (lispobj *)&result)) {
223 printf("unknown variable: ``%s''\n", token);
224 throw_to_monitor();
226 result &= ~7;
228 else {
229 if (!string_to_long(token, &result)) {
230 printf("invalid number: ``%s''\n", token);
231 throw_to_monitor();
233 result &= ~3;
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();
241 return (char *)result;
244 static boolean lookup_symbol(char *name, lispobj *result)
246 int count;
247 lispobj *headerptr;
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;
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;
275 return 0;
278 static int
279 parse_regnum(char *s)
281 if ((s[1] == 'R') || (s[1] == 'r')) {
282 int regnum;
284 if (s[2] == '\0')
285 return -1;
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;
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
304 return -1;
308 lispobj parse_lispobj(ptr)
309 char **ptr;
311 struct thread *thread=arch_os_get_current_thread();
312 char *token = parse_token(ptr);
313 long pointer;
314 lispobj result;
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;
325 free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,thread)>>2;
327 if (free == 0) {
328 printf("Variable ``%s'' is not valid -- there is no current interrupt context.\n", token);
329 throw_to_monitor();
332 context = thread->interrupt_contexts[free - 1];
334 regnum = parse_regnum(token);
335 if (regnum < 0) {
336 printf("bogus register: ``%s''\n", token);
337 throw_to_monitor();
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();
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();
355 else {
356 printf("invalid address: ``%s''\n", token+1);
357 throw_to_monitor();
360 else if (string_to_long(token, (long *)&result))
362 else if (lookup_symbol(token, &result))
364 else {
365 printf("invalid Lisp object: ``%s''\n", token);
366 throw_to_monitor();
369 return result;
372 #endif /* defined(LISP_FEATURE_SB_LDB) */