src/lisp/parse.c

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