src/lisp/parse.c

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