toka/parser.c

   1 /******************************************************
   2  * Toka
   3  *
   4  *|F|
   5  *|F| FILE: parser.c
   6  *|F|
   7  *
   8  * Copyright (c) 2006, 2007  Charles R. Childers
   9  *
  10  * Permission to use, copy, modify, and distribute this
  11  * software for any purpose with or without fee is hereby
  12  * granted, provided that the above copyright notice and
  13  * this permission notice appear in all copies.
  14  *
  15  * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR
  16  * DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE
  17  * INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY
  18  * AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE
  19  * FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL
  20  * DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
  21  * OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
  22  * CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING
  23  * OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE
  24  * OF THIS SOFTWARE.
  25  ******************************************************/
  26
  27 #include <stdio.h>
  28 #include <stdlib.h>
  29 #include <string.h>
  30 #include <errno.h>
  31 #include <ctype.h>
  32 #include <memory.h>
  33
  34 #include "toka.h"
  35 extern VM_STACK data, address, alternate;
  36
  37
  38
  39
  40 /******************************************************
  41  *|F| Variables:
  42  *|F|   FILE *input[]
  43  *|F|   Current file stream to parse from. Setup as
  44  *|F|   an array of 8 inputs.
  45  *|F|
  46  *|F|   long isp
  47  *|F|   Pointer to the most recent input source in the array
  48  *|F|
  49  *|F|   long base
  50  *|F|   Holds the current numeric base
  51  *|F|
  52  *|F|   long parser
  53  *|F|   When ON (TRUE), system parsing words will parse. When
  54  *|F|   OFF (FALSE), they will take a string from the stack.
  55  *|F|
  56  *|F|   long escapes
  57  *|F|   When ON (TRUE), escape sequences will be handled
  58  *|F|   by the parser. When OFF (FALSE), they will be ignored.
  59  *|F|
  60  *
  61  *|G| base     ( -a )      Variable containg the current
  62  *|G|                      numeric base
  63  *|G| parser   ( -a )      Variable holding current parser
  64  *|G|                      mode.
  65  *|G| escape-sequences ( -a)  Variable determining if
  66  *|G|                         escape sequences are used.
  67  ******************************************************/
  68 FILE *input[8];
  69 long base=10;
  70 long isp=0;
  71 long parser=TRUE;
  72 long escapes=TRUE;
  73
  74
  75 /******************************************************
  76  *|G| >number  ( a-nf )    Attempt to convert a string
  77  *|G|                      to a number
  78  *
  79  *|F| to_number()
  80  *|F| Attempt to convert a string (on TOS) to a number.
  81  *|F| This accepts a format of:
  82  *|F|   [prefix][-]number
  83  *|F| If successful, it leaves the number and a flag of
  84  *|F| TRUE on the stack. Otherwise, it leaves the original
  85  *|F| string, and a flag of FALSE.
  86  *|F|
  87  ******************************************************/
  88 void to_number()
  89 {
  90   char *s, *t;
  91   long flag, old_base;
  92
  93   s = (char *)TOS; DROP;
  94   t = s;
  95   flag = TRUE;
  96   old_base = base;
  97
  98   if (*t == '%')
  99   {
 100     base = 2;
 101     t++; s++;
 102   }
 103   if (*t == '&')
 104   {
 105     base = 8;
 106     t++; s++;
 107   }
 108   if (*t == '#')
 109   {
 110     base = 10;
 111     t++; s++;
 112   }
 113   if (*t == '$')
 114   {
 115     base = 16;
 116     t++; s++;
 117   }
 118
 119   if (*t == '-')
 120     t++;
 121
 122   for (; *t; t++)
 123   {
 124      if (base <= 10)
 125      {
 126        if (!isdigit(*t))
 127        {
 128          flag = FALSE;
 129          break;
 130        }
 131      }
 132      else
 133      {
 134        if (!isxdigit(*t))
 135        {
 136          flag = FALSE;
 137          break;
 138        }
 139      }
 140   }
 141
 142   if (flag == TRUE)
 143     vm_push(strtol(s, (char **)NULL, base));
 144   else
 145     vm_push((long)s);
 146
 147   vm_push(flag);
 148   base = old_base;
 149 }
 150
 151
 152
 153 /******************************************************
 154  *|G| >string  ( n-a )     Convert a number to a string
 155  *
 156  *|F| to_string()
 157  *|F| Convert a number (on TOS) to a string.
 158  *|F|
 159  ******************************************************/
 160 void to_string()
 161 {
 162   char *s;
 163   s = gc_alloc(128, sizeof(char), GC_MEM);
 164   switch (base)
 165   {
 166     case  8: snprintf(s, 128, "%lo", TOS); break;
 167     case 16: snprintf(s, 128, "%lx", TOS); break;
 168     default: snprintf(s, 128, "%li", TOS); break;
 169   }
 170   TOS = (long)s;
 171 }
 172
 173
 174
 175 /******************************************************
 176  *|G| parse    ( d-a )     Parse until the character
 177  *|G|                      represented by 'd' is found.
 178  *|G|                      Return a pointer to the string
 179  *
 180  *|F| parse()
 181  *|F| Parse the input buffer until the character passed
 182  *|F| on TOS is found, or until the end of the line is
 183  *|F| encountered. Return a pointer to the resulting
 184  *|F| string on the stack.
 185  *|F|
 186  ******************************************************/
 187 void parse()
 188 {
 189   long delim;
 190   char *s;
 191
 192   delim = TOS; DROP;
 193   s = gc_alloc(4096, sizeof(char), GC_MEM);
 194   get_token(s, delim);
 195 }
 196
 197
 198
 199 /******************************************************
 200  *|F| get_token(char *s, long delim)
 201  *|F| Return a string (in "s") up to the specified
 202  *|F| delimiter. This also puts the resulting string
 203  *|F| on the stack.
 204  *|F|
 205  ******************************************************/
 206 void get_token(char *s, long delim)
 207 {
 208   char *t;
 209   long c;
 210
 211   t = s;
 212
 213   while (1)
 214   {
 215     if ((c = getc(input[isp])) == EOF && input[isp] != stdin)
 216     {
 217       fclose(input[isp]);
 218       isp--;
 219       break;
 220     }
 221     if (c == EOF && input[isp] == stdin)
 222     {
 223       exit(0);
 224     }
 225
 226     if (c == '\\' && escapes == TRUE)
 227     {
 228       c = getc(input[isp]);
 229       if (c == 'n')
 230       {
 231         *t++ = 10;
 232         c = 1;
 233       }
 234       if (c == 'r')
 235       {
 236         *t++ = 13;
 237         c = 1;
 238       }
 239       if (c == '"')
 240       {
 241         *t++ = (char)c;
 242         c = 1;
 243       }
 244       if (c == '^')
 245       {
 246         *t++ = 27;
 247         c = 1;
 248       }
 249     }
 250
 251     if (delim == 10 || delim == 32)
 252     {
 253       if (c == 10 || c == 13)
 254       {
 255         break;
 256       }
 257     }
 258
 259     if (c == delim)
 260       break;
 261     if (c >= 32 || c == 10 || c == 13)
 262       *t++ = (char)c;
 263   }
 264   *t++ = 0;
 265   vm_push((long)s);
 266 }
 267
 268
 269
 270 /******************************************************
 271  *|F| long include_file(char *s)
 272  *|F| Attempt to open a file ("s") and add it to the
 273  *|F| top of the input stack.
 274  *|F|
 275  ******************************************************/
 276 long include_file(char *s)
 277 {
 278   FILE *file;
 279   long flag;
 280
 281   file = fopen(s, "r");
 282   flag = FALSE;
 283
 284   if (file)
 285   {
 286     isp++;
 287     input[isp] = file;
 288     flag = TRUE;
 289   }
 290
 291   return flag;
 292 }
 293
 294
 295
 296 /******************************************************
 297  *|G| include   ( "- )     Attempt to open a file and
 298  *|G|                      add it to the input stack.
 299  *|G|           ( $- )     Non-parsing form
 300  *
 301  *|F| include()
 302  *|F| Take a filename off the stack, attempt to open
 303  *|F| it and add it to the input stream if successful.
 304  *|F|
 305  ******************************************************/
 306 void include()
 307 {
 308   char *s;
 309
 310   if (PARSING)
 311   {
 312     s = gc_alloc(256, sizeof(char), GC_TEMP);
 313     get_token(s, 32); DROP;
 314   }
 315   else
 316   {
 317     s = (char *)TOS; DROP;
 318   }
 319
 320   include_file(s);
 321 }
 322
 323
 324
 325 /******************************************************
 326  *|G| needs     ( "- )     Attempt to include a file
 327  *|G|                      from the library (normally
 328  *|G|                      /usr/share/toka/library)
 329  *|G|           ( $- )     Non-parsing form
 330  *
 331  *|F| needs()
 332  *|F| Take a filename off the stack. Attempt to open it
 333  *|F| from the library, and add it to the input stream
 334  *|F| if successful.
 335  *|F|
 336  ******************************************************/
 337 void needs()
 338 {
 339   char *s;
 340   char *d;
 341
 342   d = gc_alloc(384, sizeof(char), GC_TEMP);
 343   strcpy(d, LIBRARY);
 344
 345   if (PARSING)
 346   {
 347     s = gc_alloc(256, sizeof(char), GC_TEMP);
 348     get_token(s, 32); DROP;
 349   }
 350   else
 351   {
 352     s = (char *)TOS; DROP;
 353   }
 354
 355   strcat(d, s);
 356   include_file(d);
 357 }
 358
 359
 360 /******************************************************
 361  *|G| end.      ( - )      Remove the current file from
 362  *|G|                      the input stack
 363  *
 364  *|F| force_eof()
 365  *|F| Remove the current file from the input stack. This
 366  *|F| can be used to abort an include.
 367  *|F|
 368  ******************************************************/
 369 void force_eof()
 370 {
 371   if (isp > 0)
 372   {
 373     fclose(input[isp]);
 374     isp--;
 375   }
 376   else
 377   {
 378     error(ERROR_CLOSE_STDIN);
 379   }
 380 }