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