0.9.3.17
[sbcl/eslaughter.git] / src / runtime / parse.c
blob62a0f59b85da7b374da3170644ebe93ecf6cb9c0
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 "sbcl.h"
19 #include "runtime.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 "validate.h"
31 #include "arch.h"
32 #include "search.h"
33 #include "thread.h"
35 #include "genesis/simple-fun.h"
36 #include "genesis/fdefn.h"
37 #include "genesis/symbol.h"
38 #include "genesis/static-symbols.h"
40 static void skip_ws(char **ptr)
42 while (**ptr <= ' ' && **ptr != '\0')
43 (*ptr)++;
46 static boolean string_to_long(char *token, long *value)
48 int base, digit;
49 long num;
50 char *ptr;
52 if (token == 0)
53 return 0;
55 if (token[0] == '0')
56 if (token[1] == 'x') {
57 base = 16;
58 token += 2;
60 else {
61 base = 8;
62 token++;
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;
80 else
81 base = 10;
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;
97 ptr++;
98 num = num * base + digit;
101 *value = num;
102 return 1;
105 static boolean lookup_variable(char *name, lispobj *result)
107 struct var *var = lookup_by_name(name);
109 if (var == NULL)
110 return 0;
111 else {
112 *result = var_value(var);
113 return 1;
118 boolean more_p(ptr)
119 char **ptr;
121 skip_ws(ptr);
123 if (**ptr == '\0')
124 return 0;
125 else
126 return 1;
129 char *parse_token(ptr)
130 char **ptr;
132 char *token;
134 skip_ws(ptr);
136 if (**ptr == '\0')
137 return NULL;
139 token = *ptr;
141 while (**ptr > ' ')
142 (*ptr)++;
144 if (**ptr != '\0') {
145 **ptr = '\0';
146 (*ptr)++;
149 return token;
152 #if 0
153 static boolean number_p(token)
154 char *token;
156 char *okay;
158 if (token == NULL)
159 return 0;
161 okay = "abcdefABCDEF987654321d0";
163 if (token[0] == '0')
164 if (token[1] == 'x' || token[1] == 'X')
165 token += 2;
166 else {
167 token++;
168 okay += 14;
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;
183 else
184 okay += 12;
186 while (*token != '\0')
187 if (index(okay, *token++) == NULL)
188 return 0;
189 return 1;
191 #endif
193 long parse_number(ptr)
194 char **ptr;
196 char *token = parse_token(ptr);
197 long result;
199 if (token == NULL) {
200 printf("expected a number\n");
201 throw_to_monitor();
203 else if (string_to_long(token, &result))
204 return result;
205 else {
206 printf("invalid number: ``%s''\n", token);
207 throw_to_monitor();
209 return 0;
212 char *parse_addr(ptr)
213 char **ptr;
215 char *token = parse_token(ptr);
216 lispobj result;
218 if (token == NULL) {
219 printf("expected an address\n");
220 throw_to_monitor();
222 else if (token[0] == '$') {
223 if (!lookup_variable(token+1, &result)) {
224 printf("unknown variable: ``%s''\n", token);
225 throw_to_monitor();
227 result &= ~7;
229 else {
230 long value;
231 if (!string_to_long(token, &value)) {
232 printf("invalid number: ``%s''\n", token);
233 throw_to_monitor();
235 result = (value & ~3);
238 if (!is_valid_lisp_addr((os_vm_address_t)result)) {
239 printf("invalid Lisp-level address: %p\n", (void *)result);
240 throw_to_monitor();
243 return (char *)result;
246 static boolean lookup_symbol(char *name, lispobj *result)
248 int count;
249 lispobj *headerptr;
251 /* Search static space. */
252 headerptr = (lispobj *)STATIC_SPACE_START;
253 count =
254 (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER,0) -
255 (lispobj *)STATIC_SPACE_START;
256 if (search_for_symbol(name, &headerptr, &count)) {
257 *result = make_lispobj(headerptr,OTHER_POINTER_LOWTAG);
258 return 1;
261 /* Search dynamic space. */
262 #ifndef LISP_FEATURE_GENCGC
263 headerptr = (lispobj *)current_dynamic_space;
264 count = dynamic_space_free_pointer - headerptr;
265 #else
266 headerptr = (lispobj *)DYNAMIC_SPACE_START;
267 count = ((lispobj *)SymbolValue(ALLOCATION_POINTER,0)) - headerptr;
268 #endif
269 if (search_for_symbol(name, &headerptr, &count)) {
270 *result = make_lispobj(headerptr, OTHER_POINTER_LOWTAG);
271 return 1;
274 return 0;
277 static int
278 parse_regnum(char *s)
280 if ((s[1] == 'R') || (s[1] == 'r')) {
281 int regnum;
283 if (s[2] == '\0')
284 return -1;
286 /* skip the $R part and call atoi on the number */
287 regnum = atoi(s + 2);
288 if ((regnum >= 0) && (regnum < NREGS))
289 return regnum;
290 else
291 return -1;
292 } else {
293 int i;
295 for (i = 0; i < NREGS ; i++)
296 if (strcasecmp(s + 1, lisp_register_names[i]) == 0)
297 #ifdef LISP_FEATURE_X86
298 return i*2;
299 #else
300 return i;
301 #endif
303 return -1;
307 lispobj parse_lispobj(ptr)
308 char **ptr;
310 struct thread *thread=arch_os_get_current_thread();
311 char *token = parse_token(ptr);
312 long pointer;
313 lispobj result;
314 long value;
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, &value))
361 result = value;
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) */