2 * This software is part of the SBCL system. See the README file for
5 * This software is derived from the CMU CL system, which was
6 * written at Carnegie Mellon University and released into the
7 * public domain. The software is in the public domain and is
8 * provided with absolutely no warranty. See the COPYING and CREDITS
9 * files for more information.
22 #include "interrupt.h"
28 static void skip_ws(char **ptr)
30 while (**ptr <= ' ' && **ptr != '\0')
34 static boolean string_to_long(char *token, long *value)
44 if (token[1] == 'x') {
52 else if (token[0] == '#') {
73 while (*ptr != '\0') {
74 if (*ptr >= 'a' && *ptr <= 'f')
75 digit = *ptr + 10 - 'a';
76 else if (*ptr >= 'A' && *ptr <= 'F')
77 digit = *ptr + 10 - 'A';
78 else if (*ptr >= '0' && *ptr <= '9')
82 if (digit < 0 || digit >= base)
86 num = num * base + digit;
93 static boolean lookup_variable(char *name, lispobj *result)
95 struct var *var = lookup_by_name(name);
100 *result = var_value(var);
117 char *parse_token(ptr)
141 static boolean number_p(token)
149 okay = "abcdefABCDEF987654321d0";
152 if (token[1] == 'x' || token[1] == 'X')
158 else if (token[0] == '#') {
174 while (*token != '\0')
175 if (index(okay, *token++) == NULL)
181 long parse_number(ptr)
184 char *token = parse_token(ptr);
188 printf("expected a number\n");
191 else if (string_to_long(token, &result))
194 printf("invalid number: ``%s''\n", token);
200 char *parse_addr(ptr)
203 char *token = parse_token(ptr);
207 printf("expected an address\n");
210 else if (token[0] == '$') {
211 if (!lookup_variable(token+1, (lispobj *)&result)) {
212 printf("unknown variable: ``%s''\n", token);
218 if (!string_to_long(token, &result)) {
219 printf("invalid number: ``%s''\n", token);
225 if (!is_valid_lisp_addr((os_vm_address_t)result)) {
226 printf("invalid Lisp-level address: 0x%lx\n", result);
230 return (char *)result;
233 static boolean lookup_symbol(char *name, lispobj *result)
238 /* Search static space. */
239 headerptr = (lispobj *)STATIC_SPACE_START;
241 (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER) -
242 (lispobj *)STATIC_SPACE_START;
243 if (search_for_symbol(name, &headerptr, &count)) {
244 *result = (lispobj)headerptr | type_OtherPointer;
248 /* Search dynamic space. */
249 headerptr = (lispobj *)DYNAMIC_SPACE_START;
250 #if !defined(ibmrt) && !defined(__i386__)
252 dynamic_space_free_pointer -
253 (lispobj *)DYNAMIC_SPACE_START;
256 (lispobj *)SymbolValue(ALLOCATION_POINTER) -
257 (lispobj *)DYNAMIC_SPACE_START;
259 if (search_for_symbol(name, &headerptr, &count)) {
260 *result = (lispobj)headerptr | type_OtherPointer;
268 parse_regnum(char *s)
270 if ((s[1] == 'R') || (s[1] == 'r')) {
276 /* skip the $R part and call atoi on the number */
277 regnum = atoi(s + 2);
278 if ((regnum >= 0) && (regnum < NREGS))
285 for (i = 0; i < NREGS ; i++)
286 if (strcasecmp(s + 1, lisp_register_names[i]) == 0)
297 lispobj parse_lispobj(ptr)
300 char *token = parse_token(ptr);
305 printf("expected an object\n");
307 } else if (token[0] == '$') {
308 if (isalpha(token[1])) {
311 os_context_t *context;
313 free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)>>2;
316 printf("Variable ``%s'' is not valid -- there is no current interrupt context.\n", token);
320 context = lisp_interrupt_contexts[free - 1];
322 regnum = parse_regnum(token);
324 printf("bogus register: ``%s''\n", token);
328 result = *os_context_register_addr(context, regnum);
329 } else if (!lookup_variable(token+1, &result)) {
330 printf("unknown variable: ``%s''\n", token);
333 } else if (token[0] == '@') {
334 if (string_to_long(token+1, &pointer)) {
336 if (is_valid_lisp_addr((os_vm_address_t)pointer))
337 result = *(lispobj *)pointer;
339 printf("invalid Lisp-level address: ``%s''\n", token+1);
344 printf("invalid address: ``%s''\n", token+1);
348 else if (string_to_long(token, (long *)&result))
350 else if (lookup_symbol(token, &result))
353 printf("invalid Lisp object: ``%s''\n", token);