src/runtime/parse.c

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