src/runtime/parse.c

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